]> git.jsancho.org Git - gacela.git/commitdiff
Mobs running with external main function
authorjsancho <devnull@localhost>
Sun, 22 Jan 2012 17:39:11 +0000 (17:39 +0000)
committerjsancho <devnull@localhost>
Sun, 22 Jan 2012 17:39:11 +0000 (17:39 +0000)
src/gacela.scm

index 10e7d8b0aaf711a66668a1eeb276013212aff186..c0451f67e84acad58e1ed83de9a98d3ef94ff6d1 100644 (file)
           (hash-set! mob-functions mob-name name)))
     name))
 
           (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)
 
 (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)
        (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)
         (list ,@(map (lambda (a) `(cons ',(car a) ,(car a))) attr))))))
 
 (define-macro (define-mob mob-head . body)
        (define-mob-function ,(cons fun-name attr) ,@body)
        (define ,(string->symbol (string-concatenate (list "make-" (symbol->string name))))
         (lambda* ,(if (null? attr) '() `(#:key ,@attr))
        (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)
 
 (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
 
 
 ;;; Collisions