;;;; image.lisp (in-package #:wheelwork) (defvar *image-shader-program* nil "Cached for later cleanup.") (defvar *image-vao* nil) (defvar *image-count* 0 "Used by finalizers to determin if the shader should be destroyed.") (defun image-finalizer () "executed after a image has been reclaimed by gc. decrements image count and destroys shader-program if necessary." (decf *image-count*) (unless (plusp *image-count*) )) (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) (with-slots (base-width base-height texture) image (setf base-height (texture-height texture) base-width (texture-width texture)) (make-shared-image-gpu-objects))) (defmethod render ((image image)) (with-slots (texture) image (gl:active-texture 0) (gl:bind-texture :texture-2d (texture-id texture)) (gl:use-program *image-shader-program*) (gl:program-uniform-matrix-4fv *image-shader-program* (gl:get-uniform-location *image-shader-program* "TRANSFORM") (projected-matrix image)) (gl:bind-vertex-array *image-vao*) (gl:draw-arrays :triangles 0 6) (gl:bind-vertex-array 0)))