struct glTexture
{
GLuint texture_id;
+ int width, height;
};
static scm_t_bits glTexture_tag;
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)
{
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;
}
{
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));
(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)))