src/gacela_mobs.scm

   1 ;;; Gacela, a GNU Guile extension for fast games development
   2 ;;; Copyright (C) 2009 by Javier Sancho Fernandez <jsf at jsancho dot org>
   3 ;;;
   4 ;;; This program is free software: you can redistribute it and/or modify
   5 ;;; it under the terms of the GNU General Public License as published by
   6 ;;; the Free Software Foundation, either version 3 of the License, or
   7 ;;; (at your option) any later version.
   8 ;;;
   9 ;;; This program is distributed in the hope that it will be useful,
  10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ;;; GNU General Public License for more details.
  13 ;;;
  14 ;;; You should have received a copy of the GNU General Public License
  15 ;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16
  17
  18 ;;; Mobs Factory
  19
  20 (define show-mob-hash #f)
  21 (define hide-mob-hash #f)
  22 (define refresh-active-mobs #f)
  23 (define get-active-mobs #f)
  24 (define hide-all-mobs #f)
  25 (define mobs-changed? #f)
  26
  27 (let ((mobs-table (make-hash-table))
  28       (active-mobs '())
  29       (changed #f))
  30
  31   (set! show-mob-hash
  32         (lambda (mob)
  33           (hash-set! mobs-table (mob 'get-mob-id) mob)
  34           (set! changed #t)))
  35
  36   (set! hide-mob-hash
  37         (lambda (mob-id)
  38           (hash-remove! mobs-table mob-id)
  39           (set! changed #t)))
  40
  41   (set! refresh-active-mobs
  42         (lambda ()
  43           (cond (changed
  44                  (set! changed #f)
  45                  (set! active-mobs (hash-map->list (lambda (k v) v) mobs-table))))))
  46
  47   (set! get-active-mobs
  48         (lambda () active-mobs))
  49
  50   (set! hide-all-mobs
  51         (lambda ()
  52           (set! changed #t)
  53           (hash-clear! mobs-table)))
  54
  55   (set! mobs-changed?
  56         (lambda () changed)))
  57
  58
  59 (define-macro (show-mob mob)
  60   (cond ((list? mob)
  61          `(let ((m ,mob))
  62             (show-mob-hash m)))
  63         (else
  64          `(show-mob-hash (lambda* (#:optional (option #f)) (,mob option))))))
  65
  66 (define-macro (hide-mob mob)
  67   (cond ((list? mob)
  68          `(let ((m ,mob))
  69             (hide-mob-hash (m 'get-mob-id))))
  70         (else
  71          `(hide-mob-hash (,mob 'get-mob-id)))))
  72
  73 (define* (run-mobs #:optional (mobs (get-active-mobs)))
  74   (for-each
  75    (lambda (m)
  76      (glPushMatrix)
  77      (m)
  78      (glPopMatrix))
  79    mobs))
  80
  81
  82 ;;; Making mobs
  83
  84 (define-macro (define-mob mob-head . body)
  85   (let ((name (car mob-head)) (attr (cdr mob-head)))
  86     `(define ,(string->symbol (string-concatenate (list "make-" (symbol->string name))))
  87        (lambda* ,(if (null? attr) '() `(#:key ,@attr))
  88          (the-mob ',name () ,attr ,@body)))))
  89
  90 (define-macro (the-mob type attr publish . body)
  91   (let ((mob-id-symbol (gensym))
  92         (type-symbol (gensym))
  93         (time-symbol (gensym))
  94         (data-symbol (gensym))
  95         (save-symbol (gensym)))
  96     `(let ((,mob-id-symbol (gensym))
  97            (,type-symbol ,type)
  98            (,time-symbol 0)
  99            (,data-symbol '())
 100            ,@attr)
 101        (lambda* (#:optional (option #f))
 102          (define (kill-me)
 103            (hide-mob-hash ,mob-id-symbol))
 104          (define (,save-symbol)
 105            (let ((time (get-frame-time)))
 106              (cond ((not (= time ,time-symbol))
 107                     (set! ,time-symbol time)
 108                     (set! ,data-symbol ,(cons 'list (map (lambda (x) `(cons ',(car x) ,(car x))) publish)))))))
 109          (define (map-mobs fun type)
 110            (let ((mobs (filter (lambda (m) (and (eq? (m 'get-type) type) (not (eq? (m 'get-mob-id) ,mob-id-symbol)))) (get-active-mobs))))
 111              (map (lambda (m) (fun (m 'get-data))) mobs)))
 112          (case option
 113            ((get-mob-id)
 114             ,mob-id-symbol)
 115            ((get-type)
 116             ,type-symbol)
 117            ((get-data)
 118             (,save-symbol)
 119             ,data-symbol)
 120            (else
 121             (,save-symbol)
 122             (catch #t
 123                    (lambda () ,@body)
 124                    (lambda (key . args) #f))))))))
 125
 126 (define-macro (lambda-mob attr . body)
 127   `(the-mob 'undefined ,attr '() ,@body))