wh-engine/wh-engine/component.lisp

93 lines
3.1 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-load-form-saving-slots this :environment environment)
(make-generic-load-form this :environment environment))
(defmethod actor ((this component))
"The actor this component belongs to."
(deref-sus-pointer [this :slot actor]))
(defmethod scene ((this component))
"The scene this component belongs to."
[this actor scene])
(defmethod destroyed-p ((this component))
"If true, this component will be unloaded."
[this actor destroyed-p])
(defmethod attach ((this component) actor)
"Attach this component to an actor."
(setf [this :slot actor] (make-weak-pointer (ensure-live actor)))
[this (parent-changed)])
(defmethod parent-deactivated ((this component) parent)
"Called when the component's actor is deactivated."
nil)
(defmethod parent-activated ((this component) parent)
"Called when the component's actor is activated."
nil)
(defmethod parent-changed ((this component))
"Called when the component's actor's parent is changed."
nil)
(defmethod deactivate ((this component))
"Deactivate this component."
(setf [this :slot active-p] nil))
(defmethod activate ((this component))
"Activate this component."
(setf [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 [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)