X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Fgacela_mobs.scm;h=5e159075b945586567e7154096dd4386de42b53e;hb=023823491bfe1a64e136bcc2d47c6ec5803f23bf;hp=5ae3296ab0287601d48b91062623f2e5aa3930b4;hpb=b50916459d90f604043ea688750c55a516636796;p=gacela.git diff --git a/src/gacela_mobs.scm b/src/gacela_mobs.scm index 5ae3296..5e15907 100755 --- a/src/gacela_mobs.scm +++ b/src/gacela_mobs.scm @@ -48,8 +48,11 @@ (define-macro (hide-mob mob) `(hide-mob-hash ',mob)) -(define (process-mobs mobs) - (for-each (lambda (m) (m #:render)) mobs)) +(define (run-mob-actions mobs) + (for-each (lambda (m) (m 'run-actions)) mobs)) + +(define (render-mobs mobs) + (for-each (lambda (m) (m 'render)) mobs)) ;;; Actions and looks for mobs @@ -113,7 +116,7 @@ (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) @@ -124,15 +127,42 @@ actions) ((set-actions) (if (not (null? params)) (set! actions (car params)))) - ((get-renders) - renders) - ((set-renders) - (if (not (null? params)) (set! renders (car params)))) + ((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)))))) + (for-each + (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 (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) + (mob 'set-actions (assoc-set! (mob 'get-actions) name action))) + +(define (quit-mob-action mob name) + (mob 'set-actions (assoc-remove! (mob 'get-actions) name))) + +(define (add-mob-look mob name look) + (mob 'set-looks (assoc-set! (mob 'get-looks) name look))) + +(define (quit-mob-look mob name) + (mob 'set-looks (assoc-remove! (mob 'get-looks) name)))