-(define (run-mobs-logic mobs)
- (for-each (lambda (m) (m 'run-logic)) mobs))
-
-(define (render-mobs mobs)
- (for-each (lambda (m) (m 'render)) mobs))
-
-
-;;; Logics 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)))
- `(set! attributes (assoc-set! attributes ',name (list ,name)))))
-
-(define-macro (define-mob-logic logic-head . code)
- (let ((name (car logic-head)) (attr (cdr logic-head)))
- `(define ,name
- (lambda-mob-logic ,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 (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
- (let ((line (car look)))
- (receive (lines images) (process-look (cdr look))
- (cond ((string? line)
- (let ((var (gensym)))
- (values (cons `(draw-texture ,var) lines)
- (cons `(,var (load-texture ,line)) images))))
- (else
- (values (cons line lines)
- images))))))))
-
- (receive (look-lines look-images) (process-look look)
- `(let ,look-images
- (lambda (attributes)
- (let ,(map attr-def attr)
- (glPushMatrix)
- ,@look-lines
- (glPopMatrix))))))