From: jsancho 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)))