(no commit message)

diff --git a/src/gacela.c b/src/gacela.c
index 18e2439eb967291ec36871040173aaff98a9d8ca..ec0108235128be798a4eade7f1af7d43b76f8483 100644 (file)
--- 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 af14ababba2f68106cb191a78c025a0ceb559428..643707e466fae7d0c9749b9e782cbfa2034aeee1 100644 (file)
--- 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 07ab34799965feb91908b8fb1f03305deccc696a..e20877f554a37b8896a0cf9e85ff246de7e815ea 100644 (file)
--- 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 f5f239b058227f26de033d599d0388259c4988cb..7dc912fa69909637e0642d830ea28d85b38c9f3c 100644 (file)
--- 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 c95abf5200e323d45465e89229d51e9fb7a29c9f..b75a44eb1cf91a4d1c1158db9c754a5c06687b0a 100644 (file)
--- a/src/gacela_misc.scm
+++ b/src/gacela_misc.scm
@@ -15,3 +15,8 @@
 ;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 
+(define (nearest-power-of-two n)
+  (define (power p n)
+    (cond ((> (* p 2) n) p)
+         (else (power (* p 2) n))))
+  (power 1 n))