1 files changed, 53 insertions, 49 deletions
diff --git a/src/interactive/image.lisp b/src/interactive/image.lisp
index 0089f57..1b3a817 100644
--- a/src/interactive/image.lisp
+++ b/src/interactive/image.lisp
@@ -14,63 +14,67 @@
 count and destroys shader-program if necessary."
   (decf *image-count*)
   (unless (plusp *image-count*)
-    (when *image-vao*
-      (gl:delete-vertex-arrays (list *image-vao*))
-      (setf *image-vao* nil))
-    (when *image-shader-program*
-      (gl:delete-program *image-shader-program*)
-      (setf *image-shader-program* nil))))
+    ))
 
 (defclass/std image (unit interactive)
   ((texture :ri :std (error "A image requires a texture."))))
 
+(defun make-shared-image-gpu-objects ()
+  (unless *image-shader-program*
+    (setf *image-shader-program*
+          (create-shader
+           '(:vertex
+             ((vert :vec2))
+             ((transform :mat4))
+             ((values
+               (* transform (vari:vec4 vert 0.0 1.0))
+               vert))) ;color
+           '(:fragment
+             ((tc :vec2))
+             ((tex :sampler-2d))
+             ((let ((frag  (vari:texture tex tc)))
+                (if (< (aref frag 3) 0.01)
+                    (vari:discard)
+                    frag))))))
+    (gl:program-uniformi
+     *image-shader-program*
+     (gl:get-uniform-location *image-shader-program* "TEX")
+     0))
+
+  (unless *image-vao*
+    (setf *image-vao* (gl:gen-vertex-array))
+    (gl:bind-vertex-array *image-vao*)
+    (let ((vbo (gl:gen-buffer)))
+      (with-gl-array (verts :float
+                            0.0 1.0 
+                            1.0 0.0 
+                            0.0 0.0 
+                            
+                            0.0 1.0 
+                            1.0 1.0 
+                            1.0 0.0 )
+        (gl:bind-buffer :array-buffer vbo)
+        (gl:buffer-data :array-buffer :static-draw verts)))
+    (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))
+
+  (unless (pre-exit-hook-exists-p :image-gpu-resources)
+    (pre-exit-hook :image-gpu-resources
+     (lambda ()
+       (when *image-vao*
+         (gl:delete-vertex-arrays (list *image-vao*))
+         (setf *image-vao* nil))
+       (when *image-shader-program*
+         (gl:delete-program *image-shader-program*)
+         (setf *image-shader-program* nil))))))
+
 (defmethod initialize-instance :after ((image image) &key)
-  (incf *image-count*)
-  (trivial-garbage:finalize image #'image-finalizer)
   (with-slots (base-width base-height texture) image
     (setf base-height (texture-height texture)
           base-width (texture-width texture))
-    (unless *image-shader-program*
-      (setf *image-shader-program*
-            (create-shader
-             '(:vertex
-               ((vert :vec2))
-               ((transform :mat4))
-               ((values
-                 (* transform (vari:vec4 vert 0.0 1.0))
-                 vert))) ;color
-             '(:fragment
-               ((tc :vec2))
-               ((tex :sampler-2d))
-               ((let ((frag  (vari:texture tex tc)))
-                  (if (< (aref frag 3) 0.01)
-                      (vari:discard)
-                      frag))))))
-      (gl:program-uniformi
-       *image-shader-program*
-       (gl:get-uniform-location *image-shader-program* "TEX")
-       0))
-    (unless *image-vao*
-      (setf *image-vao* (gl:gen-vertex-array))
-      (gl:bind-vertex-array *image-vao*)
-      (let ((vbo (gl:gen-buffer)))
-        (with-gl-array (verts :float
-                              0.0 1.0 
-                              1.0 0.0 
-                              0.0 0.0 
-                              
-                              0.0 1.0 
-                              1.0 1.0 
-                              1.0 0.0 )
-          (gl:bind-buffer :array-buffer vbo)
-          (gl:buffer-data :array-buffer :static-draw verts)))
-      (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))))
-
-(defmethod cleanup ((image image))
-  (image-finalizer))
+    (make-shared-image-gpu-objects)))
 
 (defmethod render ((image image))
   (with-slots (texture) image