From 0f118296f8a4a07a378b89199eefe2e4af33ea09 Mon Sep 17 00:00:00 2001
From: jsancho <devnull@localhost>
Date: Wed, 18 Jan 2012 20:21:41 +0000
Subject: [PATCH] Mobs with main functions.

---
 src/gacela.scm | 42 ++++++++++++++++++++++++++++++++----------
 1 file changed, 32 insertions(+), 10 deletions(-)

diff --git a/src/gacela.scm b/src/gacela.scm
index a9d6771..f3794c9 100644
--- a/src/gacela.scm
+++ b/src/gacela.scm
@@ -37,11 +37,13 @@
 	    set-game-code
 	    show-mob-hash
 	    hide-mob-hash
-	    hide-all-mobs)
+	    hide-all-mobs
+	    get-mob-function-name)
   #:export-syntax (game
 		   show-mob
 		   hide-mob
 		   the-mob
+		   define-mob-function
 		   define-mob
 		   lambda-mob)
   #:re-export (get-current-color
@@ -230,7 +232,16 @@
 
 ;;; Making mobs
 
-(define-macro (the-mob type attr publish . body)
+(define mob-functions (make-hash-table))
+
+(define (get-mob-function-name mob-name)
+  (let ((name (hash-ref mob-functions mob-name)))
+    (cond ((not name)
+	   (set! name (gensym))
+	   (hash-set! mob-functions mob-name name)))
+    name))
+
+(define-macro (the-mob type attr publish fun-name)
   (let ((mob-id-symbol (gensym))
 	(type-symbol (gensym))
 	(time-symbol (gensym))
@@ -265,18 +276,29 @@
 	    ,data-symbol)
 	   (else
 	    (save-data)
-	    (catch #t
-	     	   (lambda () ,@body)
-		   (lambda (key . args) #f))))))))
+	    (,fun-name 123)))))))
+
+(define-macro (define-mob-function head . body)
+  (let ((fun-name (car head)) (attr (cdr head)))
+    `(define (,fun-name data)
+       (catch #t
+	      (lambda* () ,@body)
+	      (lambda (key . args) #f))))
 
 (define-macro (define-mob mob-head . body)
-  (let ((name (car mob-head)) (attr (cdr mob-head)))
-    `(define ,(string->symbol (string-concatenate (list "make-" (symbol->string name))))
-       (lambda* ,(if (null? attr) '() `(#:key ,@attr))
-	 (the-mob ',name () ,attr ,@body)))))
+  (let* ((name (car mob-head)) (attr (cdr mob-head))
+	 (fun-name (get-mob-function-name name)))
+    `(begin
+       (define-mob-function ,(cons fun-name attr) ,@body)
+       (define ,(string->symbol (string-concatenate (list "make-" (symbol->string name))))
+	 (lambda* ,(if (null? attr) '() `(#:key ,@attr))
+	   (the-mob ',name () ,attr ,fun-name))))))
 
 (define-macro (lambda-mob attr . body)
-  `(the-mob 'undefined ,attr '() ,@body))
+  (let ((fun-name (gensym)))
+    `(begin
+       (define-mob-function ,(cons fun-name attr) ,@body)
+       (the-mob 'undefined ,attr '() ,fun-name))))
 
 
 ;;; Collisions
-- 
2.39.5