From 0f118296f8a4a07a378b89199eefe2e4af33ea09 Mon Sep 17 00:00:00 2001 From: jsancho 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.2