diff options
Diffstat (limited to 'src/interactive')
| -rw-r--r-- | src/interactive/canvas.lisp | 39 | ||||
| -rw-r--r-- | src/interactive/image.lisp | 102 |
2 files changed, 70 insertions, 71 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 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 |