From: jsancho <devnull@localhost>
Date: Sun, 22 Jan 2012 17:39:11 +0000 (+0000)
Subject: Mobs running with external main function
X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=863e73d0d406019c9376c5e8e06a935fbd276807;p=gacela.git

Mobs running with external main function
---

diff --git a/src/gacela.scm b/src/gacela.scm
index 10e7d8b..c0451f6 100644
--- a/src/gacela.scm
+++ b/src/gacela.scm
@@ -241,58 +241,51 @@
 	   (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))
-	(data-symbol (gensym)))
-    `(let ((,mob-id-symbol (gensym))
-	   (,type-symbol ,type)
-	   (,time-symbol 0)
-	   (,data-symbol '())
-	   ,@attr)
-       (lambda* (#:optional (option #f))
-	 (define (kill-me)
-	   (hide-mob-hash ,mob-id-symbol))
-	 (define (save-data)
-	   (let ((time (get-frame-time)))
-	     (cond ((not (= time ,time-symbol))
-		    (set! ,time-symbol time)
-		    (set! ,data-symbol ,(cons 'list (map (lambda (x) `(cons ',(car x) ,(car x))) publish)))))))
-	 (define (get-data)
-	   ,data-symbol)
-	 (define (filter-mobs type fun)
-	   #t)
-	 (define (map-mobs fun type)
-	   (let ((mobs (filter (lambda (m) (and (eq? (m 'get-type) type) (not (eq? (m 'get-mob-id) ,mob-id-symbol)))) (get-active-mobs))))
-	     (map (lambda (m) (fun (m 'get-data))) mobs)))
-	 (case option
-	   ((get-mob-id)
-	    ,mob-id-symbol)
-	   ((get-type)
-	    ,type-symbol)
-	   ((get-data)
-	    (save-data)
-	    ,data-symbol)
-	   (else
-	    (save-data)
-	    (,fun-name 123)))))))
+(define-macro (the-mob type init-data fun-name)
+  `(let ((mob-id (gensym))
+	 (mob-time 0)
+	 (mob-data ,init-data)
+	 (saved-data ,init-data))
+     (lambda* (#:optional (option #f))
+       (define (save-data)
+	 (let ((time (get-frame-time)))
+	   (cond ((not (= time mob-time))
+		  (set! mob-time time)
+		  (set! saved-data mob-data)))))
+;       (define (filter-mobs type fun)
+;	 #t)
+;       (define (map-mobs fun type)
+;	 (let ((mobs (filter (lambda (m) (and (eq? (m 'get-type) type) (not (eq? (m 'get-mob-id) ,mob-id-symbol)))) (get-active-mobs))))
+;	   (map (lambda (m) (fun (m 'get-data))) mobs)))
+       (case option
+	 ((get-mob-id)
+	  mob-id)
+	 ((get-type)
+	  ,type)
+	 ((get-data)
+	  (save-data)
+	  saved-data)
+	 (else
+	  (save-data)
+	  (set! mob-data (,fun-name mob-id mob-data)))))))
 
 (define-macro (define-mob-function head . body)
-  (let ((fun-name (car head)) (attr (map (lambda (a) (if (list? a) a (list a #f))) (cdr head)))
-	(data-symbol (gensym))
-	(body-fun
-	 `(catch #t
-		 (lambda* () ,@body)
-		 (lambda (key . args) #f))))
-    `(define (,fun-name ,data-symbol)
+  (let ((fun-name (car head))
+	(attr (map (lambda (a) (if (list? a) a (list a #f))) (cdr head)))
+	(mob-id-symbol (gensym))
+	(data-symbol (gensym)))
+    `(define (,fun-name ,mob-id-symbol ,data-symbol)
+       (define (kill-me)
+	 (hide-mob-hash ,mob-id-symbol))
        (let ,attr
 	 ,@(map
 	    (lambda (a)
 	      `(let ((val (assoc-ref ,data-symbol ',(car a))))
 		 (cond (val (set! ,(car a) val)))))
 	    attr)
-	 ,body-fun
+	 (catch #t
+		(lambda* () ,@body)
+		(lambda (key . args) #f))
 	 (list ,@(map (lambda (a) `(cons ',(car a) ,(car a))) attr))))))
 
 (define-macro (define-mob mob-head . body)
@@ -302,13 +295,13 @@
        (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))))))
+	   (the-mob ',name (list ,@(map (lambda (a) `(cons ',(car a) ,(car a))) attr)) ,fun-name))))))
 
 (define-macro (lambda-mob attr . body)
   (let ((fun-name (gensym)))
     `(begin
        (define-mob-function ,(cons fun-name attr) ,@body)
-       (the-mob 'undefined ,attr '() ,fun-name))))
+       (the-mob 'undefined '() ,fun-name))))
 
 
 ;;; Collisions