358 lines
12 KiB
Common Lisp
358 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
|
|
:initarg :scene
|
|
: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-generic-load-form this :environment environment))
|
|
|
|
(defmethod scene ((this actor))
|
|
"The scene containing this actor."
|
|
(deref-sus-pointer (o! this :slot scene)))
|
|
|
|
(defmethod parent ((this actor))
|
|
"This actor's parent."
|
|
(deref-sus-pointer (o! this :slot parent)))
|
|
|
|
(defmethod tree-active-p ((this actor))
|
|
"Whether or not this actor and all its parents are active."
|
|
(and (o! this active-p) (not (o! this :slot blocked-p))))
|
|
|
|
(defmethod apply-to-tree ((this actor) fun)
|
|
(funcall fun this)
|
|
(loop for child-ptr in (o! this children)
|
|
when (typep child-ptr 'weak-pointer)
|
|
do (o! (weak-pointer-value child-ptr) (apply-to-tree fun))))
|
|
|
|
(defmethod print-object ((this actor) stream)
|
|
(print-unreadable-object (this stream :type t :identity t)
|
|
(prin1 (o! this :slot id) stream)
|
|
(princ " ")
|
|
(prin1 (o! 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))
|
|
(o! this components)))
|
|
|
|
(defmethod add-component ((this actor) component)
|
|
"Add a component to this object."
|
|
(let ((component-class (class-of component)))
|
|
(when (o! this (get-component component-class))
|
|
(error "~S already has a component of class ~S" this component-class))
|
|
(push component (o! this :slot components))
|
|
(o! component (attach this)))
|
|
component)
|
|
|
|
(defmethod add-child ((this actor) child)
|
|
"Add a child to this object."
|
|
(when (o! child parent)
|
|
(error "~S is already a child of ~S" child (o! child parent)))
|
|
(push (make-weak-pointer child) (o! this :slot children))
|
|
(setf (o! child :slot parent) (make-weak-pointer this))
|
|
(o! child (parent-changed))
|
|
child)
|
|
|
|
(defmethod remove-child ((this actor) child)
|
|
"Remove a child from this object."
|
|
(unless (eq (o! child parent) this)
|
|
(error "~S is not a child of ~S" child this))
|
|
(setf (o! this :slot children) (delete child (o! this :slot children) :key #'deref-sus-pointer :count 1))
|
|
(setf (o! child :slot parent) nil)
|
|
(o! child (parent-changed))
|
|
child)
|
|
|
|
(defmethod recompute-blocked-p ((this actor))
|
|
"Determine if any ancestors of this actor are deactivated."
|
|
(setf (o! this :slot blocked-p)
|
|
(when (o! this parent) (or (not (o! this parent active-p)) (o! this parent :slot blocked-p)))))
|
|
|
|
(defmethod has-tag ((this actor) tag)
|
|
"Check if this object has the specified tag."
|
|
(find tag (o! this tags)))
|
|
|
|
(defmethod add-tag ((this actor) tag)
|
|
"Add a tag to this object."
|
|
(pushnew tag (o! this :slot tags)))
|
|
|
|
(defmethod remove-tag ((this actor) tag)
|
|
"Remove a tag from this object."
|
|
(setf (o! this :slot tags) (remove tag (o! this :slot tags))))
|
|
|
|
(defmethod parent-changed ((this actor))
|
|
"Called when the actor's parent is changed."
|
|
(o! this (recompute-blocked-p))
|
|
(loop for component in (o! this components)
|
|
do (o! component (parent-changed))))
|
|
|
|
(defmethod deactivate ((this actor) &key origin)
|
|
"Deactivate this object."
|
|
(o! this (recompute-blocked-p))
|
|
(unless origin
|
|
(setf (o! this :slot active-p) nil))
|
|
(loop for component in (o! this components)
|
|
do (o! component (deactivate :origin (or origin this))))
|
|
(loop for child-ptr in (o! this children)
|
|
for child = (weak-pointer-value child-ptr)
|
|
do (o! child (deactivate :origin (or origin this)))))
|
|
|
|
(defmethod activate ((this actor) &key origin)
|
|
"Activate this object."
|
|
(o! this (recompute-blocked-p))
|
|
(unless origin
|
|
(setf (o! this :slot active-p) t))
|
|
(when (o! this tree-active-p)
|
|
(loop for child-ptr in (o! this children)
|
|
for child = (weak-pointer-value child-ptr)
|
|
when (o! child active-p)
|
|
do (o! child (activate :origin (or origin this))))
|
|
(loop for component in (o! this components)
|
|
when (o! component active-p)
|
|
do (o! component (activate :origin (or origin this))))
|
|
))
|
|
|
|
(defmethod resume ((this actor))
|
|
"Initialize or restore this actor's state."
|
|
;; Restore self
|
|
(when (typep (o! this :slot scene) 'id-ref)
|
|
;; relink to scene
|
|
(let ((scene (get-scene (id-ref-scene (o! this :slot scene)))))
|
|
(setf (o! this :slot scene) nil)
|
|
(o! scene (add-actor this))))
|
|
(when (typep (o! this :slot parent) 'id-ref)
|
|
;; relink to parent
|
|
(let ((parent (o! this scene (get-actor (id-ref-actor (o! this :slot parent))))))
|
|
(setf (o! this :slot parent) nil)
|
|
(o! parent (add-child this))))
|
|
(loop for entry on (o! this :slot children)
|
|
when (typep (car entry) 'id-ref)
|
|
do (rplaca entry (pointerize (car entry))))
|
|
;; Restore components
|
|
(loop for component in (o! this components)
|
|
do (o! component (resume)))
|
|
;; Restore children
|
|
(loop for child-ptr in (o! this children)
|
|
for child = (weak-pointer-value child-ptr)
|
|
do (o! child (resume))))
|
|
|
|
(defmethod suspend ((this actor))
|
|
"Prepare this actor for serialization."
|
|
;; Suspend children
|
|
(loop for child-ptr in (o! this children)
|
|
for child = (weak-pointer-value child-ptr)
|
|
do (o! child (suspend)))
|
|
;; Suspend components
|
|
(loop for component in (o! this components)
|
|
do (o! component (suspend)))
|
|
;; Suspend self
|
|
(loop for child-cell on (o! this :slot children)
|
|
when (typep (car child-cell) 'weak-pointer)
|
|
do (rplaca child-cell (referize (car child-cell))))
|
|
(referize-setf (o! this :slot scene))
|
|
(referize-setf (o! this :slot parent)))
|
|
|
|
(defmethod update ((this actor))
|
|
"Update this actor's components."
|
|
(loop for component in (o! this components)
|
|
do (when (o! component active-p)
|
|
(unless (o! component started-p) (o! component (start)))
|
|
(o! component (update))))
|
|
; (loop for child in (o! this children)
|
|
; do (when (o! child active-p)
|
|
; (o! child (update))))
|
|
)
|
|
|
|
(defmethod destroy ((this actor))
|
|
"Mark this object for unloading."
|
|
(unless (o! this destroyed-p)
|
|
; Cleanup on aisle 5!
|
|
(loop for component in (o! this components)
|
|
when (o! component active-p)
|
|
do (o! component (destroy)))
|
|
; Remove from parent
|
|
(when (o! this parent)
|
|
(o! this parent (remove-child this)))
|
|
(loop for child-ptr in (o! this children)
|
|
for child = (deref-sus-pointer child-ptr)
|
|
do (o! child (destroy)))
|
|
(when (o! this scene)
|
|
(o! this scene (remove-actor this))))
|
|
(setf (o! this :slot destroyed-p) t))
|
|
|
|
;; Transform
|
|
|
|
(defmethod initialize-instance :after ((this actor) &key)
|
|
(o! this (recompute-matrix)))
|
|
|
|
(defmethod recompute-matrix ((this actor))
|
|
"Recompute the local-to-parent-space matrix."
|
|
(let ((rs (sin (o! this rotation)))
|
|
(rc (cos (o! this rotation)))
|
|
(sx (vx2 (o! this scale)))
|
|
(sy (vy2 (o! this scale)))
|
|
(tx (vx2 (o! this location)))
|
|
(ty (vy2 (o! this location))))
|
|
(with-fast-matref (m (o! 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 (o! this :slot location)) (vx2 new-val)
|
|
(vy2 (o! this :slot location)) (vy2 new-val))
|
|
(o! 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 (o! this :slot rotation) new-val)
|
|
(o! 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 (o! this :slot scale)) (vx2 new-val)
|
|
(vy2 (o! this :slot scale)) (vy2 new-val))
|
|
(o! this (recompute-matrix)))
|
|
|
|
(defmethod world-matrix ((this actor))
|
|
"The local-to-world-space transformation matrix for this actor."
|
|
(if (o! this parent)
|
|
(m* (o! this parent world-matrix) (o! this matrix))
|
|
(o! this matrix)))
|
|
|
|
(defmethod local-matrix ((this actor))
|
|
"The world-to-local-space transformation matrix for this actor."
|
|
(minv (o! this world-matrix)))
|
|
|
|
(defmethod world-location ((this actor))
|
|
"The world-space location of this actor."
|
|
(vxy (m* (o! 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* (o! this matrix) (vxy1 point))))
|
|
|
|
(defmethod world-point ((this actor) point)
|
|
"Transform point from local space to world space."
|
|
(declare (type vec2 point))
|
|
|
|
(vxy (m* (o! 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* (o! 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* (o! 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 (o! 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 (o! this location) (v+ (o! this location) vector)))
|
|
|
|
(defmethod rotate-by ((this actor) angle)
|
|
"Rotate this actor by the given angle."
|
|
(declare (type single-float angle))
|
|
|
|
(setf (o! this rotation) (+ (o! 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 (o! this scale) (v* (o! this scale) factor)))
|