From 870f146b156daf8910c0ee549df1bc47d509169e Mon Sep 17 00:00:00 2001
From: jsancho <devnull@localhost>
Date: Fri, 9 Oct 2009 06:20:00 +0000
Subject: [PATCH]

---
 gacela.lisp      | 101 ++---------------------------------------------
 gacela_draw.lisp |   2 +-
 gacela_ttf.lisp  |  18 +++++----
 3 files changed, 16 insertions(+), 105 deletions(-)

diff --git a/gacela.lisp b/gacela.lisp
index cd29c3e..45df43c 100644
--- a/gacela.lisp
+++ b/gacela.lisp
@@ -66,23 +66,6 @@
     (cond ((null screen) nil)
 	  (t (SDL_Flip screen))))
 
-  (defun create-surface (width height &key (trans-color *transparent-color*))
-    (init-video-mode)
-    (let ((new-surface (make-surface
-			:address (create-SDL_Surface
-				  (surface-address screen)
-				  width
-				  height
-				  (getf trans-color :red)
-				  (getf trans-color :green)
-				  (getf trans-color :blue)))))
-      (set-resource 'image new-surface (gentemp))
-      new-surface))
-
-  (defun print-surface (x y surface)
-    (apply-surface x y surface screen)
-    surface)
-
   (defun quit-video-mode ()
     (setq screen nil)))
 
@@ -106,10 +89,6 @@
      (glDisable GL_TEXTURE_2D)
      (apply #'values values)))
 
-(defun init-textures ()
-  (init-video-mode)
-  (glEnable GL_TEXTURE_2D))
-
 (defun init-lighting ()
   (init-video-mode)
   (glEnable GL_LIGHTING))
@@ -156,31 +135,6 @@
      (lambda (x y) (print-surface x y address-image))
      (lambda () (SDL_FreeSurface address-image)))))
 
-(defun apply-surface (x y source destination)
-  (let ((offset (SDL_Rect x y 0 0)))
-    (SDL_BlitSurface source 0 destination offset)
-    (free offset)
-    destination))
-
-(defun apply-surface-old (x y source destination &optional (clip nil))
-  (cond ((null clip)
-	 (apply-surface2 x y (surface-address source) (surface-address destination) 0 0 0 0 0))
-	((integerp clip)
-	 (apply-surface2 x y (surface-address source) (surface-address destination) 0 0
-			 (surface-clip-w source) (surface-clip-h source) clip))
-	(t
-	 (apply-surface2 x y (surface-address source) (surface-address destination)
-			 (first clip) (second clip) (third clip) (fourth clip) 0)))
-  destination)
-
-
-(defun print-image (x y image-file &optional (clip nil))
-  (init-video-mode)
-  (let ((image (load-image image-file)))
-    (print-surface x y image clip)
-    image))
-
-
 (defun clean-screen ()
   (fill-screen *background-color*))
 
@@ -190,56 +144,6 @@
   (flip))
 
 
-;;; TTF Subsystem
-(defstruct font address)
-
-(let ((ttf nil))
-
-  (defun init-ttf ()
-    (cond ((null ttf) (progn (init-sdl) (setq ttf (TTF_Init))))
-	  (t ttf)))
-
-  (defun quit-ttf ()
-    (setq ttf (TTF_Quit))))
-
-
-(defun open-font (font-name tam)
-  (init-ttf)
-  (let ((font (get-resource 'font font-name tam)))
-    (if (null font)
-	(progn (setq font (make-font :address (TTF_OpenFont font-name tam)))
-	       (set-resource 'font font font-name tam)))
-    font))
-
-
-(defun render-text (text-message
-		    &key (color '(:red 255 :green 255 :blue 255))
-		    (font-name "lazy.ttf") (tam 28))
-  (init-ttf)
-  (let ((message (get-resource 'text text-message color font-name tam)))
-    (if (null message)
-	(progn
-	  (setq message
-		(make-surface
-		 :address (render-text2 (open-font font-name tam)
-					text-message
-					(getf color :red)
-					(getf color :green)
-					(getf color :blue))))
-	  (set-resource 'text message text-message color font-name tam)))
-    message))
-
-
-(defun print-text (x y text-message
-		     &key (color '(:red 255 :green 255 :blue 255))
-		     (font-name "lazy.ttf") (tam 28))
-  (init-video-mode)
-  (init-ttf)
-  (let ((message (render-text text-message :color color :font-name font-name :tam tam)))
-    (print-surface x y message)
-    message))
-
-
 ;;; Audio Subsystem
 (let ((audio nil))
 
@@ -254,9 +158,12 @@
 ;;; Resources Manager
 (defstruct resource plist free-function time)
 
-(defun make-texture (&key filename min-filter mag-filter)
+(defun make-resource-texture (&key filename min-filter mag-filter)
   `(:type texture :filename ,filename :min-filter ,min-filter :mag-filter ,mag-filter))
 
+(defun make-resource-font (&key filename size encoding)
+  `(:type font :filename ,filename :size ,size :enconding ,encoding))
+
 (let ((resources-table (make-hash-table :test 'equal)))
 
   (defun set-resource (key plist free-function &key static)
diff --git a/gacela_draw.lisp b/gacela_draw.lisp
index a66adf9..c04fc89 100644
--- a/gacela_draw.lisp
+++ b/gacela_draw.lisp
@@ -73,7 +73,7 @@
 		      (cond ((/= zoomed-image 0) (values zoomed-image width height))))))))))
 
 (defun load-texture (filename &key (min-filter GL_LINEAR) (mag-filter GL_LINEAR) static)
-  (let ((key (make-texture :filename filename :min-filter min-filter :mag-filter mag-filter)))
+  (let ((key (make-resource-texture :filename filename :min-filter min-filter :mag-filter mag-filter)))
     (cond ((get-resource key) key)
 	  (t
 	   (progn-textures
diff --git a/gacela_ttf.lisp b/gacela_ttf.lisp
index 89d9b68..63b4b2d 100644
--- a/gacela_ttf.lisp
+++ b/gacela_ttf.lisp
@@ -16,12 +16,16 @@
 
 (in-package :gacela)
 
-(defun open-font (font-file &optional (size 80) (encoding ft_encoding_unicode))
-  (let ((font (ftglCreateTextureFont font-file)))
-    (cond ((/= font 0)
-	   (ftglSetFontFaceSize font size 72)
-	   (ftglSetFontCharMap font encoding)
-	   font))))
+(defun open-font (font-file &key (size 80) (encoding ft_encoding_unicode) static)
+  (let ((key (make-resource-font :filename font-file :size size :encoding encoding)))
+    (cond ((get-resource key) key)
+	  (t
+	   (let ((font (ftglCreateTextureFont font-file)))
+	     (cond ((/= font 0)
+		    (ftglSetFontFaceSize font size 72)
+		    (ftglSetFontCharMap font encoding)
+		    (set-resource key `(:id-font ,font) nil :static static)
+		    key)))))))
 
 (defun render-text (text font)
-  (ftglRenderFont font text FTGL_RENDER_ALL))
+  (ftglRenderFont (getf font :id-font) text FTGL_RENDER_ALL))
-- 
2.39.2