Add shapes and bodies to space only between observations

borodust · Apr 18, 2020 · 5ce456c · 5ce456c
1 parent 0637425
commit 5ce456c
Show file tree

Hide file tree

Showing 4 changed files with 28 additions and 7 deletions.
diff --git a/physics/2d/body.lisp b/physics/2d/body.lisp
@@ -63,7 +63,9 @@
   (let ((body (make-instance 'rigid-body :mass (or mass (and (not kinematic) (make-mass :value 1f0 :inertia 1f0)))
                                          :universe universe
                                          :kinematic kinematic)))
-    (%cp:space-add-body (handle-value-of universe) (handle-value-of body))
+    (flet ((%space-add-body ()
+             (%cp:space-add-body (handle-value-of universe) (handle-value-of body))))
+      (invoke-between-observations #'%space-add-body))
     body))
 
 

diff --git a/physics/2d/chipmunk.lisp b/physics/2d/chipmunk.lisp
@@ -1,6 +1,9 @@
 (cl:in-package :cl-bodge.physics.chipmunk)
 
 
+(defvar *observing-p* nil)
+(defvar *post-observation-hooks* nil)
+
 (defclass chipmunk-engine ()
   ())
 
@@ -14,3 +17,9 @@
 
 (defmethod simulation-engine-discard ((this chipmunk-engine))
   (declare (ignore this)))
+
+
+(defun invoke-between-observations (hook)
+  (if *observing-p*
+      (push hook *post-observation-hooks*)
+      (funcall hook)))
diff --git a/physics/2d/shape.lisp b/physics/2d/shape.lisp
@@ -43,6 +43,12 @@
       (handle-value-of body)))
 
 
+(defun add-space-shape (universe shape)
+  (flet ((%add ()
+           (%cp:space-add-shape (handle-value-of universe) (handle-value-of shape))))
+    (invoke-between-observations #'%add)))
+
+
 ;;;
 ;;; SEGMENT
 ;;;
@@ -69,7 +75,7 @@
                               :end end
                               :substance substance
                               :body body)))
-    (%cp:space-add-shape (handle-value-of universe) (handle-value-of shape))
+    (add-space-shape universe shape)
     shape))
 
 
@@ -147,7 +153,7 @@
                               :radius radius
                               :substance substance
                               :body body)))
-    (%cp:space-add-shape (handle-value-of universe) (handle-value-of shape))
+    (add-space-shape universe shape)
     shape))
 
 
@@ -189,7 +195,7 @@
                               :points points
                               :substance substance
                               :body body)))
-    (%cp:space-add-shape (handle-value-of universe) (handle-value-of shape))
+    (add-space-shape universe shape)
     shape))
 
 ;;;
@@ -226,5 +232,5 @@
                                   :width width
                                   :height height
                                   :body body)))
-        (%cp:space-add-shape (handle-value-of universe) (handle-value-of shape))
+        (add-space-shape universe shape)
         shape)))
diff --git a/physics/2d/universe.lisp b/physics/2d/universe.lisp
@@ -136,7 +136,11 @@
 
 (defmethod simulation-engine-observe-universe ((engine chipmunk-engine) (universe universe) time-step)
   (with-slots (post-step-queue) universe
-    (let ((*active-universe* universe))
+    (let ((*active-universe* universe)
+          (*observing-p* t)
+          (*post-observation-hooks* nil))
       (float-features:with-float-traps-masked t
         (%cp:space-step (handle-value-of universe) (cp-float time-step))
-        (drain post-step-queue)))))
+        (drain post-step-queue))
+      (loop for hook in *post-observation-hooks*
+            do (funcall hook)))))