Fix (dump-actors) child serialization and destruction (for #5)
This commit is contained in:
parent
99238fea55
commit
bafd505145
|
@ -77,11 +77,11 @@
|
||||||
|
|
||||||
(defmethod scene ((this actor))
|
(defmethod scene ((this actor))
|
||||||
"The scene containing this actor."
|
"The scene containing this actor."
|
||||||
(deref-pointer [this :slot scene]))
|
(deref-sus-pointer [this :slot scene]))
|
||||||
|
|
||||||
(defmethod parent ((this actor))
|
(defmethod parent ((this actor))
|
||||||
"This actor's parent."
|
"This actor's parent."
|
||||||
(deref-pointer [this :slot parent]))
|
(deref-sus-pointer [this :slot parent]))
|
||||||
|
|
||||||
(defmethod tree-active-p ((this actor))
|
(defmethod tree-active-p ((this actor))
|
||||||
"Whether or not this actor and all its parents are active."
|
"Whether or not this actor and all its parents are active."
|
||||||
|
@ -120,7 +120,7 @@
|
||||||
"Remove a child from this object."
|
"Remove a child from this object."
|
||||||
(unless (eq [child parent] this)
|
(unless (eq [child parent] this)
|
||||||
(error "~S is not a child of ~S" child this))
|
(error "~S is not a child of ~S" child this))
|
||||||
(setf [this :slot children] (remove child [this :slot children] :key #'weak-pointer-value))
|
(setf [this :slot children] (delete child [this :slot children] :key #'deref-sus-pointer :count 1))
|
||||||
(setf [child :slot parent] nil)
|
(setf [child :slot parent] nil)
|
||||||
[child (parent-changed)]
|
[child (parent-changed)]
|
||||||
child)
|
child)
|
||||||
|
@ -195,17 +195,25 @@
|
||||||
do (rplaca entry (pointerize (car entry))))
|
do (rplaca entry (pointerize (car entry))))
|
||||||
; Restore components
|
; Restore components
|
||||||
(loop for component in [this components]
|
(loop for component in [this components]
|
||||||
do [component (resume)]))
|
do [component (resume)])
|
||||||
|
; Restore children
|
||||||
|
(loop for child-ptr in [this children]
|
||||||
|
for child = (weak-pointer-value child-ptr)
|
||||||
|
do [child (resume)]))
|
||||||
|
|
||||||
(defmethod suspend ((this actor))
|
(defmethod suspend ((this actor))
|
||||||
"Prepare this actor for serialization."
|
"Prepare this actor for serialization."
|
||||||
|
; Suspend children
|
||||||
|
(loop for child-ptr in [this children]
|
||||||
|
for child = (weak-pointer-value child-ptr)
|
||||||
|
do [child (suspend)])
|
||||||
; Suspend components
|
; Suspend components
|
||||||
(loop for component in [this components]
|
(loop for component in [this components]
|
||||||
do [component (suspend)])
|
do [component (suspend)])
|
||||||
; Suspend self
|
; Suspend self
|
||||||
(loop for entry on [this :slot children]
|
(loop for child-cell on [this :slot children]
|
||||||
when (typep (car entry) 'weak-pointer)
|
when (typep (car child-cell) 'weak-pointer)
|
||||||
do (rplaca entry (referize (car entry))))
|
do (rplaca child-cell (referize (car child-cell))))
|
||||||
(referize-setf [this :slot scene])
|
(referize-setf [this :slot scene])
|
||||||
(referize-setf [this :slot parent]))
|
(referize-setf [this :slot parent]))
|
||||||
|
|
||||||
|
@ -231,7 +239,7 @@
|
||||||
(when [this parent]
|
(when [this parent]
|
||||||
[this parent (remove-child this)])
|
[this parent (remove-child this)])
|
||||||
(loop for child-ptr in [this children]
|
(loop for child-ptr in [this children]
|
||||||
for child = (weak-pointer-value child-ptr)
|
for child = (deref-sus-pointer child-ptr)
|
||||||
do [child (destroy)])
|
do [child (destroy)])
|
||||||
(when [this scene]
|
(when [this scene]
|
||||||
[this scene (remove-actor this)]))
|
[this scene (remove-actor this)]))
|
||||||
|
|
|
@ -22,7 +22,7 @@
|
||||||
|
|
||||||
(defmethod actor ((this component))
|
(defmethod actor ((this component))
|
||||||
"The actor this component belongs to."
|
"The actor this component belongs to."
|
||||||
(deref-pointer [this :slot actor]))
|
(deref-sus-pointer [this :slot actor]))
|
||||||
|
|
||||||
(defmethod scene ((this component))
|
(defmethod scene ((this component))
|
||||||
"The scene this component belongs to."
|
"The scene this component belongs to."
|
||||||
|
|
|
@ -25,6 +25,7 @@
|
||||||
(declaim (inline deref-pointer))
|
(declaim (inline deref-pointer))
|
||||||
(defun deref-pointer (ptr)
|
(defun deref-pointer (ptr)
|
||||||
"Dereference ptr if it's non-nil."
|
"Dereference ptr if it's non-nil."
|
||||||
|
(declare (type (or weak-pointer null) ptr))
|
||||||
(when ptr (weak-pointer-value ptr)))
|
(when ptr (weak-pointer-value ptr)))
|
||||||
|
|
||||||
(defun points-to (ptr obj)
|
(defun points-to (ptr obj)
|
||||||
|
@ -71,6 +72,7 @@
|
||||||
(defun fixed-id (id)
|
(defun fixed-id (id)
|
||||||
"Ensure the given ID won't be returned by make-id."
|
"Ensure the given ID won't be returned by make-id."
|
||||||
(declare (type fixnum id))
|
(declare (type fixnum id))
|
||||||
|
|
||||||
(when (>= id *id-counter*)
|
(when (>= id *id-counter*)
|
||||||
(setq *id-counter* (+ id 1)))
|
(setq *id-counter* (+ id 1)))
|
||||||
id)
|
id)
|
||||||
|
@ -117,7 +119,7 @@
|
||||||
"List of all known views.")
|
"List of all known views.")
|
||||||
|
|
||||||
(defun register-test-scene ()
|
(defun register-test-scene ()
|
||||||
(let (test-scene test-actor test-drawable test-actor-2 camera-actor camera-view)
|
(let (test-scene test-actor test-drawable test-actor-2 camera-actor camera-view child-actor)
|
||||||
(setf test-scene (make-instance 'scene
|
(setf test-scene (make-instance 'scene
|
||||||
:id -1
|
:id -1
|
||||||
:name "Test scene"))
|
:name "Test scene"))
|
||||||
|
@ -141,9 +143,19 @@
|
||||||
:colour (vec4 0.0 1.0 0.0 1.0)))
|
:colour (vec4 0.0 1.0 0.0 1.0)))
|
||||||
]
|
]
|
||||||
|
|
||||||
|
(setf child-actor (make-instance 'actor
|
||||||
|
:name "Child Actor"
|
||||||
|
:location (vec2 0.0 0.5)
|
||||||
|
:z-layer -2))
|
||||||
|
[test-scene (add-actor child-actor)]
|
||||||
|
[test-actor-2 (add-child child-actor)]
|
||||||
|
|
||||||
|
[child-actor (add-component (make-instance 'drawable-test
|
||||||
|
:colour (vec4 0.0 1.0 1.0 1.0)))
|
||||||
|
]
|
||||||
|
|
||||||
(setf camera-actor (make-instance 'actor
|
(setf camera-actor (make-instance 'actor
|
||||||
:name "Camera"
|
:name "Camera"))
|
||||||
:rotation (coerce (/ pi -4) 'single-float)))
|
|
||||||
[test-scene (add-actor camera-actor)]
|
[test-scene (add-actor camera-actor)]
|
||||||
|
|
||||||
(setf camera-view (make-instance 'view))
|
(setf camera-view (make-instance 'view))
|
||||||
|
|
|
@ -21,9 +21,11 @@
|
||||||
;; serialization.lisp
|
;; serialization.lisp
|
||||||
id-ref make-id-ref
|
id-ref make-id-ref
|
||||||
pointer
|
pointer
|
||||||
|
deref-sus-pointer
|
||||||
referize pointerize
|
referize pointerize
|
||||||
referize-setf pointerize-setf
|
referize-setf pointerize-setf
|
||||||
generate-load-forms
|
generate-load-forms
|
||||||
|
dump-scene dump-actors
|
||||||
|
|
||||||
;; actor.lisp
|
;; actor.lisp
|
||||||
actor
|
actor
|
||||||
|
|
|
@ -43,7 +43,7 @@
|
||||||
"Remove an actor from this scene."
|
"Remove an actor from this scene."
|
||||||
(unless (eq [actor scene] this)
|
(unless (eq [actor scene] this)
|
||||||
(error "~S is not in scene ~S" actor this))
|
(error "~S is not in scene ~S" actor this))
|
||||||
(setf [this :slot actors] (remove actor [this :slot actors] :key #'weak-pointer-value))
|
(setf [this :slot actors] (delete actor [this :slot actors] :count 1))
|
||||||
(setf [actor :slot scene] nil)
|
(setf [actor :slot scene] nil)
|
||||||
actor)
|
actor)
|
||||||
|
|
||||||
|
|
|
@ -8,12 +8,23 @@
|
||||||
|
|
||||||
(deftype pointer () '(or id-ref weak-pointer null))
|
(deftype pointer () '(or id-ref weak-pointer null))
|
||||||
|
|
||||||
|
(declaim (inline deref-sus-pointer))
|
||||||
|
(defun deref-sus-pointer (val)
|
||||||
|
"Dereference val, and warn if it's suspended."
|
||||||
|
(declare (type pointer val))
|
||||||
|
(etypecase val
|
||||||
|
(weak-pointer (weak-pointer-value val))
|
||||||
|
(id-ref (warn "dereferencing sus pointer:~%~S" val)
|
||||||
|
(weak-pointer-value (pointerize val)))
|
||||||
|
(null nil)))
|
||||||
|
|
||||||
|
|
||||||
(defun referize (ptr)
|
(defun referize (ptr)
|
||||||
"Convert weak-pointer ptr into an id-ref."
|
"Convert weak-pointer ptr into an id-ref."
|
||||||
(declare (type weak-pointer ptr))
|
(declare (type weak-pointer ptr))
|
||||||
|
|
||||||
(let ((target (weak-pointer-value ptr)))
|
(let ((target (weak-pointer-value ptr)))
|
||||||
(typecase target
|
(etypecase target
|
||||||
(scene
|
(scene
|
||||||
(make-id-ref :scene [target id]))
|
(make-id-ref :scene [target id]))
|
||||||
(actor
|
(actor
|
||||||
|
@ -23,7 +34,7 @@
|
||||||
(make-id-ref :scene [target scene id]
|
(make-id-ref :scene [target scene id]
|
||||||
:actor [target actor id]
|
:actor [target actor id]
|
||||||
:component (class-name (class-of target))))
|
:component (class-name (class-of target))))
|
||||||
(t (error "can't referize ~S (not an actor, component, or scene)" ptr)))))
|
)))
|
||||||
|
|
||||||
(defun pointerize (ref)
|
(defun pointerize (ref)
|
||||||
"Convert id-ref ref into a weak-pointer."
|
"Convert id-ref ref into a weak-pointer."
|
||||||
|
@ -176,17 +187,32 @@
|
||||||
[scene (destroy)]
|
[scene (destroy)]
|
||||||
[scene (resume)])))
|
[scene (resume)])))
|
||||||
|
|
||||||
|
(defun collect-descendents (actor)
|
||||||
|
"Recursively collect actor and all its descendents."
|
||||||
|
(declare (type actor actor))
|
||||||
|
|
||||||
|
(cons actor
|
||||||
|
(loop for child-ptr in [actor children]
|
||||||
|
nconc (collect-descendents (weak-pointer-value child-ptr)))))
|
||||||
|
|
||||||
(defun dump-actors (actors &key (destroy-after t) (prune t) (nice-syms nil))
|
(defun dump-actors (actors &key (destroy-after t) (prune t) (nice-syms nil))
|
||||||
"Suspend and serialize actors."
|
"Suspend and serialize actors."
|
||||||
(declare (type (proper-list actor) actors))
|
;(declare (type (proper-list actor) actors))
|
||||||
(declare (type boolean destroy-after prune nice-syms))
|
(declare (type boolean destroy-after prune nice-syms))
|
||||||
|
|
||||||
|
;; Collect children so we serialize them as well
|
||||||
|
(let ((all-actors (append actors
|
||||||
(loop for actor in actors
|
(loop for actor in actors
|
||||||
collect
|
nconc (collect-descendents actor)))))
|
||||||
(prog2
|
;; Suspend
|
||||||
;; FIXME Children are destroyed with actor, but not serialized with it
|
(loop for actor in actors
|
||||||
[actor (suspend)]
|
do [actor (suspend)])
|
||||||
(generate-load-forms actor :prune prune :nice-syms nice-syms)
|
;; Serialize
|
||||||
|
(prog1
|
||||||
|
(loop for actor in all-actors
|
||||||
|
collect (generate-load-forms actor :prune prune :nice-syms nice-syms))
|
||||||
|
;; Resume/destroy
|
||||||
(if destroy-after
|
(if destroy-after
|
||||||
[actor (destroy)]
|
(loop for actor in actors do [actor (destroy)])
|
||||||
[actor (resume)]))))
|
(loop for actor in actors do [actor (resume)])))
|
||||||
|
))
|
||||||
|
|
Loading…
Reference in New Issue