+
+;;; Actions and looks for mobs
+
+(define (get-attr list name default)
+ (let ((value (assoc-ref list name)))
+ (cond (value (car value))
+ (else default))))
+
+(define (attr-def attr)
+ (let ((name (car attr))
+ (value (cadr attr)))
+ `(,name (get-attr attributes ',name ',value))))
+
+(define (attr-save attr)
+ (let ((name (car attr)))
+ `(assoc-set! attributes ',name (list ,name))))
+
+(define-macro (define-action action-head . code)
+ (let ((name (car action-head)) (attr (cdr action-head)))
+ `(define ,name
+ (lambda-action ,attr ,@code))))
+
+(define-macro (lambda-action attr . code)
+ `(lambda (attributes)
+ (let ,(map attr-def attr)
+ ,@code
+ ,(cons 'begin (map attr-save attr))
+ attributes)))
+