From 38447b2c7eff4102b99b817a9054d49c27aca1e2 Mon Sep 17 00:00:00 2001 From: ~keith Date: Tue, 22 Feb 2022 19:02:52 +0000 Subject: [PATCH] Fix actors being GC'd during initialization (closes #9) --- wh-engine/actor.lisp | 53 ++++++++++++++++++------------------ wh-engine/main.lisp | 4 +-- wh-engine/package.lisp | 5 ++-- wh-engine/scene.lisp | 5 ++-- wh-engine/serialization.lisp | 36 +++++++++++++++--------- 5 files changed, 57 insertions(+), 46 deletions(-) diff --git a/wh-engine/actor.lisp b/wh-engine/actor.lisp index 984b633..2b76058 100644 --- a/wh-engine/actor.lisp +++ b/wh-engine/actor.lisp @@ -36,7 +36,7 @@ :initform nil) (children :documentation "The actors this actor is a parent of." :reader children - :type (proper-list pointer) + :type (proper-list (or actor id-ref)) :initform nil) (components :documentation "The components attached to this actor." :reader components @@ -89,13 +89,11 @@ (and (o! this active-p) (not (o! this :slot blocked-p)))) (defmethod apply-to-tree ((this actor) fun) + "Apply fun to this actor and all its children recursively." (funcall fun this) - (loop for child-ptr in (o! this children) - when (typep child-ptr 'weak-pointer) - do (let ((child (weak-pointer-value child-ptr))) - (unless child - (error "nil value dereferencing child-ptr in ~S" this)) - (o! child (apply-to-tree fun))))) + (loop for child in (o! this children) + when (typep child 'actor) + do (o! child (apply-to-tree fun)))) (defmethod print-object ((this actor) stream) (print-unreadable-object (this stream :type t :identity t) @@ -111,7 +109,7 @@ "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)) + (error "~S already has a component of class ~S" this component-class)) (push component (o! this :slot components)) (o! component (attach this))) component) @@ -119,8 +117,12 @@ (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)) + (error "~S is already a child of ~S" child (o! child parent))) + (unless (find-if (lambda (x) (etypecase x + (actor (eq x child)) + (id-ref (eq (id-ref-actor x) (o! child id))))) + (o! this :slot children)) + (push child (o! this :slot children))) (setf (o! child :slot parent) (make-weak-pointer this)) (o! child (parent-changed)) child) @@ -129,7 +131,11 @@ "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! this :slot children) + (delete-if (lambda (x) (etypecase x + (actor (eq x child)) + (id-ref (eq (id-ref-actor x) (o! child id))))) + (o! this :slot children) :count 1)) (setf (o! child :slot parent) nil) (o! child (parent-changed)) child) @@ -164,8 +170,7 @@ (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) + (loop for child in (o! this children) do (o! child (deactivate :origin (or origin this))))) (defmethod activate ((this actor) &key origin) @@ -174,8 +179,7 @@ (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) + (loop for child in (o! this children) when (o! child active-p) do (o! child (activate :origin (or origin this)))) (loop for component in (o! this components) @@ -185,7 +189,6 @@ (defmethod resume ((this actor)) "Initialize or restore this actor's state." - (format t "=> actor resume: ~S~%" this) ;; Restore self (when (typep (o! this :slot scene) 'id-ref) ;; relink to scene @@ -199,29 +202,26 @@ (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)))) + do (rplaca entry (dereferize (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) + (loop for child in (o! this children) 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) + (loop for child in (o! this children) 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) + when (typep (car child-cell) 'actor) do (rplaca child-cell (referize (car child-cell)))) - (format t "suspend -- children: ~S~%" (o! this :slot children)) (referize-setf (o! this :slot scene)) (referize-setf (o! this :slot parent))) @@ -242,9 +242,10 @@ ; 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))) + (loop for child in (o! this children) + do (typecase child + (id-ref (o! (dereferize child) (destroy))) + (t (o! child (destroy))))) (when (o! this scene) (o! this scene (remove-actor this)))) (setf (o! this :slot destroyed-p) t)) diff --git a/wh-engine/main.lisp b/wh-engine/main.lisp index 1e52fce..211c8d9 100644 --- a/wh-engine/main.lisp +++ b/wh-engine/main.lisp @@ -67,14 +67,14 @@ (defun make-id () "Return a unique ID." - (setq *id-counter* (+ *id-counter* 1))) + (setf *id-counter* (+ *id-counter* 1))) (defun fixed-id (id) "Ensure the given ID won't be returned by make-id." (declare (type fixnum id)) (when (>= id *id-counter*) - (setq *id-counter* (+ id 1))) + (setf *id-counter* (+ id 1))) id) (defvar *world-scenes* () diff --git a/wh-engine/package.lisp b/wh-engine/package.lisp index 856defb..c695591 100644 --- a/wh-engine/package.lisp +++ b/wh-engine/package.lisp @@ -13,7 +13,7 @@ deref-pointer points-to ensure-live vxy1 vxy-trunc make-id fixed-id - *running-scenes* + *world-scenes* add-scene remove-scene get-scene update-all-scenes initialize-actors-in *view-width* *view-height* *view-ppu* *pixel-scale* @@ -24,7 +24,7 @@ id-ref make-id-ref pointer deref-sus-pointer - referize pointerize + referize dereferize pointerize referize-setf pointerize-setf make-generic-load-form generate-load-forms @@ -43,6 +43,7 @@ ; methods get-component add-component add-child remove-child + apply-to-tree has-tag add-tag remove-tag parent-changed deactivate activate diff --git a/wh-engine/scene.lisp b/wh-engine/scene.lisp index 6187c5f..3a203da 100644 --- a/wh-engine/scene.lisp +++ b/wh-engine/scene.lisp @@ -65,7 +65,7 @@ (defmethod destroy ((this scene)) "Mark this scene for unloading." (unless (o! this destroyed-p) - ; We're dead, clean up actors + ;; We're dead, clean up actors (loop for actor in (o! this actors) do (o! actor (destroy))) (remove-scene this)) @@ -76,8 +76,7 @@ ;; Restore actors (loop for actor in (o! this actors) unless (o! actor :slot parent) - do (format t "===> scene resume: ~S~%" actor) - (o! actor (resume)))) + do (o! actor (resume)))) (defmethod suspend ((this scene)) "Prepare this scene for serialization." diff --git a/wh-engine/serialization.lisp b/wh-engine/serialization.lisp index 99c08dc..313f0bd 100644 --- a/wh-engine/serialization.lisp +++ b/wh-engine/serialization.lisp @@ -19,10 +19,11 @@ (null nil))) (defun referize (ptr) - "Convert weak-pointer ptr into an id-ref." - (declare (type weak-pointer ptr)) + "Convert ptr into an id-ref." - (let ((target (weak-pointer-value ptr))) + (let ((target (etypecase ptr + (weak-pointer (weak-pointer-value ptr)) + ((or scene actor component) ptr)))) (etypecase target (scene (make-id-ref :scene (o! target id))) @@ -41,22 +42,28 @@ :component (class-name (class-of target)))) ))) -(defun pointerize (ref) - "Convert id-ref ref into a weak-pointer." +(defun dereferize (ref) + "Return the object specified by id-ref ref." (declare (type id-ref ref)) (let ((scene (get-scene (id-ref-scene ref))) actor component) (unless scene - (error "can't pointerize ~S (scene not found)" ref)) + (error "can't dereferize ~S (scene not found)" ref)) (if (id-ref-actor ref) (if (setf actor (o! scene (get-actor (id-ref-actor ref)))) (if (id-ref-component ref) (if (setf component (o! actor (get-component (find-class (id-ref-component ref))))) - (make-weak-pointer component) - (error "can't pointerize ~S (component not found)" ref)) - (make-weak-pointer actor)) - (error "can't pointerize ~S (actor not found)" ref)) - (make-weak-pointer scene)))) + component + (error "can't dereferize ~S (component not found)" ref)) + actor) + (error "can't dereferize ~S (actor not found)" ref)) + scene))) + +(defun pointerize (ref) + "Convert id-ref ref into a weak-pointer." + (declare (type id-ref ref)) + + (make-weak-pointer (dereferize ref))) (defmacro referize-setf (place) `(when (typep ,place 'weak-pointer) @@ -224,8 +231,8 @@ (declare (type actor actor)) (cons actor - (loop for child-ptr in (o! actor children) - nconc (collect-descendents (weak-pointer-value child-ptr))))) + (loop for child in (o! actor children) + nconc (collect-descendents child)))) (defun dump-actors (actors &key (destroy-after t) (prune t) (nice-syms nil)) "Suspend and serialize actors." @@ -253,6 +260,9 @@ (let ((scene (eval scene-form))) (add-scene scene) (o! scene (resume)) + (loop for actor in (o! scene actors) + when (and (not (o! actor parent)) (o! actor active-p)) + do (o! actor (activate))) scene)) (defun load-resume-actors (actor-forms)