Browse files

Add shooting

  • Loading branch information...
borodust committed Apr 20, 2017
1 parent f23d6d9 commit c0207d35d6705ae83761e9c90e1fff8c3297b07c
Showing with 137 additions and 33 deletions.
  1. +10 −8 client/src/ball.lisp
  2. +2 −2 client/src/camera.lisp
  3. +60 −2 client/src/dude.lisp
  4. +10 −2 client/src/keymap.lisp
  5. +44 −17 client/src/main.lisp
  6. +8 −2 client/src/player.lisp
  7. +3 −0 client/src/utils.lisp
@@ -6,13 +6,15 @@
(body geom))
(defmethod initialize-instance :after ((this ball-body) &key)
(defmethod initialize-instance :after ((this ball-body) &key position force)
(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))))
geom (make-instance 'ball-geom :radius (/ 1.025 2)))
(when force
(apply-force body force))
(when position
(setf (position-of body) position))
(bind-geom geom body)))
(defmethod transform-of ((this ball-body))
@@ -60,14 +62,14 @@
(body mesh program))
(defmethod initialization-flow ((this ball-model) &key)
(defmethod initialization-flow ((this ball-model) &key position force)
(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)))
(setf body (make-instance 'ball-body :position position :force force)))
@@ -84,7 +86,7 @@
(defmethod scene-pass ((this ball-model) (pass rendering-pass) ball-transform)
(let ((*model-matrix* (mult *model-matrix* ball-transform)))
(let ((*model-matrix* ball-transform))
@@ -10,6 +10,6 @@
(with-slots (player front-gaze) this
(let* ((pos (position-of player))
(rotation (rotation-of player)))
(setf (transform-of this) (mult (euler-angles->mat4 (vec3 (- (x rotation)) (y rotation) 0.0))
(translation-mat4 (- (x pos)) -10.0 (- (y pos)))))))
(setf (transform-of this) (mult (euler-angles->mat4 (vec3 (- (x rotation)) (- (y rotation)) 0.0))
(translation-mat4 (- (x pos)) -13.0 (y pos))))))
@@ -1,6 +1,41 @@
(in-package :mortar-combat)
(defclass dude-bounds (collidable cylinder-geom) ())
(defclass dude-body (disposable)
(body bounds))
(defmethod initialize-instance :after ((this dude-body) &key)
(with-slots (body bounds) this
(setf body (make-rigid-body)
bounds (make-instance 'dude-bounds
:radius 2.0
:length 13.0))
#++(bind-geom bounds body)))
(define-destructor dude-body (body bounds)
(dispose bounds)
(dispose body))
(defmethod (setf position-of) (value (this dude-body))
(with-slots (body) this
(setf (position-of body) value)))
(defmethod transform-of ((this dude-body))
(with-slots (body) this
(transform-of body)))
(defmethod rotation-of ((this dude-body))
(with-slots (body) this
(rotation-of body)))
@@ -33,12 +68,12 @@
(mult (bone-transform name) offset)))
(defclass dude-model (model)
((mesh :initform nil)
(body :initform nil)
(program :initform nil)
(run-animation :initform nil)
(rest-animation :initform nil)
@@ -51,7 +86,7 @@
(defmethod initialization-flow ((this dude-model) &key)
(with-slots (mesh animation skeleton program
(with-slots (mesh animation skeleton program body
strafe-animation run-animation rest-animation)
(>> (resource-flow "mesh.Dude" "Stickman"
@@ -66,12 +101,35 @@
run-animation run
rest-animation rest
program p))
(-> ((physics)) ()
(setf body (make-instance 'dude-body)))
(defmethod discard-node ((this dude-model))
(with-slots (body) this
(dispose body)))
(defmethod model-graph-assembly-flow ((this dude-model))
(with-slots (skeleton mesh program color rest-animation) this
((animation-node :initial-animation rest-animation :name :dude-animation)
((animated-skeleton-node :root-bone skeleton)
((dude-mesh :mesh mesh :program program :color color)))))))
(defmethod scene-pass ((this dude-model) (pass simulation-pass) input)
(with-slots (body) this
#++(let* ((pos (mult *model-matrix* (vec4 0.0 0.0 0.0 1.0)))
(w (w pos)))
(flet ((w/ (v)
(/ v w)))
(setf (position-of body) (vec3 (w/ (x pos))
(w/ (y pos))
(w/ (z pos))))))
(defmethod scene-pass ((this dude-model) (pass rendering-pass) input)
@@ -8,6 +8,13 @@
(key-table :initform (make-hash-table :test 'eq))))
(defun mouse-button->keymap-button (button)
(case button
(:left :mouse-left)
(:right :mouse-right)
(:middle :mouse-middle)))
(defun enable-keymap (keymap)
(with-slots (callbacks cursor-action key-table) keymap
(when callbacks
@@ -19,8 +26,9 @@
(when-let ((action (gethash (key-from ev) key-table)))
(funcall action (state-from ev))))
(process-button-event (ev)
(when-let ((action (gethash (button-from ev) key-table)))
(funcall action (state-from ev))))
(let ((button (mouse-button->keymap-button (button-from ev))))
(when-let ((action (gethash button key-table)))
(funcall action (state-from ev)))))
(process-cursor-event (ev)
(when cursor-action
(funcall cursor-action (x-from ev) (y-from ev)))))
@@ -2,13 +2,15 @@
(define-constant +framestep+ 0.016)
(define-constant +player-speed+ 15.0)
(defvar *main-latch* (mt:make-latch))
(defclass mortar-combat (enableable generic-system)
((scene :initform nil)
(keymap :initform (make-instance 'keymap))
(defclass mortar-combat (enableable generic-system dispatcher)
((scene :initform nil :reader scene-of)
(task-queue :initform nil)
(keymap :initform nil)
(player :initform nil))
(:default-initargs :depends-on '(graphics-system
@@ -25,17 +27,33 @@
((projection-node :aspect (/ 800 600))
((player-camera :player player)
((transform-node :translation (vec3 4.0 0.0 0.0))
((dude-model :color (vec3 0.9 0.4 0.4)))))))))
((scene-node :name :ball-group))
((dude-model :color (vec3 0.9 0.4 0.4))
(defmethod dispatch ((this mortar-combat) (task function) invariant &key)
(with-slots (task-queue) this
(push-task task task-queue)))
(defun shoot-ball (scene player)
(let ((pos (position-of player)))
(run (>> (assembly-flow 'ball-model
:position (vec3 (+ (x pos) 1.0) 10.0 (- (y pos)))
:force (mult (gaze-of player) 10000))
(-> ((mortar-combat)) (ball)
(let ((group (find-node (root-of scene) :ball-group)))
(adopt group ball)))))))
(defmethod initialize-system :after ((this mortar-combat))
(with-slots (scene player keymap) this
(with-slots (scene player keymap task-queue) this
(register-resource-loader (make-resource-loader (asset-path "font.brf")
(asset-path "dude-and-mortar.brf")))
(setf player (make-instance 'player))
(setf player (make-instance 'player)
keymap (make-instance 'keymap)
task-queue (make-task-queue))
(let ((prev-x nil)
(prev-y nil)
@@ -44,15 +62,15 @@
(when (and prev-x prev-y)
(let ((ax (/ (- y prev-y) 1000))
(ay (/ (- x prev-x) 1000)))
(look-at player ax ay)))
(look-at player ax (- ay))))
(setf prev-x x
prev-y y))
(key-velocity (key)
(case key
(:w (vec2 0.0 -10.0))
(:s (vec2 0.0 10.0))
(:a (vec2 -10.0 0.0))
(:d (vec2 10.0 0.0))))
(:w (vec2 0.0 +player-speed+))
(:s (vec2 0.0 (- +player-speed+)))
(:a (vec2 (- +player-speed+) 0.0))
(:d (vec2 +player-speed+ 0.0))))
(update-velocity ()
(setf (player-velocity player) (reduce #'add movement-keys
:key #'key-velocity
@@ -62,12 +80,18 @@
(case state
(:pressed (push button movement-keys))
(:released (deletef movement-keys button)))
(shoot (state)
(when (eq :pressed state)
(shoot-ball scene player))))
(bind-cursor keymap #'rotate-camera)
(bind-button keymap :w (update-buttons :w))
(bind-button keymap :s (update-buttons :s))
(bind-button keymap :a (update-buttons :a))
(bind-button keymap :d (update-buttons :d))))
(bind-button keymap :d (update-buttons :d))
(bind-button keymap :mouse-left #'shoot)))
(enable-keymap keymap)
@@ -86,7 +110,10 @@
(concurrently ()
(let (looped-flow)
(setf looped-flow (>> (-> ((physics)) ()
(setf looped-flow (>> (instantly ()
(let ((*system* this))
(drain task-queue)))
(-> ((physics)) ()
(observe-universe +framestep+))
(scene-processing-flow scene)
(instantly ()
@@ -5,8 +5,8 @@
(defclass player ()
((position :initform (vec2 0.0 18.0))
(rotation :initform (vec2 0.0 0.0) :reader rotation-of)
((position :initform (vec2)) ; f(x,y) field space = f(x,-z) global space
(rotation :initform (vec2) :reader rotation-of)
(updated-at :initform (real-time-seconds))
(velocity :initform (vec2 0.0 0.0))))
@@ -27,6 +27,12 @@
(defun gaze-of (player)
"In global coords"
(with-slots (rotation) player
(normalize (rotate *forward-gaze* (euler-angles->quat (x rotation) (y rotation) 0.0)))))
(defun (setf player-velocity) (vec2 player)
(with-slots (position velocity) player
(flush-position player)
@@ -6,3 +6,6 @@
(defun asset-path (file)
(merge-pathnames file (merge-working-pathname (property :assets "assets/"))))
(defgeneric scene-of (obj))

0 comments on commit c0207d3

Please sign in to comment.