(define show-mob-hash #f)
(define hide-mob-hash #f)
(define get-active-mobs #f)
+(define clear-active-mobs #f)
(define mobs-changed? #f)
(let ((active-mobs (make-hash-table)) (changed #f))
(set! changed (not refreshed))
(hash-map->list (lambda (k v) v) active-mobs)))
+ (set! clear-active-mobs
+ (lambda ()
+ (set! changed #t)
+ (hash-clear! active-mobs)))
+
(set! mobs-changed?
(lambda () changed)))
(define-macro (show-mob mob)
- `(show-mob-hash ',mob (lambda (option) (,mob option))))
+ (cond ((list? mob)
+ `(let ((m ,mob))
+ (show-mob-hash (m 'get-mob-id) m)))
+ (else
+ `(show-mob-hash (,mob 'get-mob-id) (lambda () (,mob))))))
(define-macro (hide-mob mob)
`(hide-mob-hash ',mob))
-(define (process-mobs mobs)
- (for-each (lambda (m) (m #:render)) mobs))
+(define (run-mobs-logic mobs)
+ (for-each (lambda (m) (m 'run-logic)) mobs))
+
+(define (render-mobs mobs)
+ (for-each (lambda (m) (m 'render)) mobs))
-;;; Actions and looks for mobs
+;;; Logics and looks for mobs
(define (get-attr list name default)
(let ((value (assoc-ref list name)))
(let ((name (car attr)))
`(set! attributes (assoc-set! attributes ',name (list ,name)))))
-(define-macro (define-action action-head . code)
- (let ((name (car action-head)) (attr (cdr action-head)))
+(define-macro (define-mob-logic logic-head . code)
+ (let ((name (car logic-head)) (attr (cdr logic-head)))
`(define ,name
- (lambda-action ,attr ,@code))))
+ (lambda-mob-logic ,attr ,@code))))
-(define-macro (lambda-action attr . code)
+(define-macro (lambda-mob-logic attr . code)
`(lambda (attributes)
(let ,(map attr-def attr)
,@code
,(cons 'begin (map attr-save attr))
attributes)))
-(define-macro (lambda-look attr . look)
+(define-macro (define-mob-look look-head . code)
+ (let ((name (car look-head)) (attr (cdr look-head)))
+ `(define ,name
+ (lambda-mob-look ,attr ,@code))))
+
+(define-macro (lambda-mob-look attr . look)
(define (process-look look)
(cond ((null? look) (values '() '()))
(else
(define-macro (lambda-mob attr . look)
`(let ((mob #f))
(set! mob
- (let ((attr ',attr) (actions '()) (renders '()))
+ (let ((attr ',attr) (actions '()) (looks '()))
(lambda (option . params)
(case option
((get-attr)
actions)
((set-actions)
(if (not (null? params)) (set! actions (car params))))
- ((get-renders)
- renders)
- ((set-renders)
- (if (not (null? params)) (set! renders (car params))))
- ((actions)
+ ((get-looks)
+ looks)
+ ((set-looks)
+ (if (not (null? params)) (set! looks (car params))))
+ ((run-actions)
(for-each
(lambda (action)
(set! attr ((cdr action) attr)))
actions))
((render)
(for-each
- (lambda (render)
- ((cdr render) attr))
- renders))))))
+ (lambda (look)
+ ((cdr look) attr))
+ looks))))))
(cond ((not (null? ',look))
- (mob 'set-renders
+ (mob 'set-looks
(list (cons
'default-look
(lambda-look ,attr ,@look))))))
mob))
+(define-macro (define-mob mob-def)
+ (let ((name (car mob-def)) (def (cdr mob-def)))
+ `(define ,name
+ (lambda-mob ,@def))))
+
+(defmacro* lambda-mob (#:key (attr '(quote ())) (logic #f) (look #f))
+ `(let ((attr ,attr) (logic ,logic) (look ,look))
+ (lambda (option . params)
+ (case option
+ ((get-attr)
+ attr)
+ ((set-attr)
+ (if (not (null? params)) (set! attr (car params))))
+ ((get-logic)
+ logic)
+ ((set-logic)
+ (if (not (null? params)) (set! logic (car params))))
+ ((get-look)
+ look)
+ ((set-look)
+ (if (not (null? params)) (set! look (car params))))
+ ((run-logic)
+ (cond (logic
+ (catch #t
+ (lambda () (set! attr (logic attr)))
+ (lambda (key . args) #f)))))
+ ((render)
+ (cond (look
+ (catch #t
+ (lambda () (look attr))
+ (lambda (key . args) #f)))))))))
+
+
(define (get-mob-attr mob var)
(let ((value (assoc-ref (mob 'get-attr) var)))
(if value (car value) #f)))
(define (set-mob-attr! mob var value)
(mob 'set-attr (assoc-set! (mob 'get-attr) var (list value))))
-(define (add-mob-action mob name action)
- )
+(define (set-mob-logic! mob logic)
+ (mob 'set-logic logic))
+
+(define (set-mob-look! mob look)
+ (mob 'set-look look))
+
+
+
+
+
+(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-mob ,attr ,@body))))
+
+(define-macro (lambda-mob attr . body)
+ `(lambda ()
+ (let ,(cons '(mob-id (gensym)) attr)
+ (lambda* (#:optional (option #f))
+ (case option
+ ((get-mob-id)
+ mob-id)
+ (else
+ (catch #t
+ (lambda () ,@body)
+ (lambda (key . args) #f))))))))