keith
/
wh-engine
1
1
Fork 0
Code Issues 6 Pull Requests Projects Releases Wiki Activity

Fix actors being GC'd during initialization (closes #9)

This commit is contained in:
~keith 2022-02-22 19:02:52 +00:00
parent 98d8b35a4f
commit 38447b2c7e
Signed by: keith
GPG Key ID: 5BEBEEAB2C73D520
5 changed files with 57 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
wh-engine/actor.lisp
View File

@ -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))

4
wh-engine/main.lisp
View File

@ -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* ()

5
wh-engine/package.lisp
View File

@ -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

5
wh-engine/scene.lisp
View File

@ -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."

36
wh-engine/serialization.lisp
View File

@ -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)