From bdee8563b02a087d17f57c2536bd3b1eef721eaa Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sun, 4 Aug 2013 22:59:29 -0400 Subject: Ensure that all texture objects are added to the texture guardian. --- 2d/texture.scm | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) (limited to '2d/texture.scm') diff --git a/2d/texture.scm b/2d/texture.scm index 28b6482..06e127f 100644 --- a/2d/texture.scm +++ b/2d/texture.scm @@ -52,7 +52,7 @@ ;; The object is a simple wrapper around an OpenGL texture ;; id. (define-record-type - (make-texture id parent width height s1 t1 s2 t2) + (%make-texture id parent width height s1 t1 s2 t2) texture? (id texture-id) (parent texture-parent) @@ -66,6 +66,11 @@ (define (texture-region? texture) (texture? (texture-parent texture))) +(define (make-texture id parent width height s1 t1 s2 t2) + (let ((texture (%make-texture id parent width height s1 t1 s2 t2))) + (texture-guardian texture) + texture)) + (define (make-texture-region texture x y width height) "Creates a new texture region given a texture and a pixel region." (let* ((w (texture-width texture)) @@ -127,13 +132,11 @@ Currently only works with RGBA format surfaces." pixel-format (color-pointer-type unsigned-byte) (SDL:surface-pixels surface))) - (let ((texture (make-texture texture-id - #f - (SDL:surface:w surface) - (SDL:surface:h surface) - 0 0 1 1))) - (texture-guardian texture) - texture))) + (make-texture texture-id + #f + (SDL:surface:w surface) + (SDL:surface:h surface) + 0 0 1 1))) (define (load-texture filename) "Loads a texture from a file." -- cgit v1.2.3