;;;; wh-engine/render/view.lisp
(in-package wh-engine)

(defun sort-world-views ()
  "Re-sort the *world-views* list by render pass."
  (sort *world-views* #'< :key (lambda (v) (o! (deref-pointer v) render-pass))))

(defclass view (component)
  ((render-pass :documentation "The render pass this view should be drawn in."
                :reader render-pass
                :type fixnum
                :initarg :render-pass
                :initform 0)
   (render-mask :documentation "Only include actors with at least one of these tags."
                :accessor render-mask
                :type (proper-list symbol)
                :initarg :render-mask
                :initform '(:default))
   (cull-p :documentation "Whether or not to skip rendering out-of-frame objects."
           :accessor cull-p
           :type boolean
           :initarg :cull-p
           :initform t)
   (framebuffer :documentation "The GL framebuffer this view renders to."
                :reader framebuffer
                :type (or fixnum null)
                :initform nil)
   (renderbuffer :documentation "The GL renderbuffer this view renders depth & stencil data to."
                 :reader renderbuffer
                 :type (or fixnum null)
                 :initform nil)
   (render-texture :documentation "The GL render texture this view renders color data to."
                   :reader render-texture
                   :type (or fixnum null)
                   :initform nil))
  (:documentation "Defines a view into the scene, and rendering settings for objects drawn by the view."))

(defmethod (setf render-pass) (new-val (this view))
  "The render pass this view should be drawn in."
  (setf (o! this :slot render-pass) new-val)
  (sort-world-views))

(defmethod resume :after ((this view))
  ;; create render texture & framebuffer
  (unless (and (o! this render-texture) (gl:texture-resident-p (o! this render-texture))
               (o! this renderbuffer) (gl:is-renderbuffer (o! this renderbuffer))
               (o! this framebuffer) (gl:is-framebuffer (o! this framebuffer)))
    ;; ensure the old ones are deleted if they exist
    (when (o! this framebuffer)
      (gl:delete-framebuffers (list (o! this framebuffer))))
    (when (o! this render-texture)
      (gl:delete-texture (o! this render-texture)))
    (when (o! this renderbuffer)
      (gl:delete-renderbuffers (list (o! this renderbuffer))))
    ;; create render texture
    (setf (o! this :slot render-texture) (gl:gen-texture))
    (gl:bind-texture :texture-2d (o! this render-texture))
    (gl:tex-image-2d :texture-2d 0 :rgba
                     *view-width* *view-height*
                     0 :rgba :unsigned-byte (cffi:null-pointer))
    (gl:tex-parameter :texture-2d :texture-wrap-s :clamp-to-edge)
    (gl:tex-parameter :texture-2d :texture-wrap-t :clamp-to-edge)
    (gl:tex-parameter :texture-2d :texture-min-filter :linear)
    (gl:tex-parameter :texture-2d :texture-mag-filter :linear)
    (gl:bind-texture :texture-2d 0)
    ;; create renderbuffer
    (setf (o! this :slot renderbuffer) (gl:gen-renderbuffer))
    (gl:bind-renderbuffer :renderbuffer (o! this renderbuffer))
    (gl:renderbuffer-storage :renderbuffer :depth24-stencil8 *view-width* *view-height*)
    (gl:bind-renderbuffer 0)
    ;; create framebuffer
    (setf (o! this :slot framebuffer) (gl:gen-framebuffer))
    (gl:bind-framebuffer :framebuffer (o! this framebuffer))
    (gl:framebuffer-texture-2d :framebuffer :color-attachment0 :texture-2d (o! this render-texture) 0)
    (gl:framebuffer-renderbuffer :framebuffer :depth-stencil-attachment :renderbuffer (o! this renderbuffer))
    (gl:bind-framebuffer 0)
    ))

(defmethod activate :after ((this view) &key)
  ; Register
  (pushnew (make-weak-pointer this) *world-views*)
  (sort-world-views))

(defmethod destroy :before ((this view))
  (unless (o! this destroyed-p)
    ;; Unregister
    (setf *world-views* (delete this *world-views* :key #'weak-pointer-value))
    ;; Destroy buffers
    (when (o! this framebuffer)
      (gl:delete-framebuffers (list (o! this framebuffer))))
    (when (o! this render-texture)
      (gl:delete-texture (o! this render-texture)))
    (when (o! this renderbuffer)
      (gl:delete-renderbuffers (list (o! this renderbuffer))))
    ))

(defmethod view-matrix ((this view))
  "The world-to-view-space transformation matrix for this object."
  ;; view-space = local-space, scaled by ppu, then offset so [-width/2..width/2] -> [0..width]
  ;; (Y+ is still up in view-space)
  (m* (mat *view-ppu* 0 (/ *view-width* 2)
           0 *view-ppu* (/ *view-height* 2)
           0 0 1)
      (o! this actor local-matrix)))

(defmethod world-matrix ((this view))
  "The view-to-world-space transformation matrix for this object."
  (minv (o! this view-matrix)))

(defmethod view-point ((this view) point)
  "Transform point from world space to view space."
  (declare (type vec2 point))

  (vxy-trunc (m* (o! this view-matrix) (vxy1 point))))

(defmethod render-view ((this view) drawables)
  "Render everything in this view, given all drawables in the world."
  (let ((view-matrix (o! this view-matrix)))
    ;; Apply view matrix
    (gl:matrix-mode :modelview)
    (gl:load-transpose-matrix (opengl-matrix view-matrix))
    (loop for drawable-ptr in drawables
          for drawable = (deref-pointer drawable-ptr)
          when (and drawable (ensure-live drawable))
            when (and (o! drawable active-p) (o! drawable actor tree-active-p)
                      (some (lambda (x) (o! drawable actor (has-tag x))) (o! this render-mask)))
              do (o! this (render-drawable drawable view-matrix)))
    ))

(defun in-view-p (drawable drawable-matrix view-matrix view-box)
  "Determine if drawable is in the view defined by view-matrix and view-box."
  (let ((drawable-culling-box (o! drawable culling-box))
        box-a box-b)
    (setf box-a (vxy-trunc (m* view-matrix
                               (m* drawable-matrix (vxy1 (car drawable-culling-box))))))
    (setf box-b (vxy-trunc (m* view-matrix
                               (m* drawable-matrix (vxy1 (cdr drawable-culling-box))))))
    ;; If it's in view at all, either its top-right corner is >= bottom-left of view,
    ;; or its bottom-left is <= top-right of view
    (or (v>= (vmax box-a box-b) (car view-box))
        (v<= (vmin box-a box-b) (cdr view-box)))))

(defmethod render-drawable ((this view) drawable view-matrix)
  "Render drawable with the precomputed view-matrix."
  (let ((drawable-matrix (o! drawable actor world-matrix)))
    (when (or (not (o! this cull-p)) (in-view-p drawable drawable-matrix view-matrix
                                             (cons (vec2 0 0) (vec2 *view-width* *view-height*))))
      (gl:push-matrix)
      (gl:translate 0 0 (o! drawable actor z-layer))
      (gl:mult-transpose-matrix (opengl-matrix drawable-matrix))
      (o! drawable (draw this))
      (gl:pop-matrix))))