Skip to content


Browse files Browse the repository at this point in the history
Add arena object
  • Loading branch information
borodust committed Apr 23, 2017
1 parent 3f0762c commit af8617a
Show file tree
Hide file tree
Showing 10 changed files with 236 additions and 78 deletions.
75 changes: 75 additions & 0 deletions client/src/arena.lisp
@@ -0,0 +1,75 @@
(in-package :mortar-combat)

(defclass arena (lockable subscriber)
((player :reader player-of)
(dudes :initform (make-hash-table :test 'equal))))

(defun dudes-of (arena)
(with-slots (dudes) arena
(loop for dude being the hash-value of dudes
collect dude)))

(defun add-dude (arena dude)
(with-slots (dudes) arena
(with-instance-lock-held (arena)
(setf (gethash (name-of dude) dudes) dude))))

(defun find-dude (arena name)
(with-slots (dudes) arena
(with-instance-lock-held (arena)
(gethash name dudes))))

(defun update-game-state (this state timestamp)
(with-slots (dudes player) this
(dolist (dude-state (getf state :player-list))
(with-instance-lock-held (this)
(let* ((dude-name (getf dude-state :name))
(dude (gethash dude-name dudes)))
(unless (equal dude-name (name-of player))
(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))

(defun shoot-ball (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-of *system*)) :ball-group)))
(adopt group ball)))))))

(defmethod initialize-instance :after ((this arena) &key player-name)
(with-slots (player dudes) this
(unless player-name
(error "Player name should be provided for arena"))
(setf player (make-instance 'player :name player-name))
(flet ((add-player (ev)
(run (>> (assembly-flow 'dude-model
:player (player-from ev)
:color (vec3 0.9 0.4 0.4))
(-> ((mortar-combat)) (dude)
(let ((dude-group (find-node (root-of (scene-of *system*)) :dude-group)))
(adopt dude-group dude))))))
(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))))
(register-event-handler 'trigger-pulled #'shoot)
(register-event-handler 'player-added #'add-player)
(register-event-handler 'game-state-updated #'game-state-updated))))
13 changes: 8 additions & 5 deletions client/src/camera.lisp
Expand Up @@ -2,14 +2,17 @@

(defclass player-camera (camera-node)
((player :initarg :player)
((player :initarg :player :initform nil :accessor player-of)
(front-gaze :initform (vec3 0.0 0.0 -1.0))))

(defmethod scene-pass ((this player-camera) pass input)
(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)) -13.0 (y pos))))))
(when player
(let* ((pos (position-of player))
(rotation (rotation-of player)))
(setf (transform-of this) (mult (euler-angles->mat4 (vec3 (- (x rotation))
(- (y rotation))
(translation-mat4 (- (x pos)) -13.0 (y pos)))))))
41 changes: 40 additions & 1 deletion client/src/events.lisp
@@ -1,5 +1,44 @@
(in-package :mortar-combat)

(defevent player-added-event ()
(defclass subscriber (disposable)
((callbacks :initform (cons nil nil))))

(defun register-event-handler (class handler)
(declare (special *callbacks*))
(push (cons class (subscribe-to class handler (events))) *callbacks*))

(defmethod initialize-instance :around ((this subscriber) &key)
(with-slots (callbacks) this
(let ((*callbacks* (list)))
(declare (special *callbacks*))
(rplacd callbacks *callbacks*))))

(define-destructor subscriber (callbacks)
(loop with eve = (events)
for (class . cb) in (cdr callbacks)
do (unsubscribe-from class cb eve)))

(defevent player-added ()

(defevent game-state-updated ()
(state timestamp))

(defevent camera-rotated ()
(ax ay))

(defevent velocity-changed ()

(defevent trigger-pulled () ())
17 changes: 12 additions & 5 deletions client/src/game-client.lisp
@@ -1,13 +1,14 @@
(in-package :mortar-combat)

(defclass game-client (connector) ()
(defclass game-client (connector)
((arena :initarg :arena))
(:default-initargs :host (property :server-address "")
:port (property :proxy-server-port 8222)))

(defun make-game-client ()
(make-instance 'game-client))
(defun make-game-client (arena)
(make-instance 'game-client :arena arena))

(defun register-player (client name)
Expand All @@ -16,12 +17,18 @@

(defun send-player-info (client name player)
(defun send-player-info (client player)
(let ((pos (position-of player))
(rot (rotation-of player)))
(run (-> (client :command :player-info
:name name
:no-reply t
:name (name-of player)
:timestamp (real-time-seconds)
:position (list (x pos) (y pos))
:rotation (list (x rot) (y rot)))

(defmethod process-command ((command (eql :game-state)) message)
(post (make-game-state-updated (getf message :state) (getf message :timestamp)) (events))
38 changes: 26 additions & 12 deletions client/src/game-server.lisp
Expand Up @@ -2,29 +2,43 @@

(defclass game-server (connector)
((players :initform (make-hash-table :test 'equal)))
((arena :initarg :arena))
(:default-initargs :host (property :server-address "")
:port (property :proxy-server-port 8222)))

(defun make-game-server ()
(make-instance 'game-server))
(defun make-game-server (arena)
(make-instance 'game-server :arena arena))

(defmethod process-command ((command (eql :register-player)) message)
(with-slots (players) *connector*
(with-slots (arena) *connector*
(with-message (name) message
(with-instance-lock-held (*connector*)
(let ((player (make-instance 'proxy)))
(setf (gethash name players) player)
(post (make-player-added-event player) (events))))))
(let ((player (make-instance 'proxy :name name)))
(add-dude arena player)
(post (make-player-added player) (events)))))

(defmethod process-command ((command (eql :player-info)) message)
(with-slots (players) *connector*
(with-slots (arena) *connector*
(with-message (name position rotation timestamp) message
(with-instance-lock-held (*connector*)
(when-let ((player (gethash name players)))
(update-proxy player (sequence->vec2 position) (sequence->vec2 rotation) timestamp)))))
(when-let ((player (find-dude arena name)))
(update-proxy player (sequence->vec2 position) (sequence->vec2 rotation) timestamp))))

(defun broadcast-game-state (server)
(with-slots (arena) server
(flet ((player-info (p)
(let ((pos (position-of p))
(rot (rotation-of p)))
(list :name (name-of p)
:position (list (x pos) (y pos))
:rotation (list (x rot) (y rot))))))
(let ((proxies (mapcar #'player-info (cons (player-of arena) (dudes-of arena)))))
(run (-> (server :command :game-state
:no-reply t
:timestamp (real-time-seconds)
:state (list :player-list proxies))

0 comments on commit af8617a

Please sign in to comment.