From 042f93e750461b4d7235f702c973f0bd1effcae9 Mon Sep 17 00:00:00 2001 From: jsancho Date: Wed, 25 May 2011 19:42:01 +0000 Subject: [PATCH] --- src/gacela.c | 1 + src/gacela_FTGL.c | 3 +-- src/gacela_SDL.c | 6 +++--- src/gacela_draw.scm | 43 ++++++++++++++++++------------------------- src/gacela_misc.scm | 5 +++++ 5 files changed, 28 insertions(+), 30 deletions(-) diff --git a/src/gacela.c b/src/gacela.c index 18e2439..ec01082 100644 --- a/src/gacela.c +++ b/src/gacela.c @@ -59,6 +59,7 @@ main (int argc, char *argv[]) scm_c_eval_string ("(use-modules (ice-9 readline))"); scm_c_eval_string ("(activate-readline)"); scm_c_eval_string ("(use-modules (ice-9 optargs))"); + scm_c_eval_string ("(use-modules (ice-9 receive))"); load_scheme_files (dirname (argv[0])); scm_shell (argc, argv); } diff --git a/src/gacela_FTGL.c b/src/gacela_FTGL.c index af14aba..643707e 100644 --- a/src/gacela_FTGL.c +++ b/src/gacela_FTGL.c @@ -100,8 +100,7 @@ gacela_ftglCreateTextureFont (SCM file) return make_font (file, font_address); } else { - // return SCM_UNSPECIFIED; - return SCM_UNDEFINED; + return SCM_BOOL_F; } } diff --git a/src/gacela_SDL.c b/src/gacela_SDL.c index 07ab347..e20877f 100644 --- a/src/gacela_SDL.c +++ b/src/gacela_SDL.c @@ -133,7 +133,7 @@ gacela_SDL_SetVideoMode (SCM width, SCM height, SCM bpp, SCM flags) return make_surface (scm_from_locale_string ("screen"), screen); } else { - return SCM_UNSPECIFIED; + return SCM_BOOL_F; } } @@ -190,7 +190,7 @@ gacela_SDL_LoadBMP (SCM file) return make_surface (file, image); } else { - return SCM_UNSPECIFIED; + return SCM_BOOL_F; } } @@ -203,7 +203,7 @@ gacela_IMG_Load (SCM filename) return make_surface (filename, image); } else { - return SCM_UNSPECIFIED; + return SCM_BOOL_F; } } diff --git a/src/gacela_draw.scm b/src/gacela_draw.scm index f5f239b..7dc912f 100644 --- a/src/gacela_draw.scm +++ b/src/gacela_draw.scm @@ -62,40 +62,33 @@ (define (load-image-for-texture filename) (init-video-mode) (let ((image (IMG_Load filename))) - (cond ((not (= image 0)) - (let* ((width (surface-w image)) (height (surface-h image)) + (cond (image + (let* ((width (get-surface-width image)) (height (get-surface-height image)) (power-2 (nearest-power-of-two (min width height))) - resized-image) + (resized-image #f)) (cond ((and (= width power-2) (= height power-2)) (values image width height)) - (t (setq resized-image (resize-surface image power-2 power-2)) - (SDL_FreeSurface image) - (cond ((/= resized-image 0) (values resized-image width height)))))))))) + (else (set! resized-image (resize-surface image power-2 power-2)) + (if resized-image (values resized-image width height))))))))) -(defun resize-surface (surface width height) - (let ((old-width (surface-w surface)) (old-height (surface-h surface))) +(define (resize-surface surface width height) + (let ((old-width (get-surface-width surface)) (old-height (get-surface-height surface))) (cond ((and (= width old-width) (= height old-height)) surface) - (t (let ((zoomx (/ (+ width 0.5) old-width)) (zoomy (/ (+ height 0.5) old-height))) + (else (let ((zoomx (/ (+ width 0.5) old-width)) (zoomy (/ (+ height 0.5) old-height))) (zoomSurface surface zoomx zoomy 0)))))) -(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 (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) +(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 (get-surface-width image)) (height (get-surface-height 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)))) + (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)) + (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) diff --git a/src/gacela_misc.scm b/src/gacela_misc.scm index c95abf5..b75a44e 100644 --- a/src/gacela_misc.scm +++ b/src/gacela_misc.scm @@ -15,3 +15,8 @@ ;;; along with this program. If not, see . +(define (nearest-power-of-two n) + (define (power p n) + (cond ((> (* p 2) n) p) + (else (power (* p 2) n)))) + (power 1 n)) -- 2.39.2