From: jsancho <devnull@localhost>
Date: Sun, 20 Sep 2009 07:01:19 +0000 (+0000)
Subject: (no commit message)
X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=e5735ab84c379b88a404c9d6d9fd4784e55260ea;p=gacela.git

---

diff --git a/gacela_GL.lisp b/gacela_GL.lisp
index 9bd4034..38e03ca 100644
--- a/gacela_GL.lisp
+++ b/gacela_GL.lisp
@@ -192,7 +192,7 @@
 (defentry glClearColor (float float float float) (void "gacela_glClearColor"))
 (defentry glClearDepth (double) (void "gacela_glClearDepth"))
 (defentry glColor3f (float float float) (void "gacela_glColor3f"))
-(defentry glColor4f (float float float) (void "gacela_glColor4f"))
+(defentry glColor4f (float float float float) (void "gacela_glColor4f"))
 (defentry glDepthFunc (int) (void "gacela_glDepthFunc"))
 (defentry glEnable (int) (void "gacela_glEnable"))
 (defentry glDisable (int) (void "gacela_glDisable"))
diff --git a/gacela_draw.lisp b/gacela_draw.lisp
index 7c5a2d9..d22a2fd 100644
--- a/gacela_draw.lisp
+++ b/gacela_draw.lisp
@@ -29,10 +29,10 @@
     (eq mode '3d)))
 
 (defmacro with-color (color &body code)
-  `(progn
+  `(let ((original-color (get-current-color)))
      (apply #'set-current-color ,color)
      ,@code
-     (apply #'set-current-color ,(get-current-color))))
+     (apply #'set-current-color original-color)))
 
 (defun draw (&rest vertexes)
   (begin-draw (length vertexes))
@@ -49,7 +49,9 @@
 	   (draw-vertexes (cdr vertexes)))))
 
 (defun draw-vertex (vertex &key texture-coord)
-  (cond ((consp (car vertex)) (draw-color (car vertex)) (apply #'simple-draw-vertex (cadr vertex)))
+  (cond ((consp (car vertex))
+	 (with-color (car vertex)
+		     (apply #'simple-draw-vertex (cadr vertex))))
 	(t (cond (texture-coord (apply #'glTexCoord2f texture-coord)))
 	   (apply #'simple-draw-vertex vertex))))
 
@@ -57,9 +59,6 @@
   (cond ((3d-mode?) (glVertex3f x y z))
 	(t (glVertex2f x y))))
 
-(defun draw-color (color)
-  (apply #'glColor3f color))
-
 (defun load-image-for-texture (filename)
   (init-video-mode)
   (let ((image (IMG_Load filename)))
@@ -99,7 +98,7 @@
      (cond (texture
 	    (draw-rectangle (* f width) (* f height) :texture texture))))))
 
-(defun draw-quad (v1 v2 v3 v4 &key texture color)
+(defun draw-quad (v1 v2 v3 v4 &key texture)
   (cond (texture (progn-textures
 		  (glBindTexture GL_TEXTURE_2D texture)
 		  (begin-draw 4)
@@ -108,31 +107,30 @@
 		  (draw-vertex v3 :texture-coord '(1 1))
 		  (draw-vertex v4 :texture-coord '(0 1))
 		  (glEnd)))
-	(t (cond (color (draw-color color)))
-	   (draw v1 v2 v3 v4))))
+	(t (draw v1 v2 v3 v4))))
 
-(defun draw-rectangle (width height &key texture color)
+(defun draw-rectangle (width height &key texture)
   (let* ((w (/ width 2)) (-w (neg w)) (h (/ height 2)) (-h (neg h)))
-    (draw-quad (list -w h 0) (list w h 0) (list w -h 0) (list -w -h 0) :texture texture :color color)))
+    (draw-quad (list -w h 0) (list w h 0) (list w -h 0) (list -w -h 0) :texture texture)))
 
-(defun draw-square (&key (size 1) texture color)
-  (draw-rectangle size size :texture texture :color color))
+(defun draw-square (&key (size 1) texture)
+  (draw-rectangle size size :texture texture))
 
-(defun draw-cube (&key size texture color)
+(defun draw-cube (&key size texture)
   (let ((-size (neg size)))
     (enable :textures texture)
     (glNormal3f 0 0 1)
-    (draw-quad (list -size size size) (list size size size) (list size -size size) (list -size -size size) :texture texture :color color)
+    (draw-quad (list -size size size) (list size size size) (list size -size size) (list -size -size size) :texture texture)
     (glNormal3f 0 0 -1)
-    (draw-quad (list -size -size -size) (list size -size -size) (list size size -size) (list -size size -size) :texture texture :color color)
+    (draw-quad (list -size -size -size) (list size -size -size) (list size size -size) (list -size size -size) :texture texture)
     (glNormal3f 0 1 0)
-    (draw-quad (list size size size) (list -size size size) (list -size size -size) (list size size -size) :texture texture :color color)
+    (draw-quad (list size size size) (list -size size size) (list -size size -size) (list size size -size) :texture texture)
     (glNormal3f 0 -1 0)
-    (draw-quad (list -size -size size) (list size -size size) (list size -size -size) (list -size -size -size) :texture texture :color color)
+    (draw-quad (list -size -size size) (list size -size size) (list size -size -size) (list -size -size -size) :texture texture)
     (glNormal3f 1 0 0)
-    (draw-quad (list size -size -size) (list size -size size) (list size size size) (list size size -size) :texture texture :color color)
+    (draw-quad (list size -size -size) (list size -size size) (list size size size) (list size size -size) :texture texture)
     (glNormal3f -1 0 0)
-    (draw-quad (list -size -size size) (list -size -size -size) (list -size size -size) (list -size size size) :texture texture :color color)))
+    (draw-quad (list -size -size size) (list -size -size -size) (list -size size -size) (list -size size size) :texture texture)))
 
 (defun add-light (&key light position ambient (id GL_LIGHT1) (turn-on t))
   (init-lighting)
diff --git a/gacela_tetris.lisp b/gacela_tetris.lisp
index 95268fc..200c4fa 100644
--- a/gacela_tetris.lisp
+++ b/gacela_tetris.lisp
@@ -48,7 +48,7 @@
 
 (defun draw-cell (cell)
   (cond ((null cell) nil)
-	(t (draw-color cell) (draw-square :size 20))))
+	(t (with-color cell (draw-square :size 20)))))
 
 (defun draw-row (row)
   (mapcar (lambda (cell) (draw-cell cell) (translate 23 0)) row))