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     `(let ((,mob-id-symbol (gensym))
  96            (,type-symbol ,type)
  97            (,time-symbol 0)
  98            (,data-symbol '())
  99            ,@attr)
 100        (lambda* (#:optional (option #f))
 101          (define (kill-me)
 102            (hide-mob-hash ,mob-id-symbol))
 103          (define (save-data)
 104            (let ((time (get-frame-time)))
 105              (cond ((not (= time ,time-symbol))
 106                     (set! ,time-symbol time)
 107                     (set! ,data-symbol ,(cons 'list (map (lambda (x) `(cons ',(car x) ,(car x))) publish)))))))
 108          (define (get-data)
 109            ,data-symbol)
 110          (define (filter-mobs type fun)
 111            #t)
 112          (define (map-mobs fun type)
 113            (let ((mobs (filter (lambda (m) (and (eq? (m 'get-type) type) (not (eq? (m 'get-mob-id) ,mob-id-symbol)))) (get-active-mobs))))
 114              (map (lambda (m) (fun (m 'get-data))) mobs)))
 115          (case option
 116            ((get-mob-id)
 117             ,mob-id-symbol)
 118            ((get-type)
 119             ,type-symbol)
 120            ((get-data)
 121             (save-data)
 122             ,data-symbol)
 123            (else
 124             (save-data)
 125             (catch #t
 126                    (lambda () ,@body)
 127                    (lambda (key . args) #f))))))))
 128
 129 (define-macro (lambda-mob attr . body)
 130   `(the-mob 'undefined ,attr '() ,@body))
 131
 132
 133 ;;; Collisions
 134
 135 (define-macro (lambda-mob-data attr . body)
 136   `(lambda ,attr ,@body))
 137
 138 (define-macro (define-collision-check name mobs . body)
 139   `(defmacro* ,name (#:optional m)
 140      `(let ,(cond (m `((mob-id (,m 'get-mob-id)) (mob-type (,m 'get-type))))
 141                   (else `()))
 142
 143         mob-id)))