(no commit message)

diff --git a/gacela.lisp b/gacela.lisp
index cd29c3e7e8a1a4a3c758eae9d975f275cba00cb9..45df43c9891388c4eb2a905a7474066d03c49eeb 100644 (file)
--- 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 a66adf9c34f74685d8231d08113742863b3e431b..c04fc8916fe1ac57e9b51e0b9fad5f3cbf255d8f 100644 (file)
--- 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 89d9b6803873520b641c4d9748246f60c269def6..63b4b2d6326df139dbddb059e6995d83847afd8e 100644 (file)
--- 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))