From: jsancho Date: Sat, 25 Dec 2010 09:20:16 +0000 (+0000) Subject: (no commit message) X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=ef32e643b25797f25baf38ea8eb430f8a273a7e7;p=gacela.git --- diff --git a/gacela_entities.lisp b/gacela_entities.lisp deleted file mode 100755 index c4ac79b..0000000 --- a/gacela_entities.lisp +++ /dev/null @@ -1,90 +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))) - - -;;; Behaviours of entities - -(defmacro make-behaviour (name properties &rest code) - `(defun ,name (entity) - (let ,(mapcar #'property-definition properties) - ,@code - ,(cons 'progn (mapcar #'property-save properties)) - entity))) - -(defun property-name (property) - (intern (string property) 'keyword)) - -(defun property-definition (property) - (let* ((name (cond ((listp property) (car property)) - (t property))) - (pname (property-name name)) - (value (cond ((listp property) (cadr property))))) - `(,name (getf entity ,pname ,value)))) - -(defun property-save (property) - (let* ((name (cond ((listp property) (car property)) - (t property))) - (pname (property-name name))) - `(setf (getf entity ,pname) ,name))) - - - -;;; Constructor - -;;; Boxes Factory - -(let (visible-boxes boxes-to-add boxes-to-quit) - (defun add-box (box) - (push box boxes-to-add)) - - (defun quit-box (box) - (push box boxes-to-quit)) - - (defun quit-all-boxes () - (setq visible-boxes nil boxes-to-add nil boxes-to-quit nil)) - - (defun refresh-visible-boxes () - (cond (boxes-to-add - (setq visible-boxes (union visible-boxes boxes-to-add)) - (setq boxes-to-add nil))) - (cond (boxes-to-quit - (setq visible-boxes (reverse (set-difference visible-boxes boxes-to-quit))) - (setq boxes-to-quit nil)))) - - (defun render-boxes () - (labels ((render (l) - (cond (l (funcall (render-fun-name (car l))) - (render (cdr l)))))) - (render visible-boxes)))) - - -(defun render-fun-name (name) - (intern (concatenate 'string "RENDER-BOX-" (string name)) 'gacela)) - -(defun get-props-fun-name (name) - (intern (concatenate 'string "GET-PROPERTIES-BOX-" (string name)) 'gacela)) - -(defmacro make-box (name properties &rest code) - `(progn - (let ,(union '((rx 0) (ry 0) (rz 0)) properties) - (defun ,(render-fun-name name) () ,@code) - (defun ,(get-props-fun-name name) () (list :rx rx :ry ry :rz rz))) - (add-box ',name))) diff --git a/gacela_objects.lisp b/gacela_objects.lisp new file mode 100755 index 0000000..4f55f6e --- /dev/null +++ b/gacela_objects.lisp @@ -0,0 +1,98 @@ +;;; 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))) + + +;;; Behaviours of objects + +(defmacro make-behaviour (name attr &rest code) + `(defun ,(get-behaviour-fun-name name) (object) + (let ,(mapcar #'attribute-definition attr) + ,@code + ,(cons 'progn (mapcar #'attribute-save (reverse attr))) + object))) + +(defun get-behaviour-fun-name (name) + (intern (concatenate 'string "BEHAVIOUR-" (string name)) 'gacela)) + +(defun attribute-name (attribute) + (intern (string attribute) 'keyword)) + +(defun attribute-definition (attribute) + (let* ((name (cond ((listp attribute) (car attribute)) + (t attribute))) + (pname (attribute-name name)) + (value (cond ((listp attribute) (cadr attribute))))) + `(,name (getf object ,pname ,value)))) + +(defun attribute-save (attribute) + (let* ((name (cond ((listp attribute) (car attribute)) + (t attribute))) + (pname (attribute-name name))) + `(setf (getf object ,pname) ,name))) + + + +;;; Objects Factory + +(let (active-objects objects-to-add objects-to-kill) + (defun add-object (object) + (push object objects-to-add)) + + (defun kill-object (object) + (push object objects-to-kill)) + + (defun kill-all-objects () + (setq active-objects nil objects-to-add nil objects-to-kill nil)) + + (defun refresh-active-objects () + (cond (objects-to-add + (setq active-objects (union active-objects objects-to-add)) + (setq objects-to-add nil))) + (cond (objects-to-kill + (setq active-objects (reverse (set-difference active-objects objects-to-kill))) + (setq objects-to-kill nil)))) + + (defun render-boxes () + (labels ((render (l) + (cond (l (funcall (render-fun-name (car l))) + (render (cdr l)))))) + (render visible-boxes)))) + + +(defmacro make-box (name attr &rest code) + `(progn + (let ,(union '((rx 0) (ry 0) (rz 0)) attr) + (defun ,(render-fun-name name) () ,@code) + (defun ,(get-props-fun-name name) () (list :rx rx :ry ry :rz rz))) + (add-box ',name))) + +(defmacro make-object (name &key attr bhv look) + `(let ((object '(:name ,name))) + (union object + (union ,(make-object-attributes attr) + (union ,(make-object-behaviour bhv) + ,(make-object-look look)))))) + +(defun make-object-attributes (attr)) + +(defun make-object-behaviour (bhv)) + +(defun make-object-look (look))