X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Fgacela_mobs.scm;h=e0e2edd8ba5f7c718b7b6807a6354a98f2faec9e;hb=ca3edcecf937f854c1b5d9eeac566d85dc749cd0;hp=5d4894c57838986046c7cf00c126a18f41d6ee2e;hpb=50f8a168b8b2e748e2c8ad8b83a21eafdd20a6ac;p=gacela.git diff --git a/src/gacela_mobs.scm b/src/gacela_mobs.scm index 5d4894c..e0e2edd 100755 --- a/src/gacela_mobs.scm +++ b/src/gacela_mobs.scm @@ -17,33 +17,71 @@ ;;; Mobs Factory -(define add-mob #f) -(define kill-mob #f) +(define show-mob-hash #f) +(define hide-mob-hash #f) (define get-active-mobs #f) -(define reload-mobs? #f) -(define reload-mobs #f) +(define clear-active-mobs #f) +(define mobs-changed? #f) -(let ((active-mobs '(m1 m2)) (reload #f)) - (set! add-mob - (lambda (mob) - (pushnew (procedure-name mob) active-mobs) - (set! reload #t))) +(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! kill-mob - (lambda (mob) - (set! active-mobs (lset-difference eq? active-mobs (list (procedure-name mob)))) - (set! reload #t))) + (set! hide-mob-hash + (lambda (key) + (hash-remove! key) + (set! changed #t))) (set! get-active-mobs - (lambda () active-mobs)) + (lambda* (#:optional (refreshed #t)) + (set! changed (not refreshed)) + (hash-map->list (lambda (k v) v) active-mobs))) - (set! reload-mobs? - (lambda () reload)) - - (set! reload-mobs + (set! clear-active-mobs (lambda () - #f))) + (set! changed #t) + (hash-clear! active-mobs))) + + (set! mobs-changed? + (lambda () changed))) + + +(define-macro (show-mob mob) + (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 (run-mobs mobs) + (for-each + (lambda (m) + (glPushMatrix) + (m) + (glPopMatrix)) + mobs)) + + +;;; Making mobs + +(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 () + (lambda-mob ,attr ,@body))))) -(define-macro (get-mobs-function) - (let ((mobs (get-active-mobs))) - `(lambda () ,@(map (lambda (mob) `(,mob)) mobs)))) +(define-macro (lambda-mob attr . body) + `(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)))))))