From: jsancho <devnull@localhost>
Date: Wed, 22 Jun 2011 18:17:44 +0000 (+0000)
Subject: (no commit message)
X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=25092276a1f3e86b9681fe155b7050da730a3514;p=gacela.git

---

diff --git a/gacela_make.lisp b/gacela_make.lisp
deleted file mode 100755
index a6950ef..0000000
--- a/gacela_make.lisp
+++ /dev/null
@@ -1,43 +0,0 @@
-;;; Gacela, a GNU Common Lisp extension for fast games development
-;;; Copyright (C) 2009 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; 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 <http://www.gnu.org/licenses/>.
-
-(defmacro compile-gfile (file-name &key include)
-  `(progn
-     (setq compiler::*cc* (concatenate 'string compiler::*cc* ,include " "))
-     (compile-file ,file-name :system-p t)))
-
-(defun compile-gacela ()
-  (compile-gfile "gacela.lisp")
-  (compile-gfile "gacela_misc.lisp")
-  (compile-gfile "gacela_SDL.lisp")
-  (compile-gfile "gacela_GL.lisp")
-  (compile-gfile "gacela_FTGL.lisp")
-  (compile-gfile "gacela_draw.lisp")
-  (compile-gfile "gacela_ttf.lisp")
-  (compile-gfile "gacela_events.lisp")
-  (compile-gfile "gacela_mobs.lisp")
-  (compile-gfile "gacela_widgets.lisp"))
-
-(defun link-gacela ()
-  (compiler::link
-   '("gacela.o" "gacela_misc.o" "gacela_SDL.o" "gacela_GL.o" "gacela_FTGL.o" "gacela_draw.o" "gacela_ttf.o" "gacela_events.o" "gacela_mobs.o" "gacela_widgets.o")
-   "gacela"
-   ""
-   "-lSDL -lSDL_image -lSDL_ttf -lSDL_mixer -lSDL_gfx -lGL -lGLU -lftgl"))
-
-(defun build-gacela ()
-  (compile-gacela)
-  (link-gacela))
diff --git a/src/gacela_mobs.scm b/src/gacela_mobs.scm
index 8120e03..c0507f5 100755
--- a/src/gacela_mobs.scm
+++ b/src/gacela_mobs.scm
@@ -51,6 +51,35 @@
 (define (process-mobs mobs)
   (for-each (lambda (m) (m #:render)) mobs))
 
+
+;;; Actions and looks for mobs
+
+(defmacro make-behaviour (name attr &rest code)
+  `(defun ,(get-behaviour-fun-name name) (object-attr)
+     (let ,(mapcar #'attribute-definition attr)
+       ,@code
+       ,(cons 'progn (mapcar #'attribute-save (reverse attr)))
+       object-attr)))
+
+(defun get-behaviour-fun-name (name)
+  (intern (concatenate 'string "BEHAVIOUR-" (string-upcase (string name))) 'gacela))
+
+(defun attribute-name (attribute)
+  (intern (string attribute) 'keyword))
+
+(define (attribute-definition attribute)
+  (let* ((name (cond ((list? attribute) (car attribute))
+		     (else attribute)))
+	 (pname (attribute-name name))
+	 (value (cond ((listp attribute) (cadr attribute)))))
+    `(,name (getf object-attr ,pname ,value))))
+
+(defun attribute-save (attribute)
+  (let* ((name (cond ((listp attribute) (car attribute))
+		     (t attribute)))
+	 (pname (attribute-name name)))
+    `(setf (getf object-attr ,pname) ,name)))
+
 (define-macro (lambda-look . look)
   (define (process-look look)
     (cond ((null? look) (values '() '()))
@@ -72,6 +101,9 @@
 		  ,@look-lines
 		  (glPopMatrix)))))
 
+
+;;; Making mobs
+
 (define-macro (define-mob mob-head . look)
   (let ((name (car mob-head)) (attr (cdr mob-head)))
     `(define ,name
@@ -86,7 +118,15 @@
 		 ((get-attr)
 		  attr)
 		 ((set-attr)
-		  (if (not (null? params)) (set! attr (car params))))))))
+		  (if (not (null? params)) (set! attr (car params))))
+		 ((get-actions)
+		  actions)
+		 ((set-actions)
+		  (if (not (null? params)) (set! actions (car params))))
+		 ((get-renders)
+		  renders)
+		 ((set-renders)
+		  (if (not (null? params)) (set! renders (car params))))))))
      (cond ((not (null? ',look))
 	    (display ',look)
 	    (newline)))