summaryrefslogtreecommitdiff
path: root/2d
diff options
context:
space:
mode:
authorDavid Thompson <dave@izanagi>2013-06-23 15:31:30 -0400
committerDavid Thompson <dave@izanagi>2013-06-23 15:31:30 -0400
commit9425cf09a21e0299e0d61b677eb73aa5ed6100a7 (patch)
treead922c974bed08c08d497510b40e4b93ade835f2 /2d
parenta6c41ce1fe0ade2edaf37f7cbd12d4c307b1cd55 (diff)
Reap OpenGL textures when texture objects are GC'd.
Diffstat (limited to '2d')
-rw-r--r--2d/texture.scm25
1 files changed, 22 insertions, 3 deletions
diff --git a/2d/texture.scm b/2d/texture.scm
index 7a3a60d..9f53966 100644
--- a/2d/texture.scm
+++ b/2d/texture.scm
@@ -43,6 +43,23 @@
(width texture-width)
(height texture-height))
+;; Use a guardian and an after GC hook that ensures that OpenGL
+;; textures are deleted when texture objects are GC'd.
+(define texture-guardian (make-guardian))
+
+(define (reap-textures)
+ (let loop ((texture (texture-guardian)))
+ (when texture
+ ;; When attempting to reap structures upon guile exit, the
+ ;; dynamic pointer to gl-delete-textures becomes invalid. So, we
+ ;; ignore the error and move on.
+ (catch 'misc-error
+ (lambda () (gl-delete-textures (list (texture-id texture))))
+ (lambda (key . args) #f))
+ (loop (texture-guardian)))))
+
+(add-hook! after-gc-hook reap-textures)
+
(define (surface-pixel-format surface)
"Returns the OpenGL pixel format for a surface. RGB and RGBA formats
are supported."
@@ -72,9 +89,11 @@ Currently only works with RGBA format surfaces."
pixel-format
(color-pointer-type unsigned-byte)
(SDL:surface-pixels surface)))
- (make-texture texture-id
- (SDL:surface:w surface)
- (SDL:surface:h surface))))
+ (let ((texture (make-texture texture-id
+ (SDL:surface:w surface)
+ (SDL:surface:h surface))))
+ (texture-guardian texture)
+ texture)))
(define (load-texture filename)
"Loads a texture from a file."