+
+;;; Actions and looks for mobs
+
+(defmacro make-behaviour (name attr &rest code)
+ `(defun ,(get-behaviour-fun-name name) (object-attr)
+ (let ,(mapcar #'attribute-definition attr)
+ ,@code
+ ,(cons 'progn (mapcar #'attribute-save (reverse attr)))
+ object-attr)))
+
+(defun get-behaviour-fun-name (name)
+ (intern (concatenate 'string "BEHAVIOUR-" (string-upcase (string name))) 'gacela))
+
+(defun attribute-name (attribute)
+ (intern (string attribute) 'keyword))
+
+(define (attribute-definition attribute)
+ (let* ((name (cond ((list? attribute) (car attribute))
+ (else attribute)))
+ (pname (attribute-name name))
+ (value (cond ((listp attribute) (cadr attribute)))))
+ `(,name (getf object-attr ,pname ,value))))
+
+(defun attribute-save (attribute)
+ (let* ((name (cond ((listp attribute) (car attribute))
+ (t attribute)))
+ (pname (attribute-name name)))
+ `(setf (getf object-attr ,pname) ,name)))
+