(no commit message)

[gacela.git] / src / gacela_mobs.scm

diff --git a/src/gacela_mobs.scm b/src/gacela_mobs.scm
index de527bdf7f3a93ad28f718d5550a58fa901fa90c..12a0ef1d8aa90163e40a2469adfda912ac2b4184 100755 (executable)
--- a/src/gacela_mobs.scm
+++ b/src/gacela_mobs.scm
@@ -19,19 +19,21 @@
 
 ;;; Actions for mobs
 
-(define-macro (define-action name attr . code)
-  `(define (,name mob-attr)
-     (let ,attr
-       ,@code
-       ,(cons 'begin (map #'attribute-save (reverse attr)))
-       mob-attr)))
-
-(defun attribute-save (attribute)
-  (let* ((name (cond ((listp attribute) (car attribute))
-                    (t attribute)))
-        (pname (attribute-name name)))
-    `(setf (getf object-attr ,pname) ,name)))
-
+(define-macro (define-action action-def . code)
+  (let ((name (car action-def)) (attr (cdr action-def)))
+    `(define (,name mob-attr)
+       (let ,(map attribute-definition attr)
+        ,@code
+        ,(cons 'list (map attribute-result attr))))))
+
+(define (attribute-definition attribute)
+  (let ((name (if (list? attribute) (car attribute) attribute))
+       (value (if (list? attribute) (cadr attribute) #f)))
+    `(,name (let ((v (assoc-ref mob-attr ',name))) (if v (cdr v) ,value)))))
+
+(define (attribute-result attribute)
+  (let ((name (if (list? attribute) (car attribute) attribute)))
+    `(list ',name ,name)))
 
 
 ;;; Mob Factory