Skip to content
Browse files

Add client/server shot handling

  • Loading branch information
borodust committed Apr 23, 2017
1 parent d980404 commit e3954667f513f77dac69b63319794fa99da50c47
@@ -31,23 +31,23 @@
(let* ((dude-name (getf dude-state :name)))
(unless (equal dude-name (name-of player))
(let ((dude (gethash dude-name dudes)))

(unless dude
(setf dude (make-instance 'proxy :name dude-name)
(gethash dude-name dudes) dude)
(post (make-player-added dude) (events)))
(update-proxy dude
(sequence->vec2 (getf dude-state :position))
(sequence->vec2(getf dude-state :rotation))
(sequence->vec2 (getf dude-state :rotation))
(getf dude-state :movement)))))))))

(defun shoot-ball (player)
(let ((pos (position-of player)))
(run (>> (assembly-flow 'ball-model
:owner player
:position (vec3 (+ (x pos) 1.0) 10.0 (- (y pos)))
:force (mult (gaze-of player) 10000))
:force (mult (gaze-of player) 20000))
(-> ((mortar-combat)) (ball)
(let ((group (find-node (root-of (scene-of *system*)) :ball-group)))
(adopt group ball)))))))
@@ -68,10 +68,7 @@
(game-state-updated (ev)
(update-game-state this (state-from ev) (timestamp-from ev)))
(shoot (ev)
(declare (ignore ev))
(shoot-ball player))
(update-velocity (ev)
(setf (velocity-of player) (velocity-from ev))))
(shoot-ball (player-from ev))))
(register-event-handler 'trigger-pulled #'shoot)
(register-event-handler 'player-added #'add-player)
(register-event-handler 'game-state-updated #'game-state-updated))))
@@ -1,15 +1,17 @@
(in-package :mortar-combat)

(defclass ball-geom (collidable sphere-geom) ())
(defclass ball-geom (ownable collidable sphere-geom) ())
(defclass ball-body (disposable)
(body geom))

