362 lines
12 KiB
Common Lisp
362 lines
12 KiB
Common Lisp
;;;; wh-engine/actor.lisp
|
|
(in-package wh-engine)
|
|
|
|
(defclass actor ()
|
|
((id :documentation "This actor's unique ID."
|
|
:reader id
|
|
:type fixnum
|
|
:initarg :id
|
|
:initform (make-id))
|
|
(name :documentation "This actor's human-readable name."
|
|
:accessor name
|
|
:type string
|
|
:initarg :name
|
|
:initform "")
|
|
(scene :documentation "The scene containing this actor."
|
|
:reader scene
|
|
:type pointer
|
|
:initform nil)
|
|
(tags :documentation "This actor's tags."
|
|
:reader tags
|
|
:type (proper-list symbol)
|
|
:initarg :tags
|
|
:initform '(:default))
|
|
(active-p :documentation "Whether or not this actor should be processed."
|
|
:reader active-p
|
|
:type boolean
|
|
:initform t)
|
|
(blocked-p :documentation "Whether or not this actor has a deactivated ancestor."
|
|
:type boolean
|
|
:initform nil)
|
|
(parent :documentation "This actor's parent."
|
|
:reader parent
|
|
:type pointer
|
|
:initarg :parent
|
|
:initform nil)
|
|
(children :documentation "The actors this actor is a parent of."
|
|
:reader children
|
|
:type (proper-list pointer)
|
|
:initform nil)
|
|
(components :documentation "The components attached to this actor."
|
|
:reader components
|
|
:type (proper-list component)
|
|
:initform nil)
|
|
(destroyed-p :documentation "If true, this actor will be unloaded."
|
|
:reader destroyed-p
|
|
:type boolean
|
|
:initform nil)
|
|
;; Transform data
|
|
(location :documentation "The actor's location relative to its parent."
|
|
:reader location
|
|
:type vec2
|
|
:initarg :location
|
|
:initform (vec2 0 0))
|
|
(z-layer :documentation "The actor's Z layer."
|
|
:accessor z-layer
|
|
:type fixnum
|
|
:initarg :z-layer
|
|
:initform 0)
|
|
(rotation :documentation "The actor's rotation relative to its parent."
|
|
:reader rotation
|
|
:type single-float
|
|
:initarg :rotation
|
|
:initform 0.0)
|
|
(scale :documentation "The actor's scale relative to its parent."
|
|
:reader scale
|
|
:type vec2
|
|
:initarg :scale
|
|
:initform (vec2 1 1))
|
|
(matrix :documentation "Local-to-parent-space transformation matrix."
|
|
:reader matrix
|
|
:type mat3
|
|
:initform (meye 3)))
|
|
(:documentation "Base class for entities in the game."))
|
|
|
|
(defmethod make-load-form ((this actor) &optional environment)
|
|
(make-load-form-saving-slots this :environment environment))
|
|
|
|
(defmethod scene ((this actor))
|
|
"The scene containing this actor."
|
|
(deref-sus-pointer [this :slot scene]))
|
|
|
|
(defmethod parent ((this actor))
|
|
"This actor's parent."
|
|
(deref-sus-pointer [this :slot parent]))
|
|
|
|
(defmethod tree-active-p ((this actor))
|
|
"Whether or not this actor and all its parents are active."
|
|
(and [this active-p] (not [this :slot blocked-p])))
|
|
|
|
(defmethod print-object ((this actor) stream)
|
|
(print-unreadable-object (this stream :type t :identity t)
|
|
(prin1 [this :slot id] stream)
|
|
(princ " ")
|
|
(prin1 [this :slot name] stream)))
|
|
|
|
(defmethod get-component ((this actor) component-class)
|
|
"Get a component of the specified class attached to this object."
|
|
(find-if (lambda (component) (typep component component-class))
|
|
[this components]))
|
|
|
|
(defmethod add-component ((this actor) component)
|
|
"Add a component to this object."
|
|
(let ((component-class (class-of component)))
|
|
(when [this (get-component component-class)]
|
|
(error "~S already has a component of class ~S" this component-class))
|
|
(push component [this :slot components])
|
|
[component (attach this)])
|
|
component)
|
|
|
|
(defmethod add-child ((this actor) child)
|
|
"Add a child to this object."
|
|
(when [child parent]
|
|
(error "~S is already a child of ~S" child [child parent]))
|
|
(push (make-weak-pointer child) [this :slot children])
|
|
(setf [child :slot parent] (make-weak-pointer this))
|
|
[child (parent-changed)]
|
|
child)
|
|
|
|
(defmethod remove-child ((this actor) child)
|
|
"Remove a child from this object."
|
|
(unless (eq [child parent] this)
|
|
(error "~S is not a child of ~S" child this))
|
|
(setf [this :slot children] (delete child [this :slot children] :key #'deref-sus-pointer :count 1))
|
|
(setf [child :slot parent] nil)
|
|
[child (parent-changed)]
|
|
child)
|
|
|
|
(defmethod recompute-blocked-p ((this actor))
|
|
"Determine if any ancestors of this actor are deactivated."
|
|
(setf [this :slot blocked-p]
|
|
(when [this parent] (or (not [this parent active-p]) [this parent :slot blocked-p]))))
|
|
|
|
(defmethod has-tag ((this actor) tag)
|
|
"Check if this object has the specified tag."
|
|
(find tag [this tags]))
|
|
|
|
(defmethod add-tag ((this actor) tag)
|
|
"Add a tag to this object."
|
|
(pushnew tag [this :slot tags]))
|
|
|
|
(defmethod remove-tag ((this actor) tag)
|
|
"Remove a tag from this object."
|
|
(setf [this :slot tags] (remove tag [this :slot tags])))
|
|
|
|
(defmethod parent-deactivated ((this actor) parent)
|
|
"Called when the actor's parent is deactivated."
|
|
[this (recompute-blocked-p)]
|
|
(loop for component in [this components]
|
|
do [component (parent-deactivated parent)])
|
|
(loop for child-ptr in [this children]
|
|
for child = (weak-pointer-value child-ptr)
|
|
do [child (parent-deactivated parent)]))
|
|
|
|
(defmethod parent-activated ((this actor) parent)
|
|
"Called when the actor's parent is activated."
|
|
[this (recompute-blocked-p)]
|
|
(when [this tree-active-p]
|
|
(loop for child-ptr in [this children]
|
|
for child = (weak-pointer-value child-ptr)
|
|
do [child (parent-activated parent)])
|
|
(loop for component in [this components]
|
|
do [component (parent-activated parent)])))
|
|
|
|
(defmethod parent-changed ((this actor))
|
|
"Called when the actor's parent is changed."
|
|
[this (recompute-blocked-p)]
|
|
(loop for component in [this components]
|
|
do [component (parent-changed)]))
|
|
|
|
(defmethod deactivate ((this actor))
|
|
"Deactivate this object."
|
|
(setf [this :slot active-p] nil)
|
|
(loop for component in [this components]
|
|
do [component (parent-deactivated this)])
|
|
(loop for child-ptr in [this children]
|
|
for child = (weak-pointer-value child-ptr)
|
|
do [child (parent-deactivated this)]))
|
|
|
|
(defmethod activate ((this actor))
|
|
"Activate this object."
|
|
(setf [this :slot active-p] t)
|
|
(loop for child-ptr in [this children]
|
|
for child = (weak-pointer-value child-ptr)
|
|
do [child (parent-activated this)])
|
|
(loop for component in [this components]
|
|
do [component (parent-activated this)]))
|
|
|
|
(defmethod resume ((this actor))
|
|
"Initialize or restore this actor's state."
|
|
;; Restore self
|
|
(when (typep [this :slot scene] 'id-ref)
|
|
;; relink to scene
|
|
(let ((scene (get-scene (id-ref-scene [this :slot scene]))))
|
|
(setf [this :slot scene] nil)
|
|
[scene (add-actor this)]))
|
|
(when (typep [this :slot parent] 'id-ref)
|
|
;; relink to parent
|
|
(let ((parent [this scene (get-actor (id-ref-actor [this :slot parent]))]))
|
|
(setf [this :slot parent] nil)
|
|
[parent (add-child this)]))
|
|
(loop for entry on [this :slot children]
|
|
when (typep (car entry) 'id-ref)
|
|
do (rplaca entry (pointerize (car entry))))
|
|
;; Restore components
|
|
(loop for component in [this components]
|
|
do [component (resume)])
|
|
;; Restore children
|
|
(loop for child-ptr in [this children]
|
|
for child = (weak-pointer-value child-ptr)
|
|
do [child (resume)]))
|
|
|
|
(defmethod suspend ((this actor))
|
|
"Prepare this actor for serialization."
|
|
;; Suspend children
|
|
(loop for child-ptr in [this children]
|
|
for child = (weak-pointer-value child-ptr)
|
|
do [child (suspend)])
|
|
;; Suspend components
|
|
(loop for component in [this components]
|
|
do [component (suspend)])
|
|
;; Suspend self
|
|
(loop for child-cell on [this :slot children]
|
|
when (typep (car child-cell) 'weak-pointer)
|
|
do (rplaca child-cell (referize (car child-cell))))
|
|
(referize-setf [this :slot scene])
|
|
(referize-setf [this :slot parent]))
|
|
|
|
(defmethod update ((this actor))
|
|
"Update this actor's components."
|
|
(loop for component in [this components]
|
|
do (when [component active-p]
|
|
(unless [component started-p] [component (start)])
|
|
[component (update)]))
|
|
; (loop for child in [this children]
|
|
; do (when [child active-p]
|
|
; [child (.update)]))
|
|
)
|
|
|
|
(defmethod destroy ((this actor))
|
|
"Mark this object for unloading."
|
|
(unless [this destroyed-p]
|
|
; Cleanup on aisle 5!
|
|
(loop for component in [this components]
|
|
when [component active-p]
|
|
do [component (destroy)])
|
|
; Remove from parent
|
|
(when [this parent]
|
|
[this parent (remove-child this)])
|
|
(loop for child-ptr in [this children]
|
|
for child = (deref-sus-pointer child-ptr)
|
|
do [child (destroy)])
|
|
(when [this scene]
|
|
[this scene (remove-actor this)]))
|
|
(setf [this :slot destroyed-p] t))
|
|
|
|
;; Transform
|
|
|
|
(defmethod initialize-instance :after ((this actor) &key)
|
|
[this (recompute-matrix)])
|
|
|
|
(defmethod recompute-matrix ((this actor))
|
|
"Recompute the local-to-parent-space matrix."
|
|
(let ((rs (sin [this rotation]))
|
|
(rc (cos [this rotation]))
|
|
(sx (vx2 [this scale]))
|
|
(sy (vy2 [this scale]))
|
|
(tx (vx2 [this location]))
|
|
(ty (vy2 [this location])))
|
|
(with-fast-matref (m [this :slot matrix] 3)
|
|
(setf (m 0 0) (* sx rc)
|
|
(m 0 1) (* sy (- rs))
|
|
(m 0 2) tx
|
|
(m 1 0) (* sx rs)
|
|
(m 1 1) (* sy rc)
|
|
(m 1 2) ty)
|
|
)))
|
|
|
|
(defmethod (setf location) (new-val (this actor))
|
|
"The actor's location relative to its parent."
|
|
(declare (type vec2 new-val))
|
|
|
|
(setf (vx2 [this :slot location]) (vx2 new-val)
|
|
(vy2 [this :slot location]) (vy2 new-val))
|
|
[this (recompute-matrix)])
|
|
|
|
(defmethod (setf rotation) (new-val (this actor))
|
|
"The actor's rotation relative to its parent."
|
|
(declare (type single-float new-val))
|
|
|
|
(setf [this :slot rotation] new-val)
|
|
[this (recompute-matrix)])
|
|
|
|
(defmethod (setf scale) (new-val (this actor))
|
|
"The actor's scale relative to its parent."
|
|
(declare (type vec2 new-val))
|
|
|
|
(setf (vx2 [this :slot scale]) (vx2 new-val)
|
|
(vy2 [this :slot scale]) (vy2 new-val))
|
|
[this (recompute-matrix)])
|
|
|
|
(defmethod world-matrix ((this actor))
|
|
"The local-to-world-space transformation matrix for this actor."
|
|
(if [this parent]
|
|
(m* [this matrix] [this parent world-matrix])
|
|
[this matrix]))
|
|
|
|
(defmethod local-matrix ((this actor))
|
|
"The world-to-local-space transformation matrix for this actor."
|
|
(minv [this world-matrix]))
|
|
|
|
(defmethod world-location ((this actor))
|
|
"The world-space location of this actor."
|
|
(vxy (m* [this world-matrix] (vec3 0 0 1))))
|
|
|
|
(defmethod transform-point ((this actor) point)
|
|
"Transform point from local space to parent space."
|
|
(declare (type vec2 point))
|
|
|
|
(vxy (m* [this matrix] (vxy1 point))))
|
|
|
|
(defmethod world-point ((this actor) point)
|
|
"Transform point from local space to world space."
|
|
(declare (type vec2 point))
|
|
|
|
(vxy (m* [this world-matrix] (vxy1 point))))
|
|
|
|
(defmethod local-point ((this actor) point)
|
|
"Transform point from world space to local space."
|
|
(declare (type vec2 point))
|
|
|
|
(vxy (m* [this local-matrix] (vxy1 point))))
|
|
|
|
(defmethod transform-svector ((this actor) vector)
|
|
"Transform vector from local space to parent space."
|
|
(declare (type vec2 vector))
|
|
|
|
(vxy (m* [this matrix] (vxy_ vector))))
|
|
|
|
(defmethod transform-vector ((this actor) vector)
|
|
"Transform vector from local space to parent space, without changing its length."
|
|
(declare (type vec2 vector))
|
|
|
|
(nvscale [this (transform-svector vector)] (vlength vector)))
|
|
|
|
(defmethod translate-by ((this actor) vector)
|
|
"Translate this actor by the given vector in parent space."
|
|
(declare (type vec2 vector))
|
|
|
|
(setf [this location] (v+ [this location] vector)))
|
|
|
|
(defmethod rotate-by ((this actor) angle)
|
|
"Rotate this actor by the given angle."
|
|
(declare (type single-float angle))
|
|
|
|
(setf [this rotation] (+ [this rotation] angle)))
|
|
|
|
(defmethod scale-by ((this actor) factor)
|
|
"Scale this actor by the given factor (either a scalar or a vector)."
|
|
(declare (type (or single-float vec2) factor))
|
|
|
|
(setf [this scale] (v* [this scale] factor)))
|