From: jsancho 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;ds=sidebyside;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