From b3a6fd3f78700080f0387cf20a52804624ec51ae Mon Sep 17 00:00:00 2001 From: ~keith Date: Tue, 14 Dec 2021 22:09:44 +0000 Subject: [PATCH] (suspend) and (resume) pointer conversion (for #3) --- wh-engine.asd | 1 + wh-engine/actor.lisp | 30 +++++++++++++++++++++--- wh-engine/component.lisp | 24 ++++++++++++++++++-- wh-engine/main.lisp | 18 +++++++-------- wh-engine/package.lisp | 8 +++++++ wh-engine/serialization.lisp | 44 ++++++++++++++++++++++++++++++++++++ 6 files changed, 111 insertions(+), 14 deletions(-) create mode 100644 wh-engine/serialization.lisp diff --git a/wh-engine.asd b/wh-engine.asd index 57f8ebd..115a466 100644 --- a/wh-engine.asd +++ b/wh-engine.asd @@ -11,6 +11,7 @@ ((:module "wh-engine" :components ((:file "package") (:file "main") + (:file "serialization") (:file "actor") (:file "component") (:file "scene") diff --git a/wh-engine/actor.lisp b/wh-engine/actor.lisp index c448af0..21c3210 100644 --- a/wh-engine/actor.lisp +++ b/wh-engine/actor.lisp @@ -14,7 +14,7 @@ :initform "") (scene :documentation "The scene containing this actor." :reader scene - :type (or weak-pointer null) + :type pointer :initform nil) (tags :documentation "This actor's tags." :reader tags @@ -30,12 +30,12 @@ :initform nil) (parent :documentation "This actor's parent." :reader parent - :type (or weak-pointer null) + :type pointer :initarg :parent :initform nil) (children :documentation "The actors this actor is a parent of." :reader children - :type (proper-list weak-pointer) + :type (proper-list pointer) :initform nil) (components :documentation "The components attached to this actor." :reader components @@ -181,6 +181,30 @@ (loop for component in [this components] do [component (parent-activated this)])) +(defmethod resume ((this actor)) + "Initialize or restore this actor's state." + ; Restore self + (resume-setf [this :slot scene]) + (resume-setf [this :slot parent]) + (loop for entry on [this :slot children] + when (typep (car entry) 'id-ref) + do (rplaca entry (resume-ptr (car entry)))) + ; Restore components + (loop for component in [this components] + do [component (resume)])) + +(defmethod suspend ((this actor)) + "Prepare this actor for serialization." + ; Suspend components + (loop for component in [this components] + do [component (suspend)]) + ; Suspend self + (loop for entry on [this :slot children] + when (typep (car entry) 'weak-pointer) + do (rplaca entry (suspend-ptr (car entry)))) + (suspend-setf [this :slot scene]) + (suspend-setf [this :slot parent])) + (defmethod update ((this actor)) "Update this actor's components." (loop for component in [this components] diff --git a/wh-engine/component.lisp b/wh-engine/component.lisp index 505c7f2..b2405df 100644 --- a/wh-engine/component.lisp +++ b/wh-engine/component.lisp @@ -4,7 +4,7 @@ (defclass component () ((actor :documentation "The actor this component belongs to." :reader actor - :type (or weak-pointer null) + :type pointer :initform nil) (active-p :documentation "Whether or not this component is active." :reader active-p @@ -54,8 +54,28 @@ "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 (slot-boundp this slot-name) + do (let ((value (slot-value this slot-name))) + (when (typep value id-ref) + (setf (slot-value this slot-name) (resume-ptr 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) (suspend-ptr value)))) + )) + (defmethod start ((this component)) - "Called before on-update the first time this component is processed." + "Called before (update) the first time this component is processed." (setf [this :slot started-p] t)) (defmethod update ((this component)) diff --git a/wh-engine/main.lisp b/wh-engine/main.lisp index e15d19c..c05c4fe 100644 --- a/wh-engine/main.lisp +++ b/wh-engine/main.lisp @@ -183,15 +183,15 @@ (update-all-scenes) (gl:clear :color-buffer) (let ((render-pass nil)) - (loop for view-ptr in *world-views* - for view = (ensure-live (weak-pointer-value view-ptr)) - when (and [view active-p] [view actor tree-active-p]) - do (progn - (unless (eq [view render-pass] render-pass) - (setf render-pass [view render-pass]) - (gl:clear :depth-buffer) - ) - [view (render-view *world-drawables*)]))) + (loop for view-ptr in *world-views* + for view = (ensure-live (weak-pointer-value view-ptr)) + when (and [view active-p] [view actor tree-active-p]) + do (progn + (unless (eq [view render-pass] render-pass) + (setf render-pass [view render-pass]) + (gl:clear :depth-buffer) + ) + [view (render-view *world-drawables*)]))) (gl:flush) (sdl2:gl-swap-window win))) )))) diff --git a/wh-engine/package.lisp b/wh-engine/package.lisp index 69a41e0..16dc3d6 100644 --- a/wh-engine/package.lisp +++ b/wh-engine/package.lisp @@ -18,6 +18,12 @@ register-test-scene run + ;; serialization.lisp + id-ref make-id-ref + pointer + suspend-ptr resume-ptr + suspend-setf resume-setf + ;; actor.lisp actor ; properties @@ -33,6 +39,7 @@ has-tag add-tag remove-tag parent-deactivated parent-activated parent-changed deactivate activate + resume suspend update destroy transform-point world-point local-point @@ -49,6 +56,7 @@ attach parent-deactivated parent-activated parent-changed deactivate activate + resume suspend start update destroy diff --git a/wh-engine/serialization.lisp b/wh-engine/serialization.lisp new file mode 100644 index 0000000..2f253a8 --- /dev/null +++ b/wh-engine/serialization.lisp @@ -0,0 +1,44 @@ + ;;;; wh-engine/serialization.lisp +(in-package wh-engine) + +(defstruct id-ref + (scene 0 :type fixnum) + (actor nil :type (or fixnum null)) + (component nil :type (or symbol null))) + +(deftype pointer () '(or id-ref weak-pointer null)) + +(defun suspend-ptr (ptr) + "Convert weak-pointer ptr to an id-ref." + (declare (type weak-pointer ptr)) + + (let (target (weak-pointer-value ptr)) + (cond + ((typep target 'scene) + (make-id-ref :scene [target id])) + ((typep target 'actor) + (make-id-ref :scene [target scene id] + :actor [target id])) + ((typep target 'component) + (make-id-ref :scene [target scene id] + :actor [target actor id] + :component (class-name (class-of target)))) + (t ptr)))) + +(defun resume-ptr (ref) + "Convert id-ref ref to a weak-pointer." + (declare (type id-ref ref)) + + (let ((scene (get-scene (id-ref-scene ref))) actor component) + (if (setf actor [scene (get-actor (id-ref-actor ref))]) + (if (setf component [actor (get-component (find-class (id-ref-component ref)))]) + (make-weak-pointer component) + (make-weak-pointer actor)) + (make-weak-pointer scene)))) + +(defmacro suspend-setf (place) + `(when (typep ,place 'weak-pointer) + (setf ,place (suspend-ptr ,place)))) +(defmacro resume-setf (place) + `(when (typep ,place 'id-ref) + (setf ,place (resume-ptr ,place))))