86 lines
2.9 KiB
Common Lisp
86 lines
2.9 KiB
Common Lisp
;;;; wh-engine/component.lisp
|
|
(in-package wh-engine)
|
|
|
|
(defclass component ()
|
|
((actor :documentation "The actor this component belongs to."
|
|
:reader actor
|
|
:type pointer
|
|
:initform nil)
|
|
(active-p :documentation "Whether or not this component is active."
|
|
:reader active-p
|
|
:type boolean
|
|
:initarg :active-p
|
|
:initform t)
|
|
(started-p :documentation "Whether or not this component has been started yet."
|
|
:reader started-p
|
|
:type boolean
|
|
:initform nil))
|
|
(:documentation "Base class for components attached to game entities."))
|
|
|
|
(defmethod make-load-form ((this component) &optional environment)
|
|
(make-generic-load-form this :environment environment))
|
|
|
|
(defmethod actor ((this component))
|
|
"The actor this component belongs to."
|
|
(deref-sus-pointer (o! this :slot actor)))
|
|
|
|
(defmethod scene ((this component))
|
|
"The scene this component belongs to."
|
|
(o! this actor scene))
|
|
|
|
(defmethod destroyed-p ((this component))
|
|
"If true, this component will be unloaded."
|
|
(o! this actor destroyed-p))
|
|
|
|
(defmethod attach ((this component) actor)
|
|
"Attach this component to an actor."
|
|
(setf (o! this :slot actor) (make-weak-pointer (ensure-live actor)))
|
|
(o! this (parent-changed)))
|
|
|
|
(defmethod parent-changed ((this component))
|
|
"Called when the component's actor's parent is changed."
|
|
nil)
|
|
|
|
(defmethod deactivate ((this component) &key origin)
|
|
"Deactivate this component."
|
|
(unless origin
|
|
(setf (o! this :slot active-p) nil)))
|
|
|
|
(defmethod activate ((this component) &key origin)
|
|
"Activate this component."
|
|
(unless origin
|
|
(setf (o! this :slot active-p) t)))
|
|
|
|
(defmethod resume ((this component))
|
|
"Initialize or restore this component's state."
|
|
(loop for slot in (sb-mop:class-slots (class-of this))
|
|
for slot-name = (sb-mop:slot-definition-name slot)
|
|
when (and (eq (sb-mop:slot-definition-allocation slot) :instance)
|
|
(slot-boundp this slot-name))
|
|
do (let ((value (slot-value this slot-name)))
|
|
(when (typep value 'id-ref)
|
|
(setf (slot-value this slot-name) (pointerize value))))
|
|
))
|
|
|
|
(defmethod suspend ((this component))
|
|
"Prepare this component for serialization."
|
|
(loop for slot in (sb-mop:class-slots (class-of this))
|
|
for slot-name = (sb-mop:slot-definition-name slot)
|
|
when (slot-boundp this slot-name)
|
|
do (let ((value (slot-value this slot-name)))
|
|
(when (typep value 'weak-pointer)
|
|
(setf (slot-value this slot-name) (referize value))))
|
|
))
|
|
|
|
(defmethod start ((this component))
|
|
"Called before (update) the first time this component is processed."
|
|
(setf (o! this :slot started-p) t))
|
|
|
|
(defmethod update ((this component))
|
|
"Called every game tick while this component and its actor are active."
|
|
nil)
|
|
|
|
(defmethod destroy ((this component))
|
|
"Called just before the component's actor is destroyed."
|
|
nil)
|