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)