(no commit message)

diff --git a/gacela_mobs.lisp b/gacela_mobs.lisp
deleted file mode 100755 (executable)
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 (executable)
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))))