[refactor] to get rid of finalizers. [add] pre-exit-hooks

1 files changed, 17 insertions, 22 deletions

diff --git a/src/interactive/canvas.lisp b/src/interactive/canvas.lisp
index aef8ebb..d870ae8 100644
--- a/src/interactive/canvas.lisp
+++ b/src/interactive/canvas.lisp
@@ -94,22 +94,8 @@ e.g., drawing a line in a particular color."
 
 (defvar *canvas-shader-program* nil)
 (defvar *canvas-render-vao* nil)
-(defvar *canvas-count* 0)
-
-(defun canvas-finalizer ()
-  (decf *canvas-count*)
-  (unless (plusp *canvas-count*)
-    (when *canvas-render-vao*
-      (gl:delete-vertex-arrays (list *canvas-render-vao*)))
-    (when *canvas-shader-program*
-      (gl:delete-program *canvas-shader-program*))
-    (setf-many *canvas-fbo-vao*
-               *canvas-render-vao*
-               *canvas-shader-program*
-               nil)))
-
-
-(defun make-shared-canvas-render-objects ()
+
+(defun make-shared-canvas-gpu-objects ()
   (setf
    ;; compile shader program
    *canvas-shader-program*
@@ -149,7 +135,19 @@ e.g., drawing a line in a particular color."
   (gl:enable-vertex-attrib-array 0)
   (gl:vertex-attrib-pointer 0 2 :float 0 (* +float-size+ 2) 0)
   (gl:bind-buffer :array-buffer 0)
-  (gl:bind-vertex-array 0))
+  (gl:bind-vertex-array 0)
+
+  (unless (pre-exit-hook-exists-p :canvas-gpu-resources )
+    (pre-exit-hook :canvas-gpu-resources
+                   (lambda ()
+                     (when *canvas-render-vao*
+                       (gl:delete-vertex-arrays (list *canvas-render-vao*)))
+                     (when *canvas-shader-program*
+                       (gl:delete-program *canvas-shader-program*))
+                     (setf-many *canvas-fbo-vao*
+                                *canvas-render-vao*
+                                *canvas-shader-program*
+                                nil)))))
 
 (defclass/std canvas (unit interactive pixels)
   ((fbo :with :r :doc "framebuffer object for use in off-screen-rendering of this canvas to a texture")
@@ -157,14 +155,11 @@ e.g., drawing a line in a particular color."
 
 (defmethod cleanup ((canvas canvas))
   (cleanup (canvas-texture canvas))
-  (gl:delete-framebuffers (list (canvas-fbo canvas)))
-  (canvas-finalizer))
+  (gl:delete-framebuffers (list (canvas-fbo canvas))))
 
 (defmethod initialize-instance :after ((canvas canvas) &key)
   (unless *canvas-shader-program*
-    (make-shared-canvas-render-objects))
-  (incf *canvas-count*)
-  (trivial-garbage:finalize canvas #'canvas-finalizer)
+    (make-shared-canvas-gpu-objects))
   (with-slots (texture fbo base-width base-height) canvas
     (setf texture   (make-instance
                      'texture