From: jsancho <devnull@localhost>
Date: Sat, 28 May 2011 16:46:17 +0000 (+0000)
Subject: (no commit message)
X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=34606554273af331e082fc09331ee5c52909650a;p=gacela.git

---

diff --git a/gacela_mobs.lisp b/gacela_mobs.lisp
deleted file mode 100755
index 8f3d903..0000000
--- a/gacela_mobs.lisp
+++ /dev/null
@@ -1,64 +0,0 @@
-;;; Gacela, a GNU Common Lisp extension for fast games development
-;;; Copyright (C) 2009 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-
-(eval-when (compile load eval)
-	   (when (not (find-package 'gacela)) (make-package 'gacela :nicknames '(gg) :use '(lisp)))
-	   (in-package 'gacela :nicknames '(gg) :use '(lisp)))
-
-
-;;; Mob Factory
-
-(defmacro makemob (name &rest methods)
-  `(defun ,name (&rest args &aux (option (car args)))
-     ,(union
-       `(case option
-	      (:on (mob-on ',name))
-	      (:off (mob-off ',name)))
-       (labels ((options (m &aux (option (car m)) (body (cadr m)))
-			 (cond ((null m) nil)
-			       (t (cons (list option `(apply ,body (cdr args))) (options (cddr m)))))))
-	       (options methods)))))
-
-
-(let (running-mobs mobs-to-add mobs-to-quit)
-  (defun mob-on (mob)
-    (push mob mobs-to-add))
-
-  (defun run-mobs (option &key args function)
-    (dolist (mob running-mobs)
-      (cond (function (funcall function)))
-      (secure-block nil (apply (symbol-function mob) (cons option args)))))
-
-  (defun mob-off (mob)
-    (push mob mobs-to-quit))
-
-  (defun refresh-running-mobs ()
-    (do ((mob (pop mobs-to-add) (pop mobs-to-add))) ((null mob))
-	(push mob running-mobs)
-	(secure-block nil (funcall (symbol-function mob) :init)))
-    (setq running-mobs (reverse (set-difference running-mobs mobs-to-quit)))
-    (setq mobs-to-quit nil))
-
-  (defun quit-all-mobs ()
-    (setq running-mobs nil mobs-to-add nil mobs-to-quit nil)))
-
-
-(defun logic-mobs ()
-  (run-mobs :logic))
-
-(defun render-mobs ()
-  (run-mobs :render :function (lambda () (glLoadIdentity))))
diff --git a/src/gacela_mobs.scm b/src/gacela_mobs.scm
new file mode 100755
index 0000000..6081cb4
--- /dev/null
+++ b/src/gacela_mobs.scm
@@ -0,0 +1,79 @@
+;;; Gacela, a GNU Guile extension for fast games development
+;;; Copyright (C) 2009 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(use-modules (srfi srfi-1))
+
+;;; Mob Factory
+
+(define-macro (makemob name . methods)
+  `(define* (,name . args)
+     (let ((option (car args)))
+       ,(union
+	 `(case option
+	    (:on (mob-on ',name))
+	    (:off (mob-off ',name)))
+	 (define (options m)
+	   (let ((option (car m)) (body (cadr m)))
+	     (cond ((null? m) '())
+		   (else (cons (list option `(apply ,body (cdr args))) (options (cddr m)))))))
+	 (options methods)))))
+
+
+(define mob-on #f)
+(define run-mobs #f)
+(define mob-off #f)
+(define refresh-running-mobs #f)
+(define quit-all-mobs #f)
+
+(let ((running-mobs '()) (mobs-to-add '()) (mobs-to-quit '()))
+  (set! mob-on
+	(lambda (mob)
+	  (push mob mobs-to-add)))
+
+  (set! run-mobs
+	(lambda* (option #:key args function)
+	  (define (run-mobs-rec mobs)
+	    (cond ((null? mobs) #f)
+		  (else
+		   (cond (function (function)))
+		   (secure-block #f (apply (car mobs) (cons option args)))
+		   (or #t (run-mobs-rec (cdr mobs))))))))
+
+  (set! mob-off
+	(lambda (mob)
+	  (push mob mobs-to-quit)))
+
+  (set! refresh-running-mobs
+	(lambda ()
+	  (do ((mob (pop mobs-to-add) (pop mobs-to-add))) ((null? mob))
+	    (push mob running-mobs)
+	    (secure-block nil (mob #:init)))
+	  (set! running-mobs (reverse (lset-difference eq? running-mobs mobs-to-quit)))
+	  (set! mobs-to-quit '())))
+
+  (set! quit-all-mobs
+	(lambda ()
+	  (set! running-mobs '())
+	  (set! mobs-to-add '())
+	  (set! mobs-to-quit '()))))
+
+
+(define (logic-mobs)
+  (run-mobs #:logic))
+
+(define (render-mobs)
+  (run-mobs #:render #:function (lambda () (glLoadIdentity))))