-(use-modules (srfi srfi-1))
-
-;;; Actions for mobs
-
-(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
-
-(define-macro (makemob name . methods)
- `(define* (,name . args)
- (let ((option (car args)))
- ,(lset-union eq?
- `(case option
- (:on (mob-on ',name))
- (:off (mob-off ',name)))
- (define (options m)
- (let ((option (car m)) (body (cadr m)))
- (cond ((null? m) '())
- (else (cons (list option `(apply ,body (cdr args))) (options (cddr m)))))))
- (options methods)))))
-
-(define-macro (makemob name . methods)
- (define (options m)
- (cond ((null? m) '((else #f)))
+;;; Mobs Factory
+
+(define show-mob-hash #f)
+(define hide-mob-hash #f)
+(define get-active-mobs #f)
+(define mobs-changed? #f)
+
+(let ((active-mobs (make-hash-table)) (changed #f))
+ (set! show-mob-hash
+ (lambda (key mob)
+ (hash-set! active-mobs key mob)
+ (set! changed #t)))
+
+ (set! hide-mob-hash
+ (lambda (key)
+ (hash-remove! key)
+ (set! changed #t)))
+
+ (set! get-active-mobs
+ (lambda* (#:optional (refreshed #t))
+ (set! changed (not refreshed))
+ (hash-map->list (lambda (k v) v) active-mobs)))
+
+ (set! mobs-changed?
+ (lambda () changed)))
+
+
+(define-macro (show-mob mob)
+ `(show-mob-hash ',mob (lambda (option) (,mob option))))
+
+(define-macro (hide-mob mob)
+ `(hide-mob-hash ',mob))
+
+(define (process-mobs mobs)
+ (for-each (lambda (m) (m #:render)) mobs))
+
+
+;;; 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)))
+
+(define-macro (lambda-look . look)
+ (define (process-look look)
+ (cond ((null? look) (values '() '()))