From: jsancho <devnull@localhost>
Date: Sat, 3 Oct 2009 01:50:04 +0000 (+0000)
Subject: (no commit message)
X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=4859bd92e3604ae7f32ea84d815833caa2c6ee13;p=gacela.git

---

diff --git a/gacela.lisp b/gacela.lisp
index 9663a82..e00837b 100644
--- a/gacela.lisp
+++ b/gacela.lisp
@@ -134,16 +134,6 @@
     (setq current-color (list red green blue alpha))
     (glColor4f red green blue alpha)))
 
-(defun copy-surface (source)
-  (cond ((surface-p source)
-	 (let ((new-surface
-		(make-surface :address (copy-SDL_Surface (surface-address source))
-			      :clip-w (surface-clip-w source)
-			      :clip-h (surface-clip-h source)
-			      :shape (surface-shape source))))
-	   (set-resource 'image new-surface (gentemp))
-	   new-surface))))
-
 (defun load-image (image-file &key (transparent-color nil))
   (init-video-mode)
   (let ((loaded-image (IMG_Load image-file)))
@@ -262,39 +252,24 @@
 
 
 ;;; Resources Manager
-(defstruct resource address free-function object)
+(defstruct resource plist free-function time)
+(defstruct texture filename min-filter mag-filter)
 
 (let ((resources-table (make-hash-table :test 'equal)))
 
-  (defun set-resource (type object &rest key)
-    (let ((res
-	   (cond ((surface-p object)
-		  (make-resource :address (surface-address object)
-				 :free-function #'SDL_FreeSurface
-				 :object object))
-		 ((font-p object)
-		  (make-resource :address (font-address object)
-				 :free-function #'TTF_CloseFont
-				 :object object))
-		 ((cp-space-p object)
-		  (make-resource :address (cp-space-address object)
-				 :free-function #'cpSpaceFree
-				 :object object))
-		 ((cp-body-p object)
-		  (make-resource :address (cp-body-address object)
-				 :free-function #'cpBodyFree
-				 :object object))
-		 ((cp-shape-p object)
-		  (make-resource :address (cp-shape-address object)
-				 :free-function #'cpShapeFree
-				 :object object))
-		 (t nil))))
-      (cond (res (setf (gethash `(,type ,@key) resources-table) res)))))
-
-  (defun get-resource (type &rest key)
-    (let ((resource (gethash `(,type ,@key) resources-table)))
+  (defun set-resource (key plist free-function &key static)
+    (setf (gethash key resources-table)
+	  (make-resource :plist plist
+			 :free-function free-function
+			 :time (if static -1 (SDL_GetTicks)))))
+
+  (defun get-resource (key)
+    (let ((resource (gethash key resources-table)))
       (cond ((null resource) nil)
-	    (t (resource-object resource)))))
+	    (t (cond ((/= (resource-time resource) -1)
+		      (setf (resource-time resource) (SDL_GetTicks))
+		      (setf (gethash key resources-table) resource)))
+	       (resource-plist resource)))))
 
   (defun free-all-resources ()
     (maphash (lambda (key res) (funcall (resource-free-function res) (resource-address res)))
diff --git a/gacela_draw.lisp b/gacela_draw.lisp
index d22a2fd..90efd06 100644
--- a/gacela_draw.lisp
+++ b/gacela_draw.lisp
@@ -72,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) key)
+	  (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