Permalink
Browse files

Ball body

  • Loading branch information...
borodust committed Apr 20, 2017
1 parent 5a1adeb commit f23d6d91c3f665012f2c52ef3357116ead5478d2
Showing with 52 additions and 6 deletions.
  1. +44 −3 client/src/ball.lisp
  2. +6 −1 client/src/main.lisp
  3. +2 −2 client/src/room.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
@@ -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)))))
@@ -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)

0 comments on commit f23d6d9

Please sign in to comment.