X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=gacela_draw.lisp;h=450ed133c0eb15e12d6aab2b4d762b35df3e6ce7;hb=a43020f63638aee6921f1c6333b0d81fa72d4e11;hp=7c5a2d97b846baae6a6d38014288b60d7e950378;hpb=5e3843acaf7628122c750406e48e83ac6fdb6312;p=gacela.git

diff --git a/gacela_draw.lisp b/gacela_draw.lisp
index 7c5a2d9..450ed13 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)))
@@ -73,24 +72,28 @@
 		      (SDL_FreeSurface image)
 		      (cond ((/= zoomed-image 0) (values zoomed-image width height))))))))))
 
-(defun load-texture (filename &optional (min-filter GL_LINEAR) (mag-filter GL_LINEAR))
+(defun load-texture (filename &key (min-filter GL_LINEAR) (mag-filter GL_LINEAR) static)
 ;  (init-textures)
 ;  (init-video-mode)
-  (progn-textures
-   (multiple-value-bind
-    (image real-w real-h) (load-image-for-texture filename)
-        (cond (image
-	       (let ((width (surface-w image)) (height (surface-h image))
-		     (byteorder (if (= (SDL_ByteOrder) SDL_LIL_ENDIAN)
-				    (if (= (surface-format-BytesPerPixel image) 3) GL_BGR GL_BGRA)
-				    (if (= (surface-format-BytesPerPixel image) 3) GL_RGB GL_RGBA)))
-		     (texture (car (glGenTextures 1))))
-		 (glBindTexture GL_TEXTURE_2D texture)
-		 (glTexImage2D GL_TEXTURE_2D 0 3 width height 0 byteorder GL_UNSIGNED_BYTE (surface-pixels image))
-		 (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER min-filter)
-		 (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER mag-filter)
-		 (SDL_FreeSurface image)
-		 (values texture real-w real-h)))))))
+  (let ((key (make-texture :filename filename :min-filter min-filter :mag-filter mag-filter)))
+    (cond ((get-resource key) t)
+	  (t
+	   (progn-textures
+	    (multiple-value-bind
+	     (image real-w real-h) (load-image-for-texture filename)
+	     (cond (image
+		    (let ((width (surface-w image)) (height (surface-h image))
+			  (byteorder (if (= (SDL_ByteOrder) SDL_LIL_ENDIAN)
+				     (if (= (surface-format-BytesPerPixel image) 3) GL_BGR GL_BGRA)
+				     (if (= (surface-format-BytesPerPixel image) 3) GL_RGB GL_RGBA)))
+			  (texture (car (glGenTextures 1))))
+		      (glBindTexture GL_TEXTURE_2D texture)
+		      (glTexImage2D GL_TEXTURE_2D 0 3 width height 0 byteorder GL_UNSIGNED_BYTE (surface-pixels image))
+		      (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER min-filter)
+		      (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER mag-filter)
+		      (SDL_FreeSurface image)
+		      (set-resource key (list :texture texture :width real-w :height real-h) nil :static static)
+		      key)))))))))
 
 (defun draw-image-function (filename)
   (multiple-value-bind
@@ -99,7 +102,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 +111,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)