[refactor] use trival-garbage finalizers to clean up gl resources

1 files changed, 35 insertions, 24 deletions

diff --git a/src/interactive/bitmap.lisp b/src/interactive/bitmap.lisp
index cc4b4f7..3d38503 100644
--- a/src/interactive/bitmap.lisp
+++ b/src/interactive/bitmap.lisp
@@ -2,16 +2,36 @@
 
 (in-package #:wheelwork)
 
+(defvar *bitmap-shader-program* nil
+  "Cached for later cleanup.")
+(defvar *bitmap-vao* nil)
+
+(defvar *bitmap-count* 0
+  "Used by finalizers to determin if the shader should be destroyed.")
+
+(defun bitmap-finalizer ()
+  "executed after a bitmap has been reclaimed by gc. decrements bitmap
+count and destroys shader-program if necessary."
+  (decf *bitmap-count*)
+  (when (zerop *bitmap-count*)
+    (when *bitmap-vao*
+      (gl:delete-vertex-arrays (list *bitmap-vao*))
+      (setf *bitmap-vao* nil))
+    (when *bitmap-shader-program*
+      (gl:delete-program *bitmap-shader-program*)
+      (setf *bitmap-shader-program* nil))))
+
 (defclass/std bitmap (affine interactive)
-  ((texture :ri :std (error "A bitmap requires a texture."))
-   (vao shader :with :r :static)))
+  ((texture :ri :std (error "A bitmap requires a texture."))))
 
 (defmethod initialize-instance :after ((bitmap bitmap) &key)
-  (with-slots (vao shader base-width base-height texture) bitmap
+  (incf *bitmap-count*)
+  (trivial-garbage:finalize bitmap #'bitmap-finalizer)
+  (with-slots (base-width base-height texture) bitmap
     (setf base-height (texture-height texture)
           base-width (texture-width texture))
-    (unless shader
-      (setf shader
+    (unless *bitmap-shader-program*
+      (setf *bitmap-shader-program*
             (create-shader
              '(:vertex
                ((vert :vec2))
@@ -27,12 +47,12 @@
                       (vari:discard)
                       frag))))))
       (gl:program-uniformi
-       shader
-       (gl:get-uniform-location shader "TEX")
+       *bitmap-shader-program*
+       (gl:get-uniform-location *bitmap-shader-program* "TEX")
        0))
-    (unless vao
-      (setf vao (gl:gen-vertex-array))
-      (gl:bind-vertex-array vao)
+    (unless *bitmap-vao*
+      (setf *bitmap-vao* (gl:gen-vertex-array))
+      (gl:bind-vertex-array *bitmap-vao*)
       (let ((vbo (gl:gen-buffer)))
         (with-gl-array (verts :float
                               0.0 1.0 
@@ -49,24 +69,15 @@
       (gl:bind-buffer :array-buffer 0)
       (gl:bind-vertex-array 0))))
 
-(defmethod cleanup ((bitmap bitmap))
-  (with-slots (vao shader) bitmap
-    (when vao
-      (gl:delete-vertex-arrays (list vao)))
-    (when shader
-      (gl:delete-program shader))
-    (setf vao nil
-          shader nil)))
-
 (defmethod render ((bitmap bitmap))
-  (with-slots (texture vao shader) bitmap
+  (with-slots (texture) bitmap
     (gl:active-texture 0)
     (gl:bind-texture :texture-2d (texture-id texture))
-    (gl:use-program shader)
+    (gl:use-program *bitmap-shader-program*)
     (gl:program-uniform-matrix-4fv
-     shader
-     (gl:get-uniform-location shader "TRANSFORM")
+     *bitmap-shader-program*
+     (gl:get-uniform-location *bitmap-shader-program* "TRANSFORM")
      (projected-matrix bitmap))
-    (gl:bind-vertex-array vao)    
+    (gl:bind-vertex-array *bitmap-vao*)    
     (gl:draw-arrays :triangles 0 6)
     (gl:bind-vertex-array 0)))