From ce7ef4885a71f0f08eb813fc4fac2a768a92923c Mon Sep 17 00:00:00 2001 From: jsancho Date: Sun, 1 Jan 2012 21:09:22 +0000 Subject: [PATCH] Include mobs in gacela module. --- src/gacela.scm | 117 ++++++++++++++++++++++++++++++++++++ src/gacela_mobs.scm | 143 -------------------------------------------- 2 files changed, 117 insertions(+), 143 deletions(-) delete mode 100755 src/gacela_mobs.scm diff --git a/src/gacela.scm b/src/gacela.scm index 2945ec6..83e7275 100644 --- a/src/gacela.scm +++ b/src/gacela.scm @@ -166,3 +166,120 @@ (define (get-game-properties) `((title . ,(get-screen-title)) (width . ,(get-screen-width)) (height . ,(get-screen-height)) (bpp . ,(get-screen-bpp)) (fps . ,(get-frames-per-second)) (mode . ,(if (3d-mode?) '3d '2d)))) + + +;;; Mobs Factory + +(define mobs-table (make-hash-table)) +(define active-mobs '()) +(define changed #f)) + +(define (show-mob-hash mob) + (hash-set! mobs-table (mob 'get-mob-id) mob) + (set! changed #t)) + +(define (hide-mob-hash mob-id) + (hash-remove! mobs-table mob-id) + (set! changed #t)) + +(define (refresh-active-mobs) + (cond (changed + (set! changed #f) + (set! active-mobs (hash-map->list (lambda (k v) v) mobs-table))))) + +(define (get-active-mobs) + active-mobs) + +(define (hide-all-mobs) + (set! changed #t) + (hash-clear! mobs-table)) + +(define (mobs-changed?) + changed) + + +(define-macro (show-mob mob) + (cond ((list? mob) + `(let ((m ,mob)) + (show-mob-hash m))) + (else + `(show-mob-hash (lambda* (#:optional (option #f)) (,mob option)))))) + +(define-macro (hide-mob mob) + (cond ((list? mob) + `(let ((m ,mob)) + (hide-mob-hash (m 'get-mob-id)))) + (else + `(hide-mob-hash (,mob 'get-mob-id))))) + +(define* (run-mobs #:optional (mobs (get-active-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* ,(if (null? attr) '() `(#:key ,@attr)) + (the-mob ',name () ,attr ,@body))))) + +(define-macro (the-mob type attr publish . body) + (let ((mob-id-symbol (gensym)) + (type-symbol (gensym)) + (time-symbol (gensym)) + (data-symbol (gensym))) + `(let ((,mob-id-symbol (gensym)) + (,type-symbol ,type) + (,time-symbol 0) + (,data-symbol '()) + ,@attr) + (lambda* (#:optional (option #f)) + (define (kill-me) + (hide-mob-hash ,mob-id-symbol)) + (define (save-data) + (let ((time (get-frame-time))) + (cond ((not (= time ,time-symbol)) + (set! ,time-symbol time) + (set! ,data-symbol ,(cons 'list (map (lambda (x) `(cons ',(car x) ,(car x))) publish))))))) + (define (get-data) + ,data-symbol) + (define (filter-mobs type fun) + #t) + (define (map-mobs fun type) + (let ((mobs (filter (lambda (m) (and (eq? (m 'get-type) type) (not (eq? (m 'get-mob-id) ,mob-id-symbol)))) (get-active-mobs)))) + (map (lambda (m) (fun (m 'get-data))) mobs))) + (case option + ((get-mob-id) + ,mob-id-symbol) + ((get-type) + ,type-symbol) + ((get-data) + (save-data) + ,data-symbol) + (else + (save-data) + (catch #t + (lambda () ,@body) + (lambda (key . args) #f)))))))) + +(define-macro (lambda-mob attr . body) + `(the-mob 'undefined ,attr '() ,@body)) + + +;;; Collisions + +;; (define-macro (lambda-mob-data attr . body) +;; `(lambda ,attr ,@body)) + +;; (define-macro (define-collision-check name mobs . body) +;; `(defmacro* ,name (#:optional m) +;; `(let ,(cond (m `((mob-id (,m 'get-mob-id)) (mob-type (,m 'get-type)))) +;; (else `())) + +;; mob-id))) diff --git a/src/gacela_mobs.scm b/src/gacela_mobs.scm deleted file mode 100755 index a0d2bf7..0000000 --- a/src/gacela_mobs.scm +++ /dev/null @@ -1,143 +0,0 @@ -;;; Gacela, a GNU Guile extension for fast games development -;;; Copyright (C) 2009 by Javier Sancho Fernandez -;;; -;;; This program is free software: you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation, either version 3 of the License, or -;;; (at your option) any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see . - - -;;; Mobs Factory - -(define show-mob-hash #f) -(define hide-mob-hash #f) -(define refresh-active-mobs #f) -(define get-active-mobs #f) -(define hide-all-mobs #f) -(define mobs-changed? #f) - -(let ((mobs-table (make-hash-table)) - (active-mobs '()) - (changed #f)) - - (set! show-mob-hash - (lambda (mob) - (hash-set! mobs-table (mob 'get-mob-id) mob) - (set! changed #t))) - - (set! hide-mob-hash - (lambda (mob-id) - (hash-remove! mobs-table mob-id) - (set! changed #t))) - - (set! refresh-active-mobs - (lambda () - (cond (changed - (set! changed #f) - (set! active-mobs (hash-map->list (lambda (k v) v) mobs-table)))))) - - (set! get-active-mobs - (lambda () active-mobs)) - - (set! hide-all-mobs - (lambda () - (set! changed #t) - (hash-clear! mobs-table))) - - (set! mobs-changed? - (lambda () changed))) - - -(define-macro (show-mob mob) - (cond ((list? mob) - `(let ((m ,mob)) - (show-mob-hash m))) - (else - `(show-mob-hash (lambda* (#:optional (option #f)) (,mob option)))))) - -(define-macro (hide-mob mob) - (cond ((list? mob) - `(let ((m ,mob)) - (hide-mob-hash (m 'get-mob-id)))) - (else - `(hide-mob-hash (,mob 'get-mob-id))))) - -(define* (run-mobs #:optional (mobs (get-active-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* ,(if (null? attr) '() `(#:key ,@attr)) - (the-mob ',name () ,attr ,@body))))) - -(define-macro (the-mob type attr publish . body) - (let ((mob-id-symbol (gensym)) - (type-symbol (gensym)) - (time-symbol (gensym)) - (data-symbol (gensym))) - `(let ((,mob-id-symbol (gensym)) - (,type-symbol ,type) - (,time-symbol 0) - (,data-symbol '()) - ,@attr) - (lambda* (#:optional (option #f)) - (define (kill-me) - (hide-mob-hash ,mob-id-symbol)) - (define (save-data) - (let ((time (get-frame-time))) - (cond ((not (= time ,time-symbol)) - (set! ,time-symbol time) - (set! ,data-symbol ,(cons 'list (map (lambda (x) `(cons ',(car x) ,(car x))) publish))))))) - (define (get-data) - ,data-symbol) - (define (filter-mobs type fun) - #t) - (define (map-mobs fun type) - (let ((mobs (filter (lambda (m) (and (eq? (m 'get-type) type) (not (eq? (m 'get-mob-id) ,mob-id-symbol)))) (get-active-mobs)))) - (map (lambda (m) (fun (m 'get-data))) mobs))) - (case option - ((get-mob-id) - ,mob-id-symbol) - ((get-type) - ,type-symbol) - ((get-data) - (save-data) - ,data-symbol) - (else - (save-data) - (catch #t - (lambda () ,@body) - (lambda (key . args) #f)))))))) - -(define-macro (lambda-mob attr . body) - `(the-mob 'undefined ,attr '() ,@body)) - - -;;; Collisions - -(define-macro (lambda-mob-data attr . body) - `(lambda ,attr ,@body)) - -(define-macro (define-collision-check name mobs . body) - `(defmacro* ,name (#:optional m) - `(let ,(cond (m `((mob-id (,m 'get-mob-id)) (mob-type (,m 'get-type)))) - (else `())) - - mob-id))) -- 2.39.5