;;;; units/text.lisp

(in-package #:wheelwork)

(def:class text (unit interactive)
  (font :prefix :ro :required :type font)
  (content :prefix :ro :type string :initform "")
  ((color "RGBA values")
   :prefix :type (vector float 4) :initform (vector 1.0 1.0 1.0 1.0))
  (vao elem-count newlines :ro :type (unsigned-byte 32))
  (shader :prefix :ro :allocation :class))

(defmethod model-matrix ((text text))
  (let ((m (mat:meye 4)))
    (with-slots (font newlines x y base-width base-height scale-x scale-y rotation) text 
      (let* ((text-height
               (cl-fond:text-height (font-object font)))
             (baseline-offset
              (* newlines text-height))
             (rotation-baseline-offset
               (* 2 newlines text-height )))
        (mat:nmtranslate
         m (vec:vec x
                    (+ y
                       (*
                        scale-y
                        baseline-offset))
                    0.0))

        (mat:nmtranslate
         m (vec:v* 0.5 (vec:vec (* scale-x base-width)
                                (* scale-y (- base-height rotation-baseline-offset) )
                                0.0)))
        (mat:nmrotate  m vec:+vz+ rotation)
        (mat:nmtranslate
         m (vec:v* -0.5 (vec:vec (* scale-x base-width )
                                 (* scale-y (- base-height rotation-baseline-offset))
                                 0.0))))
      
      (mat:nmscale m (vec:vec scale-x scale-y 1.0))
      m)))

(defvar *text-shader-program* nil)

(defun make-shared-text-gpu-objects ()
  (unless *text-shader-program*
    (setf *text-shader-program*
          (create-shader
           '(:vertex
             ((vert :vec2) (col :vec2))
             ((transform :mat4))
             ((values
               (* transform (vari:vec4 vert 0.0 1.0))
               col)))
           '(:fragment
             ((tc :vec2))
             ((tex :sampler-2d)
              (color :vec4))
             ((* color (aref (vari:texture tex tc) 0)))))))
  (unless (pre-exit-hook-exists-p :text-gpu-resources)
    (pre-exit-hook
     :text-gpu-resources
     (lambda ()
       (when *text-shader-program*
         (gl:delete-program *text-shader-program*)
         (setf *text-shader-program* nil))))))

(defmethod initialize-instance :after ((text text) &key)
  (with-slots (content newlines font vao elem-count base-width base-height scale-x scale-y) text
    (make-shared-text-gpu-objects)
    (multiple-value-bind (vao% count%) (cl-fond:compute-text (font-object font) content)
      (setf vao vao%
            elem-count count%))
    (setf newlines (count #\newline content))
    (let* ((extent
             (cl-fond:compute-extent (font-object font) content))
           (l
             (getf extent :l))
           (r
             (getf extent :r))) 
      (setf base-width (- r l)
            base-height (* (cl-fond:text-height (font-object font))
                           (1+ newlines))))))

(defmethod cleanup ((text text))
  (with-slots (vao) text
    (when vao 
      (gl:delete-vertex-arrays (list vao)))
    (setf vao nil)))

(defmethod render ((text text))
  (with-slots (font vao elem-count color) text
    (gl:use-program *text-shader-program*)
    (gl:active-texture 0)
    (gl:bind-texture :texture-2d (cl-fond:texture (font-object font)))
    (gl:program-uniform-matrix-4fv
     *text-shader-program* 
     (gl:get-uniform-location *text-shader-program* "TRANSFORM")
     (projected-matrix text))
    (gl:program-uniformi
     *text-shader-program*
     (gl:get-uniform-location *text-shader-program* "TEX")
     0)
    (gl:program-uniformfv
     *text-shader-program*
     (gl:get-uniform-location *text-shader-program* "COLOR")
     color)
    (gl:bind-vertex-array vao)
    (%gl:draw-elements :triangles elem-count :unsigned-int 0)
    (gl:bind-vertex-array 0)))