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

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)
+  (loop for child in (o! this children)
-        when (typep child-ptr 'weak-pointer)
+        when (typep child 'actor)
-          do (let ((child (weak-pointer-value child-ptr)))
+          do (o! child (apply-to-tree fun))))
-               (unless child
-                 (error "nil value dereferencing child-ptr in ~S" this))
-               (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)))
+    (error "~S is already a child of ~S" child (o! child parent)))
-  (push (make-weak-pointer child) (o! this :slot children))
+  (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)
+  (loop for child in (o! this children)
-        for child = (weak-pointer-value child-ptr)
         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)
+    (loop for child in (o! this children)
-          for child = (weak-pointer-value child-ptr)
           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)
+  (loop for child in (o! this children)
-        for child = (weak-pointer-value child-ptr)
         do (o! child (resume))))
 
 (defmethod suspend ((this actor))
   "Prepare this actor for serialization."
   ;; Suspend children
-  (loop for child-ptr in (o! this children)
+  (loop for child in (o! this children)
-        for child = (weak-pointer-value child-ptr)
         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)
+          (loop for child in (o! this children)
-                for child = (deref-sus-pointer child-ptr)
+                do (typecase child
-                do (o! child (destroy)))
+                     (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))

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

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

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)
+          do (o! actor (resume))))
-             (o! actor (resume))))
 
 (defmethod suspend ((this scene))
   "Prepare this scene for serialization."

wh-engine/serialization.lisp

@@ -19,10 +19,11 @@
     (null nil)))
 
 (defun referize (ptr)
-  "Convert weak-pointer ptr into an id-ref."
+  "Convert ptr into an id-ref."
-  (declare (type weak-pointer ptr))
 
-  (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)
+(defun dereferize (ref)
-  "Convert id-ref ref into a weak-pointer."
+  "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)
+                    component
-                    (error "can't pointerize ~S (component not found)" ref))
+                    (error "can't dereferize ~S (component not found)" ref))
-                (make-weak-pointer actor))
+                actor)
-            (error "can't pointerize ~S (actor not found)" ref))
+            (error "can't dereferize ~S (actor not found)" ref))
-        (make-weak-pointer scene))))
+        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)
+        (loop for child in (o! actor children)
-              nconc (collect-descendents (weak-pointer-value child-ptr)))))
+              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)