Events Engine running and returning data.

[gacela.git] / src / gacela_mobs.scm

diff --git a/src/gacela_mobs.scm b/src/gacela_mobs.scm
index f9594cfd58fa983d4189f261dbc93bb2e3fe9bd0..fc99b89d39c7f5690ff02bde86129772b3a9b52d 100755 (executable)
--- a/src/gacela_mobs.scm
+++ b/src/gacela_mobs.scm
@@ -63,6 +63,9 @@
         `(hide-mob-hash (,mob 'get-mob-id)))))
 
 (define (run-mobs mobs)
+  (clear-mob-data)
+  (for-each (lambda (m) (m 'publish-data)) mobs)
+  (run-mobs-events)
   (for-each
    (lambda (m)
      (glPushMatrix)
@@ -93,12 +96,87 @@
            ,mob-id-symbol)
           ((get-type)
            ,type-symbol)
+          ((publish-data)
+           (cond ((not (null? ',publish))
+                  (publish-mob-data ,mob-id-symbol ,type-symbol ,(cons 'list (map (lambda (x) `(cons ',(car x) ,(car x))) publish))))))
           (else
-           (display ,(cons 'list (map (lambda (x) `(cons ',(car x) ,(car x))) publish)))
-           (newline)
            (catch #t
                   (lambda () ,@body)
                   (lambda (key . args) #f))))))))
 
 (define-macro (lambda-mob attr . body)
   `(the-mob 'undefined ,attr '() ,@body))
+
+
+;;; Events Engine
+
+(define publish-mob-data #f)
+(define clear-mob-data #f)
+(define def-mobs-event #f)
+(define run-mobs-events #f)
+(define return-data #f)
+
+(define published-data (make-hash-table))
+(define mobs-events (make-hash-table))
+(define returned-data (make-hash-table))
+
+(let ((nop #f))
+  (set! publish-mob-data
+       (lambda (mob-id mob-type data)
+         (let ((t (hash-ref published-data mob-type))
+               (i (cons mob-id data)))
+           (hash-set! published-data mob-type
+                      (cond (t (cons i t))
+                            (else (list i)))))))
+
+  (set! clear-mob-data
+       (lambda ()
+         (hash-clear! published-data)
+         (hash-clear! returned-data)))
+
+  (set! def-mobs-event
+       (lambda (pair fun)
+         (cond ((not fun)
+                (hash-remove! mobs-events pair))
+               (else
+                (hash-set! mobs-events pair fun)))))
+
+  (set! run-mobs-events
+       (lambda ()
+         (hash-for-each
+          (lambda (types fun)
+            (let ((t1 (hash-ref published-data (car types)))
+                  (t2 (hash-ref published-data (cadr types))))
+              (cond ((and t1 t2)
+                     (for-each
+                      (lambda (m1)
+                        (for-each
+                         (lambda (m2)
+                           (let ((res (catch #t
+                                             (lambda () (fun (cdr m1) (cdr m2)))
+                                             (lambda (key . args) #f))))
+                             (cond ((and (list? res) (>= (length res) 2))
+                                    (let ((id1 (car m1)) (id2 (car m2))
+                                          (r1 (car res)) (r2 (cadr res)))
+                                      (return-data id1 (cadr types) r1)
+                                      (return-data id2 (car types) r2)
+)))))
+                         t2))
+                      t1)))))
+          mobs-events)))
+
+  (set! return-data
+       (lambda (mob-id mob-type data)
+         (let* ((key (list mob-id mob-type))
+                (res (hash-ref returned-data key)))
+           (hash-set! returned-data key
+                      (cond (res (cons data res))
+                            (else (list data))))
+)))
+)
+
+(define-macro (define-mobs-event types-pair . body)
+  `(def-mobs-event
+     ',types-pair
+     ,(cond ((null? body) #f)
+           (else `(lambda (,(car types-pair) ,(cadr types-pair)) ,@body)))))