From: jsancho <devnull@localhost>
Date: Wed, 25 May 2011 19:42:01 +0000 (+0000)
Subject: (no commit message)
X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=042f93e750461b4d7235f702c973f0bd1effcae9;p=gacela.git

---

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 <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))