From def70bc521a71b3bfa8d8b0bb982bbcd1743bd22 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Wed, 27 Jul 2022 08:49:15 -0500 Subject: [refactor] to get rid of finalizers. [add] pre-exit-hooks --- src/application.lisp | 2 +- src/interactive/canvas.lisp | 39 ++++++++--------- src/interactive/image.lisp | 102 +++++++++++++++++++++++--------------------- src/pre-exit-hooks.lisp | 16 +++++++ wheelwork.asd | 1 + 5 files changed, 88 insertions(+), 72 deletions(-) create mode 100644 src/pre-exit-hooks.lisp 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))) diff --git a/wheelwork.asd b/wheelwork.asd index 6d578a1..c2fa044 100644 --- a/wheelwork.asd +++ b/wheelwork.asd @@ -21,6 +21,7 @@ (:file "utils") (:file "grid-geometry") (:file "region") + (:file "pre-exit-hooks") (:module "gl" :components ((:file "util") (:file "texture") -- cgit v1.2.3