Ball body

client/src/ball.lisp

@@ -1,6 +1,29 @@
 (in-package :mortar-combat)
 
 
+(defclass ball-geom (collidable sphere-geom) ())
+(defclass ball-body (disposable)
+  (body geom))
+
+
+(defmethod initialize-instance :after ((this ball-body) &key)
+  (with-slots (body geom) this
+    (setf body (make-rigid-body)
+          geom (make-instance 'ball-geom :radius 1.025))
+    (bind-geom geom body)
+
+    (setf (position-of body) (vec3 0.0 10.0 0.0))))
+
+
+(defmethod transform-of ((this ball-body))
+  (with-slots (body) this
+    (transform-of body)))
+
+
+(define-destructor ball-body (body geom)
+  (dispose geom)
+  (dispose body))
+
 ;;;
 ;;;
 ;;;
@@ -34,19 +57,37 @@
 ;;;
 ;;;
 (defclass ball-model (model)
-  ((mesh :initform nil)
-   (program :initform nil)))
+  (body mesh program))
 
 
 (defmethod initialization-flow ((this ball-model) &key)
-  (with-slots (mesh program) this
+  (with-slots (body mesh program) this
     (>> (resource-flow "mesh.Ball" (shading-program-resource-name "passthru-program"))
         (instantly (m p)
           (setf mesh m
                 program p))
+        (-> ((physics)) ()
+          (setf body (make-instance 'ball-body)))
         (call-next-method))))
 
 
+(defmethod discard-node :before ((this ball-model))
+  (with-slots (body) this
+    (dispose body)))
+
+
+(defmethod scene-pass ((this ball-model) (pass simulation-pass) input)
+  (with-slots (body) this
+    (let ((result (transform-of body)))
+      (call-next-method)
+      result)))
+
+
+(defmethod scene-pass ((this ball-model) (pass rendering-pass) ball-transform)
+  (let ((*model-matrix* (mult *model-matrix* ball-transform)))
+    (call-next-method)))
+
+
 (defmethod model-graph-assembly-flow ((this ball-model))
   (with-slots (mesh program) this
     (scenegraph

client/src/main.lisp

@@ -1,9 +1,11 @@
 (in-package :mortar-combat)
 
 
+(define-constant +framestep+ 0.016)
 (defvar *main-latch* (mt:make-latch))
 
 
+
 (defclass mortar-combat (enableable generic-system)
   ((scene :initform nil)
    (keymap :initform (make-instance 'keymap))
@@ -23,6 +25,7 @@
     ((projection-node :aspect (/ 800 600))
      ((player-camera :player player)
       (room-model)
+      (ball-model)
       ((transform-node :translation (vec3 4.0 0.0 0.0))
        (mortar-model)
        ((dude-model :color (vec3 0.9 0.4 0.4)))))))))
@@ -83,7 +86,9 @@
                                        scenegraph-root)))
              (concurrently ()
                (let (looped-flow)
-                 (setf looped-flow (>> (scene-processing-flow scene)
+                 (setf looped-flow (>> (-> ((physics)) ()
+                                         (observe-universe +framestep+))
+                                       (scene-processing-flow scene)
                                        (instantly ()
                                          (when (enabledp this)
                                            (run looped-flow)))))

client/src/room.lisp

@@ -1,14 +1,14 @@
 (in-package :mortar-combat)
 
 
-
+(defclass floor-geom (collidable plane-geom) ())
 (defclass room-floor (disposable)
   (geom))
 
 
 (defmethod initialize-instance :after ((this room-floor) &key)
   (with-slots (geom) this
-    (setf geom (make-instance 'plane-geom :normal (vec3 0.0 1.0 0.0)))))
+    (setf geom (make-instance 'floor-geom :normal (vec3 0.0 1.0 0.0)))))
 
 
 (define-destructor room-floor (geom)