97 lines
4.0 KiB
Common Lisp
97 lines
4.0 KiB
Common Lisp
;;;; 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) [(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))
|
|
(: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 [this :slot render-pass] new-val)
|
|
(sort-world-views))
|
|
|
|
(defmethod start :after ((this view))
|
|
; Register
|
|
(pushnew (make-weak-pointer this) *world-views*)
|
|
(sort-world-views))
|
|
|
|
(defmethod destroy :before ((this view))
|
|
(unless [this destroyed-p]
|
|
; Unregister
|
|
(setf *world-views* (delete this *world-views* :key #'weak-pointer-value))))
|
|
|
|
(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)
|
|
[this actor local-matrix]))
|
|
|
|
(defmethod world-matrix ((this view))
|
|
"The view-to-world-space transformation matrix for this object."
|
|
(minv [this view-matrix]))
|
|
|
|
(defmethod view-point ((this view) point)
|
|
"Transform point from world space to view space."
|
|
(declare (type vec2 point))
|
|
|
|
(vxy-trunc (m* [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 [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 [drawable active-p] [drawable actor tree-active-p]
|
|
(some (lambda (x) [drawable actor (has-tag x)]) [this render-mask]))
|
|
do [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 [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 [drawable actor world-matrix]))
|
|
(when (or (not [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 [drawable actor z-layer])
|
|
(gl:mult-transpose-matrix (opengl-matrix drawable-matrix))
|
|
[drawable (draw this)]
|
|
(gl:pop-matrix))))
|