From 34606554273af331e082fc09331ee5c52909650a Mon Sep 17 00:00:00 2001 From: jsancho Date: Sat, 28 May 2011 16:46:17 +0000 Subject: [PATCH] --- gacela_mobs.lisp | 64 ------------------------------------ src/gacela_mobs.scm | 79 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 79 insertions(+), 64 deletions(-) delete mode 100755 gacela_mobs.lisp create mode 100755 src/gacela_mobs.scm diff --git a/gacela_mobs.lisp b/gacela_mobs.lisp deleted file mode 100755 index 8f3d903..0000000 --- a/gacela_mobs.lisp +++ /dev/null @@ -1,64 +0,0 @@ -;;; Gacela, a GNU Common Lisp 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 . - - -(eval-when (compile load eval) - (when (not (find-package 'gacela)) (make-package 'gacela :nicknames '(gg) :use '(lisp))) - (in-package 'gacela :nicknames '(gg) :use '(lisp))) - - -;;; Mob Factory - -(defmacro makemob (name &rest methods) - `(defun ,name (&rest args &aux (option (car args))) - ,(union - `(case option - (:on (mob-on ',name)) - (:off (mob-off ',name))) - (labels ((options (m &aux (option (car m)) (body (cadr m))) - (cond ((null m) nil) - (t (cons (list option `(apply ,body (cdr args))) (options (cddr m))))))) - (options methods))))) - - -(let (running-mobs mobs-to-add mobs-to-quit) - (defun mob-on (mob) - (push mob mobs-to-add)) - - (defun run-mobs (option &key args function) - (dolist (mob running-mobs) - (cond (function (funcall function))) - (secure-block nil (apply (symbol-function mob) (cons option args))))) - - (defun mob-off (mob) - (push mob mobs-to-quit)) - - (defun refresh-running-mobs () - (do ((mob (pop mobs-to-add) (pop mobs-to-add))) ((null mob)) - (push mob running-mobs) - (secure-block nil (funcall (symbol-function mob) :init))) - (setq running-mobs (reverse (set-difference running-mobs mobs-to-quit))) - (setq mobs-to-quit nil)) - - (defun quit-all-mobs () - (setq running-mobs nil mobs-to-add nil mobs-to-quit nil))) - - -(defun logic-mobs () - (run-mobs :logic)) - -(defun render-mobs () - (run-mobs :render :function (lambda () (glLoadIdentity)))) diff --git a/src/gacela_mobs.scm b/src/gacela_mobs.scm new file mode 100755 index 0000000..6081cb4 --- /dev/null +++ b/src/gacela_mobs.scm @@ -0,0 +1,79 @@ +;;; 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 . + + +(use-modules (srfi srfi-1)) + +;;; Mob Factory + +(define-macro (makemob name . methods) + `(define* (,name . args) + (let ((option (car args))) + ,(union + `(case option + (:on (mob-on ',name)) + (:off (mob-off ',name))) + (define (options m) + (let ((option (car m)) (body (cadr m))) + (cond ((null? m) '()) + (else (cons (list option `(apply ,body (cdr args))) (options (cddr m))))))) + (options methods))))) + + +(define mob-on #f) +(define run-mobs #f) +(define mob-off #f) +(define refresh-running-mobs #f) +(define quit-all-mobs #f) + +(let ((running-mobs '()) (mobs-to-add '()) (mobs-to-quit '())) + (set! mob-on + (lambda (mob) + (push mob mobs-to-add))) + + (set! run-mobs + (lambda* (option #:key args function) + (define (run-mobs-rec mobs) + (cond ((null? mobs) #f) + (else + (cond (function (function))) + (secure-block #f (apply (car mobs) (cons option args))) + (or #t (run-mobs-rec (cdr mobs)))))))) + + (set! mob-off + (lambda (mob) + (push mob mobs-to-quit))) + + (set! refresh-running-mobs + (lambda () + (do ((mob (pop mobs-to-add) (pop mobs-to-add))) ((null? mob)) + (push mob running-mobs) + (secure-block nil (mob #:init))) + (set! running-mobs (reverse (lset-difference eq? running-mobs mobs-to-quit))) + (set! mobs-to-quit '()))) + + (set! quit-all-mobs + (lambda () + (set! running-mobs '()) + (set! mobs-to-add '()) + (set! mobs-to-quit '())))) + + +(define (logic-mobs) + (run-mobs #:logic)) + +(define (render-mobs) + (run-mobs #:render #:function (lambda () (glLoadIdentity)))) -- 2.39.2