From 9425cf09a21e0299e0d61b677eb73aa5ed6100a7 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sun, 23 Jun 2013 15:31:30 -0400 Subject: Reap OpenGL textures when texture objects are GC'd. --- 2d/texture.scm | 25 ++++++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) (limited to '2d/texture.scm') 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." -- cgit v1.2.3