]> git.jsancho.org Git - gacela.git/commitdiff
(no commit message)
authorjsancho <devnull@localhost>
Mon, 12 Sep 2011 18:25:53 +0000 (18:25 +0000)
committerjsancho <devnull@localhost>
Mon, 12 Sep 2011 18:25:53 +0000 (18:25 +0000)
src/gacela.scm
src/gacela_draw.scm
src/gacela_ttf.scm

index f14b837bdd956ca859d84a9e70d2b2a7d1681cbd..f8dcaf45e75647534045ad9946a4d52f9a62cccc 100644 (file)
 
 (define resources-cache (make-weak-value-hash-table))
 
+(define get-resource-from-cache #f)
+(define insert-resource-into-cache #f)
+
+(let ()
+  (set! get-resource-from-cache
+       (lambda (key)
+         (hash-ref resources-cache key)))
+
+  (set! insert-resource-into-cache
+       (lambda (key res)
+         (hash-set! resources-cache key res))))
 
 ;;; GaCeLa Functions
 
index f72c75142ecc314c7cb6adf98dd4e0a93c6c6d28..595efe9ae92f1074927dc7f15bfa45c59d229a18 100644 (file)
               (zoomSurface surface zoomx zoomy 0))))))
 
 (define* (load-texture filename #:key (min-filter GL_LINEAR) (mag-filter GL_LINEAR))
-  (progn-textures
-   (receive
-    (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 4 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)
-            (set-texture-size! texture real-w real-h)
-            texture))))))
+  (let* ((key (list filename min-filter mag-filter))
+        (res (get-resource-from-cache key)))
+    (cond (res res)
+         (else
+          (progn-textures
+           (receive
+            (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 4 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)
+                     (set-texture-size! texture real-w real-h)
+                     (insert-resource-into-cache key texture)
+                     texture)))))))))
 
 (define* (draw-image filename #:optional (zoom 1))
   (let ((texture (load-texture filename)))
index 228153270318e55b7996f7f1003003bcd9aae03c..a9e64c0eeac3e3790f45a8f099823a93591bb1ad 100644 (file)
 
 
 (define* (load-font font-file #:key (size 40) (encoding ft_encoding_unicode))
-  (let ((font (ftglCreateTextureFont font-file)))
+  (let* ((key (list font-file))
+        (font (get-resource-from-cache key)))
+    (cond ((not font)
+          (set! font (ftglCreateTextureFont font-file))
+          (insert-resource-into-cache key font)))
     (ftglSetFontFaceSize font size 72)
     (ftglSetFontCharMap font encoding)
     font))