From d93e90690ad41aae3203e93ba01cf8fa658203b3 Mon Sep 17 00:00:00 2001
From: Javier Sancho <jsf@jsancho.org>
Date: Sat, 23 Jun 2012 10:08:06 +0200
Subject: [PATCH] Introducing views

---
 src/gacela.scm | 46 ++++++++++++++++++++++------------------------
 src/video.scm  |  8 ++++----
 2 files changed, 26 insertions(+), 28 deletions(-)

diff --git a/src/gacela.scm b/src/gacela.scm
index 2b9a19e..6719f82 100644
--- a/src/gacela.scm
+++ b/src/gacela.scm
@@ -50,8 +50,8 @@
 		   define-mob
 		   lambda-mob
 		   define-checking-mobs)
-  #:re-export (translate
-	       get-frame-time
+  #:re-export ;(translate
+	      ( get-frame-time
 	       3d-mode?))
 
 
@@ -119,7 +119,7 @@
 		(to-origin)
 		(refresh-active-mobs)
 		(run-mobs)
-		(draw-bricks)
+		(draw-views)
 		(flip-screen)
 		(delay-frame))))
   (quit-video))
@@ -339,33 +339,31 @@
      ,@body))
 
 
-;;; Bricks Factory
+;;; Views Factory
 
-(define active-bricks '())
+(define active-views (make-hash-table))
 
-(define* (draw-bricks #:optional (bricks active-bricks))
-  (cond ((not (null? bricks))
-	 ((car bricks))
-	 (draw-bricks (cdr bricks)))))
-
-(define-macro (show-brick brick-name)
-  `(set! active-bricks (cons (lambda () (,brick-name)) active-bricks)))
-
-(define-macro (simple-brick brick-code)
-  (let ((name (gensym)))
-    `(begin
-       (define (,name)
-	 ,brick-code)
-       (show-brick ,name)
-       ,name)))
+(define* (draw-views #:optional (views (hash-map->list (lambda (k v) v) active-views)))
+  (cond ((not (null? views))
+	 (catch #t
+		  (lambda* () ((car views)))
+		  (lambda (key . args) #f))
+	 (draw-views (cdr views)))))
 
+(define-macro (define-view name content)
+  `(begin
+     (hash-set! active-views ',name (lambda () (glmatrix-block ,content)))
+     ',name))
 
-;;; Primitive bricks
 
-(define-macro (draw-square . args)
-  `(simple-brick (apply video:draw-square ',args)))
+;;; Views Primitives
 
-(re-export video:draw-square)
+(define-macro (translate x y view-or-z . view)
+  (let* ((z (if (null? view) 0 view-or-z))
+	 (view (if (null? view) view-or-z (car view))))
+    `(begin
+       (gltranslate ,x ,y ,z)
+       ,view)))
 
 
 (module-map (lambda (sym var)
diff --git a/src/video.scm b/src/video.scm
index e58fab9..d3fbdfb 100644
--- a/src/video.scm
+++ b/src/video.scm
@@ -58,8 +58,8 @@
 	    draw-rectangle
 	    draw-square
 	    draw-cube
-	    translate
-	    rotate
+	    gltranslate
+	    glrotate
 	    to-origin
 	    add-light
 	    set-camera
@@ -374,10 +374,10 @@
      (glNormal3f -1 0 0)
      (draw-quad (list -size -size size) (list -size -size -size) (list -size size -size) (list -size size size) #:texture (or texture-6 texture) #:color (or color-6 color)))))
 
-(define* (translate x y #:optional (z 0))
+(define* (gltranslate x y #:optional (z 0))
   (glTranslatef x y z))
 
-(define* (rotate #:rest rot)
+(define* (glrotate #:rest rot)
   (cond ((3d-mode?)
 	 (apply 3d-rotate rot))
 	(else
-- 
2.39.5