(defmethod initialize-instance :after ((this ball-body) &key position force)
(defmethod initialize-instance :after ((this ball-body) &key position force owner)
(with-slots (body geom) this
(setf body (make-rigid-body)
geom (make-instance 'ball-geom :radius (/ 1.025 2)))
geom (make-instance 'ball-geom
:owner owner
:radius (/ 1.025 2)))
(when force
(apply-force body force))
(when position
@@ -62,14 +64,17 @@
(body mesh program))

(defmethod initialization-flow ((this ball-model) &key position force)
(defmethod initialization-flow ((this ball-model) &key position force owner)
(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 :position position :force force)))
(setf body (make-instance 'ball-body
:owner owner
:position position
:force force)))

@@ -6,16 +6,19 @@
(defvar *dude-bounds-initial-position* (vec4 0.0 7.5 0.0 1.0))
(defvar *dude-bounds-initial-rotation* (euler-angles->mat4 (vec4 (/ pi 2) 0.0 0.0)))

(defclass dude-bounds (collidable cylinder-geom) ())

(defclass dude-bounds (ownable collidable cylinder-geom) ())

(defclass dude-body (disposable)

(defmethod initialize-instance :after ((this dude-body) &key)
(defmethod initialize-instance :after ((this dude-body) &key owner)
(with-slots (bounds) this
(setf bounds (make-instance 'dude-bounds
:owner owner
:radius 2.0
:length 13.0))
(setf (position-of bounds) (vec3 (x *dude-bounds-initial-position*)
@@ -111,7 +114,7 @@
rest-animation rest
program p))
(-> ((physics)) ()
(setf body (make-instance 'dude-body)))
(setf body (make-instance 'dude-body :owner dude)))
(instantly ()
(let* ((ani-player (find-node (model-root-of this) :dude-animation))
@@ -181,8 +184,10 @@

(defmethod scene-pass ((this dude-model) (pass simulation-pass) input)
(with-slots (body) this
(let* ((pos (mult *model-matrix* *dude-bounds-initial-position*))
(with-slots (body player) this
(let* ((p-pos (position-of player))
(pos (mult *model-matrix* (add *dude-bounds-initial-position*
(vec4 (x p-pos) 0.0 (- (y p-pos))))))
(w (w pos)))
(flet ((w/ (v)
(/ v w)))
@@ -41,4 +41,5 @@
(player direction))

(defevent trigger-pulled () ())
(defevent trigger-pulled ()
@@ -30,6 +30,22 @@

(defun send-shot-info (client player)
(run (-> (client :command :shot-info
:no-reply t
:name (name-of player)
:timestamp (real-time-seconds))

(defmethod process-command ((command (eql :game-state)) message)
(post (make-game-state-updated (getf message :state) (getf message :timestamp)) (events))

(defmethod process-command ((command (eql :server-shot-info)) message)
(with-slots (arena) *connector*
(with-message (player-name) message
(when-let ((dude (find-dude arena player-name)))
(post (make-trigger-pulled dude) (events)))))
@@ -1,7 +1,7 @@
(in-package :mortar-combat)

(defclass game-server (connector)
(defclass game-server (subscriber connector)
((arena :initarg :arena))
(:default-initargs :host (property :server-address "")
:port (property :proxy-server-port 8222)))
@@ -11,6 +11,19 @@
(make-instance 'game-server :arena arena))

(defun broadcast-shot-info (server player)
(run (-> (server :command :server-shot-info
:no-reply t
:player-name (name-of player))

(defmethod initialize-instance :after ((this game-server) &key)
(flet ((broadcast-shot (ev)
(broadcast-shot-info this (player-from ev))))
(register-event-handler 'trigger-pulled #'broadcast-shot)))

(defmethod process-command ((command (eql :register-player)) message)
(with-slots (arena) *connector*
(with-message (name) message
@@ -32,6 +45,14 @@

(defmethod process-command ((command (eql :shot-info)) message)
(with-slots (arena) *connector*
(with-message (name) message
(when-let ((player (find-dude arena name)))
(post (make-trigger-pulled player) (events)))))

(defun broadcast-game-state (server)
(with-slots (arena) server
(flet ((player-info (p)
@@ -153,11 +153,12 @@
(:released (deletef movement-keys button)))
(shoot (state)
(when (eq :pressed state)
(post (make-trigger-pulled) eve))))

(when (and (eq :pressed state) arena)
(let ((player (player-of arena)))
(when game-client
(send-shot-info game-client player))
(post (make-trigger-pulled player) eve)))))
(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))
@@ -5,9 +5,20 @@
(defvar *forward-gaze* (vec3 0.0 0.0 -1.0))

(defclass ownable ()
((owner :initarg :owner :initform (error ":owner missing") :reader owner-of)))

(defmethod collide ((this ownable) (that ownable))
(when (eq (owner-of this) (owner-of that))

(defgeneric position-of (player))
(defgeneric rotation-of (player))
(defgeneric name-of (player))
(defgeneric gaze-of (player))

(defclass player (subscriber)
((name :initarg :name :initform (error ":name missing") :reader name-of)
@@ -49,10 +60,14 @@
(t (vec2 0.0 0.0)))))

(defun gaze-of (player)
(defun calc-gaze (rotation)
(normalize (rotate *forward-gaze* (euler-angles->quat (x rotation) (y rotation) 0.0))))

(defmethod gaze-of ((this player))
"In global coords"
(with-slots (rotation) player
(normalize (rotate *forward-gaze* (euler-angles->quat (x rotation) (y rotation) 0.0)))))
(with-slots (rotation) this
(calc-gaze rotation)))

(defun (setf velocity-of) (vec2 player)
@@ -32,6 +32,11 @@
(lerp rotation next-rotation (proxy-lerp-factor this))))

(defmethod gaze-of ((this proxy))
(with-slots (next-rotation) this
(calc-gaze next-rotation)))

(defun update-proxy (proxy pos rot timestamp movement)
(with-slots (next-position
next-at position updated-at

0 comments on commit e395466

Please sign in to comment.