From: Javier Sancho <jsf@jsancho.org>
Date: Wed, 11 Jul 2012 18:19:06 +0000 (+0200)
Subject: Defining meshes as closures.
X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=9c14da6c19a2e29a1db346df5c746bfcd2680afb;p=gacela.git

Defining meshes as closures.
---

diff --git a/src/video.scm b/src/video.scm
index e58fab9..3e5553d 100644
--- a/src/video.scm
+++ b/src/video.scm
@@ -377,11 +377,11 @@
 (define* (translate x y #:optional (z 0))
   (glTranslatef x y z))
 
-(define* (rotate #:rest rot)
+(define (rotate . rot)
   (cond ((3d-mode?)
 	 (apply 3d-rotate rot))
 	(else
-	 (apply 2d-rotate rot))))
+	 (2d-rotate (car (last-pair rot))))))
 
 (define (3d-rotate xrot yrot zrot)
   (glRotatef xrot 1 0 0)
diff --git a/src/views.scm b/src/views.scm
index b772562..d658eaf 100644
--- a/src/views.scm
+++ b/src/views.scm
@@ -26,23 +26,70 @@
      (hash-set! active-views ',name (lambda () (video:glmatrix-block ,content)))
      ',name))
 
-(define-macro (mesh . content)
-  `(let ((x 0) (y 0) (z 0)
-	(angle 0))
-     (lambda () ,content)))
+(define (mesh primitive)
+  (let ((x 0) (y 0) (z 0)
+	(ax 0) (ay 0) (az 0)
+	(rx 0) (ry 0) (rz 0))
+    (lambda (option . params)
+      (case option
+	((draw)
+	 (video:glatrix-block
+	  (video:rotate rx ry rz)
+	  (video:translate x y z)
+	  (video:rotate ax ay az)
+	  (primitive)))
+	((get-properties)
+	 `((x . ,x) (y . ,y) (z . ,z) (ax . ,ax) (ay . ,ay) (az . ,az) (rx . ,rx) (ry . ,ry) (rz . ,rz)))))))
 
-(define-macro (define-basic-meshes . symbols)
+(define-macro (define-mob mob-head . body)
+  (let* ((name (car mob-head))
+	 (attr (cdr mob-head))
+	 (make-fun-symbol (gensym))
+	 (mob-fun-symbol (gensym))
+	 (params-symbol (gensym)))
+    `(define (,name . ,params-symbol)
+       (define ,make-fun-symbol
+	 (lambda* ,(if (null? attr) '() `(#:key ,@attr))
+	   (the-mob ,name (list ,@(map (lambda (a) `(cons ',(car a) ,(car a))) attr)))))
+       (define ,mob-fun-symbol
+	 (define-mob-function ,attr ,@body))
+       (cond ((or (null? ,params-symbol) (keyword? (car ,params-symbol)))
+	      (apply ,make-fun-symbol ,params-symbol))
+	     (else
+	      (apply ,mob-fun-symbol ,params-symbol))))))
+
+
+(define-macro (define-mesh name . mesh)
+  (let* ((make-fun-symbol (gensym))
+	 (mesh-fun-symbol (gensym))
+	 (params-symbol (gensym)))
+    `(define ,name
+       (let ((,make-fun-symbol
+	      (lambda ()))
+	     (,mesh-fun-symbol
+	      (lambda ())))
+	 (lambda (. ,params-symbol)
+	   (cond ((or (null? ,params-symbol) (keyword? (car ,params-symbol)))
+		  (apply ,make-fun-symbol ,params-symbol))
+		 (else
+		  (apply ,mesh-fun-symbol ,params-symbol))))))))
+	 
+
+(define-macro (define-primitives . symbols)
   (cond ((null? symbols)
 	 `#t)
 	(else
 	 `(begin
-	    (define (,(caar symbols) . params) (mesh (apply ,(cadar symbols) params)))
-	    (define-basic-meshes ,@(cdr symbols))))))
+	    (define (,(caar symbols) . params) (mesh (lambda () (apply ,(cadar symbols) params))))
+	    (define-primitives ,@(cdr symbols))))))
 
-(define-basic-meshes
+; (define-macro (,(caar symbols) . params) (let ((f ',(cadar symbols))) `(mesh (lambda () (apply ,f ',params)))))
+
+(define-primitives
   (rectangle video:draw-rectangle)
   (square video:draw-square))
 
+
 (module-map (lambda (sym var)
 	      (if (not (eq? sym '%module-public-interface))
 		  (module-export! (current-module) (list sym))))