diff --git a/wh-engine/actor.lisp b/wh-engine/actor.lisp index 4d09fcd..cc1334b 100644 --- a/wh-engine/actor.lisp +++ b/wh-engine/actor.lisp @@ -77,11 +77,11 @@ (defmethod scene ((this actor)) "The scene containing this actor." - (deref-pointer [this :slot scene])) + (deref-sus-pointer [this :slot scene])) (defmethod parent ((this actor)) "This actor's parent." - (deref-pointer [this :slot parent])) + (deref-sus-pointer [this :slot parent])) (defmethod tree-active-p ((this actor)) "Whether or not this actor and all its parents are active." @@ -120,7 +120,7 @@ "Remove a child from this object." (unless (eq [child parent] 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) [child (parent-changed)] child) @@ -195,17 +195,25 @@ do (rplaca entry (pointerize (car entry)))) ; Restore 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)) "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 (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 (referize (car entry)))) + (loop for child-cell on [this :slot children] + when (typep (car child-cell) 'weak-pointer) + do (rplaca child-cell (referize (car child-cell)))) (referize-setf [this :slot scene]) (referize-setf [this :slot parent])) @@ -231,7 +239,7 @@ (when [this parent] [this parent (remove-child this)]) (loop for child-ptr in [this children] - for child = (weak-pointer-value child-ptr) + for child = (deref-sus-pointer child-ptr) do [child (destroy)]) (when [this scene] [this scene (remove-actor this)])) diff --git a/wh-engine/component.lisp b/wh-engine/component.lisp index 347991a..8840668 100644 --- a/wh-engine/component.lisp +++ b/wh-engine/component.lisp @@ -22,7 +22,7 @@ (defmethod actor ((this component)) "The actor this component belongs to." - (deref-pointer [this :slot actor])) + (deref-sus-pointer [this :slot actor])) (defmethod scene ((this component)) "The scene this component belongs to." diff --git a/wh-engine/main.lisp b/wh-engine/main.lisp index c05c4fe..101b010 100644 --- a/wh-engine/main.lisp +++ b/wh-engine/main.lisp @@ -25,6 +25,7 @@ (declaim (inline deref-pointer)) (defun deref-pointer (ptr) "Dereference ptr if it's non-nil." + (declare (type (or weak-pointer null) ptr)) (when ptr (weak-pointer-value ptr))) (defun points-to (ptr obj) @@ -71,6 +72,7 @@ (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))) id) @@ -117,7 +119,7 @@ "List of all known views.") (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 :id -1 :name "Test scene")) @@ -141,9 +143,19 @@ :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 - :name "Camera" - :rotation (coerce (/ pi -4) 'single-float))) + :name "Camera")) [test-scene (add-actor camera-actor)] (setf camera-view (make-instance 'view)) diff --git a/wh-engine/package.lisp b/wh-engine/package.lisp index 2128fd0..f1d2327 100644 --- a/wh-engine/package.lisp +++ b/wh-engine/package.lisp @@ -21,9 +21,11 @@ ;; serialization.lisp id-ref make-id-ref pointer + deref-sus-pointer referize pointerize referize-setf pointerize-setf generate-load-forms + dump-scene dump-actors ;; actor.lisp actor diff --git a/wh-engine/scene.lisp b/wh-engine/scene.lisp index ac7a9e5..65deb1d 100644 --- a/wh-engine/scene.lisp +++ b/wh-engine/scene.lisp @@ -43,7 +43,7 @@ "Remove an actor from this scene." (unless (eq [actor scene] 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) actor) diff --git a/wh-engine/serialization.lisp b/wh-engine/serialization.lisp index 6695341..2080157 100644 --- a/wh-engine/serialization.lisp +++ b/wh-engine/serialization.lisp @@ -8,12 +8,23 @@ (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) "Convert weak-pointer ptr into an id-ref." (declare (type weak-pointer ptr)) (let ((target (weak-pointer-value ptr))) - (typecase target + (etypecase target (scene (make-id-ref :scene [target id])) (actor @@ -23,7 +34,7 @@ (make-id-ref :scene [target scene id] :actor [target actor id] :component (class-name (class-of target)))) - (t (error "can't referize ~S (not an actor, component, or scene)" ptr))))) + ))) (defun pointerize (ref) "Convert id-ref ref into a weak-pointer." @@ -176,17 +187,32 @@ [scene (destroy)] [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)) "Suspend and serialize actors." - (declare (type (proper-list actor) actors)) + ;(declare (type (proper-list actor) actors)) (declare (type boolean destroy-after prune nice-syms)) - (loop for actor in actors - collect - (prog2 - ;; FIXME Children are destroyed with actor, but not serialized with it - [actor (suspend)] - (generate-load-forms actor :prune prune :nice-syms nice-syms) - (if destroy-after - [actor (destroy)] - [actor (resume)])))) + ;; Collect children so we serialize them as well + (let ((all-actors (append actors + (loop for actor in actors + nconc (collect-descendents actor))))) + ;; Suspend + (loop for actor in actors + do [actor (suspend)]) + ;; Serialize + (prog1 + (loop for actor in all-actors + collect (generate-load-forms actor :prune prune :nice-syms nice-syms)) + ;; Resume/destroy + (if destroy-after + (loop for actor in actors do [actor (destroy)]) + (loop for actor in actors do [actor (resume)]))) + ))