From: jsancho <devnull@localhost>
Date: Fri, 27 May 2011 12:04:11 +0000 (+0000)
Subject: (no commit message)
X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=16647eed5250375128894f6122be29ef15278ba3;p=gacela.git

---

diff --git a/src/gacela_GL.c b/src/gacela_GL.c
index 3bc341e..a031dba 100644
--- a/src/gacela_GL.c
+++ b/src/gacela_GL.c
@@ -24,6 +24,7 @@
 struct glTexture
 {
   GLuint texture_id;
+  int width, height;
 };
 
 static scm_t_bits glTexture_tag;
@@ -55,6 +56,26 @@ get_glTexture_id (SCM glTexture_smob)
   return glTexture->texture_id;
 }
 
+SCM
+get_glTexture_width (SCM glTexture_smob)
+{
+  struct glTexture *glTexture;
+
+  scm_assert_smob_type (glTexture_tag, glTexture_smob);
+  glTexture = (struct glTexture *) SCM_SMOB_DATA (glTexture_smob);
+  return scm_from_int (glTexture->width);
+}
+
+SCM
+get_glTexture_height (SCM glTexture_smob)
+{
+  struct glTexture *glTexture;
+
+  scm_assert_smob_type (glTexture_tag, glTexture_smob);
+  glTexture = (struct glTexture *) SCM_SMOB_DATA (glTexture_smob);
+  return scm_from_int (glTexture->height);
+}
+
 size_t
 free_glTexture (SCM glTexture_smob)
 {
@@ -238,7 +259,7 @@ gacela_glDeleteTextures (SCM n, SCM textures)
 SCM
 gacela_glBindTexture (SCM target, SCM texture)
 {
-  glBindTexture (scm_to_int (target), scm_to_int (texture));
+  glBindTexture (scm_to_int (target), get_glTexture_id (texture));
   return SCM_UNSPECIFIED;
 }
 
@@ -346,6 +367,8 @@ GL_register_functions (void* data)
 {
   glTexture_tag = scm_make_smob_type ("glTexture", sizeof (struct glTexture));
   scm_set_smob_free (glTexture_tag, free_glTexture);
+  scm_c_define_gsubr ("texture-w", 1, 0, 0, get_glTexture_width);
+  scm_c_define_gsubr ("texture-h", 1, 0, 0, get_glTexture_height);
 
   // Data types
   scm_c_define ("GL_UNSIGNED_BYTE", scm_from_int (GL_UNSIGNED_BYTE));
diff --git a/src/gacela_draw.scm b/src/gacela_draw.scm
index fbe21be..da18571 100644
--- a/src/gacela_draw.scm
+++ b/src/gacela_draw.scm
@@ -91,22 +91,17 @@
 	     (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)
-	       (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 (filename &ptional (zoom 1))
+	     texture))))))
+
+(define* (draw-image filename #:optional (zoom 1))
   (let ((texture (load-texture filename)))
     (cond (texture (draw-texture texture zoom)))))
 
-(defun draw-texture (texture &optional (zoom 1))
+(define* (draw-texture texture #:optional (zoom 1))
   (cond (texture
-	 (let ((width (getf (get-resource texture) :width))
-	       (height (getf (get-resource texture) :height)))
-	   (draw-rectangle (* zoom width) (* zoom height) :texture texture)))))
+	 (let ((width (texture-w texture))
+	       (height (texture-h texture)))
+	   (draw-rectangle (* zoom width) (* zoom height) #:texture texture)))))
 
 (defun draw-quad (v1 v2 v3 v4 &key texture)
   (let ((id-texture (getf (get-resource texture) :id-texture)))