X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=gacela_draw.lisp;h=00eb5516208f950a952201b59a9f3a8dc06959a9;hb=15dc6f156f90086f1f82655b43183f0d8647fa0e;hp=2e9ddbaf005ff06972684fb8eab94f70864b37e2;hpb=66161b212a87260a997193821426f06bca51da7b;p=gacela.git

diff --git a/gacela_draw.lisp b/gacela_draw.lisp
index 2e9ddba..00eb551 100644
--- a/gacela_draw.lisp
+++ b/gacela_draw.lisp
@@ -16,17 +16,19 @@
 
 (in-package :gacela)
 
-(let ((mode '2d))
-  (defun 2d-mode ()
-    (glDisable GL_DEPTH_TEST)
-    (setq mode '2d))
-
-  (defun 3d-mode ()
-    (glEnable GL_DEPTH_TEST)
-    (setq mode '3d))
-
-  (defun 3d-mode? ()
-    (eq mode '3d)))
+(defmacro with-color (color &body code)
+  `(let ((original-color (get-current-color)))
+     (apply #'set-current-color ,color)
+     ,@code
+     (apply #'set-current-color original-color)))
+
+(defmacro progn-textures (&body code)
+  `(let (values)
+     (init-video-mode)
+     (glEnable GL_TEXTURE_2D)
+     (setq values (multiple-value-list (progn ,@code)))
+     (glDisable GL_TEXTURE_2D)
+     (apply #'values values)))
 
 (defun draw (&rest vertexes)
   (begin-draw (length vertexes))
@@ -43,7 +45,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))))
 
@@ -51,9 +55,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)))
@@ -67,65 +68,75 @@
 		      (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))
-  (init-textures)
-  (init-video-mode)
-  (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))))))
+(defun load-texture (filename &key (min-filter GL_LINEAR) (mag-filter GL_LINEAR) static)
+  (let ((key (make-resource-texture :filename filename :min-filter min-filter :mag-filter mag-filter)))
+    (cond ((get-resource key) key)
+	  (t (true-load-texture filename min-filter mag-filter static)))))
+
+(defun true-load-texture (filename min-filter mag-filter static)
+  (let ((key (make-resource-texture :filename filename :min-filter min-filter :mag-filter mag-filter)))
+    (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_RGB GL_RGBA)
+				(if (= (surface-format-BytesPerPixel image) 3) GL_BGR GL_BGRA)))
+		   (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
+			     `(:id-texture ,texture :width ,real-w :height ,real-h)
+			     (lambda () (true-load-texture filename min-filter mag-filter static))
+			     (lambda () (glDeleteTextures 1 `(,texture)))
+			     :static static)
+	       key)))))))
 
 (defun draw-image-function (filename)
-  (multiple-value-bind
-   (texture width height) (load-texture filename)
-        (cond (texture
-	       (lambda (&optional (f 1))
-		 (draw-rectangle (* f width) (* f height) :texture texture))))))
-
-(defun draw-quad (v1 v2 v3 v4 &key texture color)
-  (cond (texture (glBindTexture GL_TEXTURE_2D texture)
-		 (begin-draw 4)
-		 (draw-vertex v1 :texture-coord '(0 0))
-		 (draw-vertex v2 :texture-coord '(1 0))
-		 (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))))
-
-(defun draw-rectangle (width height &key texture color)
+  (let ((texture (load-texture filename)))
+    (lambda (&optional (f 1))
+      (cond (texture
+	     (let ((width (getf (get-resource texture) :width))
+		   (height (getf (get-resource texture) :height)))
+	       (draw-rectangle (* f width) (* f height) :texture texture)))))))
+
+(defun draw-quad (v1 v2 v3 v4 &key texture)
+  (cond (texture (progn-textures
+		  (glBindTexture GL_TEXTURE_2D (getf (get-resource texture) :id-texture))
+		  (begin-draw 4)
+		  (draw-vertex v1 :texture-coord '(0 0))
+		  (draw-vertex v2 :texture-coord '(1 0))
+		  (draw-vertex v3 :texture-coord '(1 1))
+		  (draw-vertex v4 :texture-coord '(0 1))
+		  (glEnd)))
+	(t (draw v1 v2 v3 v4))))
+
+(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)
-    (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)
-    (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)
-    (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)
-    (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)
-    (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)))
+    (progn-textures
+     (glNormal3f 0 0 1)
+     (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)
+     (glNormal3f 0 1 0)
+     (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)
+     (glNormal3f 1 0 0)
+     (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))))
 
 (defun add-light (&key light position ambient (id GL_LIGHT1) (turn-on t))
   (init-lighting)
@@ -138,10 +149,10 @@
 (defun translate (x y &optional (z 0))
   (glTranslatef x y z))
 
-(defun rotate (xrot yrot &optional zrot)
+(defun rotate (xrot yrot zrot)
   (glRotatef xrot 1 0 0)
   (glRotatef yrot 0 1 0)
-  (cond (zrot (glRotatef zrot 0 0 1))))
+  (glRotatef zrot 0 0 1))
 
-(defun enable (&key textures)
-  (cond (textures (glEnable GL_TEXTURE_2D))))
+(defun 2d-rotate (rot)
+  (rotate 0 0 rot))
\ No newline at end of file