From 18b7b395aeba9aabdd47c52a0ae6bcd7d0f78f00 Mon Sep 17 00:00:00 2001 From: jsancho Date: Sun, 11 Oct 2009 21:50:15 +0000 Subject: [PATCH] --- gacela.lisp | 2 +- gacela_draw.lisp | 45 ++++++++++++++++++++++++--------------------- gacela_ttf.lisp | 27 +++++++++++++++------------ 3 files changed, 40 insertions(+), 34 deletions(-) diff --git a/gacela.lisp b/gacela.lisp index 8cd0da8..3f75376 100644 --- a/gacela.lisp +++ b/gacela.lisp @@ -172,7 +172,7 @@ :constructor constructor :destructor destructor :free-function free-function - :time (if static -1 (SDL_GetTicks))))) + :time (if static t (SDL_GetTicks))))) (defun get-resource (key) (let ((resource (gethash key resources-table))) diff --git a/gacela_draw.lisp b/gacela_draw.lisp index 4c96b58..31790da 100644 --- a/gacela_draw.lisp +++ b/gacela_draw.lisp @@ -75,27 +75,30 @@ (defun load-texture (filename &key (min-filter GL_LINEAR) (mag-filter GL_LINEAR) static) (let ((key (make-resource-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 - `(:id-texture ,texture :width ,real-w :height ,real-h) - (lambda () (load-texture filename :min-filter min-filter :mag-filter mag-filter :static static)) - (lambda () (glDeleteTextures 1 `(,texture))) - :static static) - key))))))))) + (t (true-load-texture filename min-filter mag-filter static))))) + +(defun true-load-texture (filename min-filter mag-filter static) + (let ((key (make-resource-texture :filename filename :min-filter min-filter :mag-filter mag-filter))) + (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 + `(:id-texture ,texture :width ,real-w :height ,real-h) + (lambda () (true-load-texture filename min-filter mag-filter static)) + (lambda () (glDeleteTextures 1 `(,texture))) + :static static) + key))))))) (defun draw-image-function (filename) (multiple-value-bind diff --git a/gacela_ttf.lisp b/gacela_ttf.lisp index 0077ad4..931f3c8 100644 --- a/gacela_ttf.lisp +++ b/gacela_ttf.lisp @@ -16,20 +16,23 @@ (in-package :gacela) -(defun open-font (font-file &key (size 80) (encoding ft_encoding_unicode) static) +(defun load-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) - (lambda () (open-font font-file :size size :encoding encoding :static static)) - (lambda () (ftglDestroyFont font)) - :static static) - key))))))) + (t (true-load-font font-file size encoding static))))) + +(defun true-load-font (font-file size encoding static) + (let ((key (make-resource-font :filename font-file :size size :encoding encoding)) + (font (ftglCreateTextureFont font-file))) + (cond ((/= font 0) + (ftglSetFontFaceSize font size 72) + (ftglSetFontCharMap font encoding) + (set-resource key + `(:id-font ,font) + (lambda () (true-load-font font-file size encoding static)) + (lambda () (ftglDestroyFont font)) + :static static) + key)))) (defun render-text (text font) (ftglRenderFont (getf font :id-font) text FTGL_RENDER_ALL)) -- 2.39.2