;;;; image.lisp

(in-package #:wheelwork)

(defvar *image-shader-program* nil
  "Cached for later cleanup.")
(defvar *image-vao* nil)

(defclass/std image (unit interactive)
  ((texture :ri :std (error "A image requires a texture."))
   (alpha :std 1.0)))

(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)
              (alpha :float))
             ((let ((frag  (vari:texture tex tc)))
                (setf (aref frag 3) (vari:clamp 0 (* alpha (aref frag 3)) 1))
                (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 alpha) 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:program-uniformf
     *image-shader-program*
     (gl:get-uniform-location *image-shader-program* "ALPHA")
     alpha)
    (gl:bind-vertex-array *image-vao*)    
    (gl:draw-arrays :triangles 0 6)
    (gl:bind-vertex-array 0)))