aboutsummaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
authorColin Okay <colin@cicadas.surf>2022-07-27 08:49:15 -0500
committerColin Okay <colin@cicadas.surf>2022-07-27 08:49:15 -0500
commitdef70bc521a71b3bfa8d8b0bb982bbcd1743bd22 (patch)
tree0737d55c92934f6500c3e515a9a2b88ec9d326c8 /src
parent4ec779a31486fdedf038c35f975723b3abc04c8c (diff)
[refactor] to get rid of finalizers. [add] pre-exit-hooks
Diffstat (limited to 'src')
-rw-r--r--src/application.lisp2
-rw-r--r--src/interactive/canvas.lisp39
-rw-r--r--src/interactive/image.lisp102
-rw-r--r--src/pre-exit-hooks.lisp16
4 files changed, 87 insertions, 72 deletions
diff --git a/src/application.lisp b/src/application.lisp
index 5b6e9ad..6869a56 100644
--- a/src/application.lisp
+++ b/src/application.lisp
@@ -96,7 +96,7 @@
(dolist (unit (application-scene app))
(drop-unit unit)
(cleanup unit))
- (trivial-garbage:gc :full t))
+ (pre-exit-hooks))
(defun run-perframe (app)
"Runs all of the handlers objects listening for perframe events, if
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
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
diff --git a/src/pre-exit-hooks.lisp b/src/pre-exit-hooks.lisp
new file mode 100644
index 0000000..42e4195
--- /dev/null
+++ b/src/pre-exit-hooks.lisp
@@ -0,0 +1,16 @@
+;;; pre-exit-hooks.lisp
+
+(in-package :wheelwork)
+
+(defvar *pre-exit-hooks* (make-hash-table))
+
+(defun pre-exit-hook-exists-p (tag)
+ (gethash tag *pre-exit-hooks*))
+
+(defun pre-exit-hook (tag thunk)
+ (setf (gethash tag *pre-exit-hooks*)
+ thunk))
+
+(defun pre-exit-hooks ()
+ (loop for thunk being the hash-value of *pre-exit-hooks*
+ do (funcall thunk)))