X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=gacela.lisp;h=eecc4893ee41e5196887514e79932e302bb571d8;hb=4fe9bd9e78b0e3cee1133da2abcb05bc98322b31;hp=bf7cea34a889da6d1e6074d54a53858374673515;hpb=a43020f63638aee6921f1c6333b0d81fa72d4e11;p=gacela.git

diff --git a/gacela.lisp b/gacela.lisp
index bf7cea3..eecc489 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)))
 
@@ -98,18 +81,6 @@
   (glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST)
   t)
 
-(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 init-textures ()
-  (init-video-mode)
-  (glEnable GL_TEXTURE_2D))
-
 (defun init-lighting ()
   (init-video-mode)
   (glEnable GL_LIGHTING))
@@ -156,31 +127,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 +136,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))
 
@@ -252,16 +148,22 @@
 
 
 ;;; Resources Manager
-(defstruct resource plist free-function time)
-(defstruct texture filename min-filter mag-filter)
+(defstruct resource plist constructor destructor time)
 
-(let ((resources-table (make-hash-table :test 'equalp)))
+(defun make-resource-texture (&key filename min-filter mag-filter)
+  `(:type texture :filename ,filename :min-filter ,min-filter :mag-filter ,mag-filter))
 
-  (defun set-resource (key plist free-function &key static)
+(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 constructor destructor &key static)
     (setf (gethash key resources-table)
 	  (make-resource :plist plist
-			 :free-function free-function
-			 :time (if static -1 (SDL_GetTicks)))))
+			 :constructor constructor
+			 :destructor destructor
+			 :time (if static t (SDL_GetTicks)))))
 
   (defun get-resource (key)
     (let ((resource (gethash key resources-table)))
@@ -271,10 +173,12 @@
 		      (setf (gethash key resources-table) resource)))
 	       (resource-plist resource)))))
 
+  (defun free-resource (key)
+    (funcall (resource-destructor (gethash key resources-table)))
+    (setf (resource-time (gethash key resources-table)) nil))
+
   (defun free-all-resources ()
-    (maphash (lambda (key res) (funcall (resource-free-function res) (resource-address res)))
-	     resources-table)
-    (clrhash resources-table)))
+    (maphash (lambda (key res) (free-resource key)) resources-table)))
 
 
 ;;; Connection with the GUI