Skip to content


Browse files Browse the repository at this point in the history
Game server and client
  • Loading branch information
borodust committed Apr 21, 2017
1 parent d0cfc8f commit 29a4b8f
Show file tree
Hide file tree
Showing 11 changed files with 283 additions and 180 deletions.
189 changes: 95 additions & 94 deletions client/assets/dude-and-mortar.brf

Large diffs are not rendered by default.

52 changes: 28 additions & 24 deletions client/src/connector.lisp
Expand Up @@ -3,7 +3,8 @@

(define-constant +supported-server-version+ 1)

(declaim (special *message*))
(declaim (special *message*

(defstruct (server-identity
(:constructor make-server-identity (id name)))
Expand All @@ -17,39 +18,36 @@

(defclass connector (lockable disposable dispatcher)
((enabled-p :initform t)
(connection :initarg :connection :reader connection-of)
(connection :initform nil :reader connection-of)
(message-counter :initform 0)
(message-table :initform (make-hash-table :test 'eql))))

(defmethod initialize-instance :after ((this connector) &key)
(defmethod initialize-instance :after ((this connector) &key host port)
(with-slots (connection message-table enabled-p) this
(setf connection (usocket:socket-connect host port
:element-type '(unsigned-byte 8)
:timeout 30))
(in-new-thread "connector-thread"
(loop while enabled-p
do (log-errors
(usocket:wait-for-input connection)
(let* ((stream (connection-stream-of this))
(message (decode-message stream)))
(message (decode-message stream))
(*connector* this))
(if-let ((reply-id (getf message :reply-for)))
(with-instance-lock-held (this)
(if-let ((handler (gethash reply-id message-table)))
(remhash reply-id message-table)
(funcall handler message))
(log:error "Handler not found for message with id ~A" reply-id)))
(encode-message (process-command (getf message :command) message) stream)
(when-let ((reply (process-command (getf message :command) message)))
(encode-message reply stream)
(force-output stream)))))
finally (usocket:socket-close connection)))))

(defun connect-to-server (host port)
(make-instance 'connector
:connection (usocket:socket-connect host port
:element-type '(unsigned-byte 8)
:timeout 30)))

(defun disconnect-from-server (connector)
(with-slots (enabled-p) connector
(setf enabled-p nil)))
Expand All @@ -70,9 +68,14 @@
(finish-output stream)))

(defmacro with-response (command-name (&rest properties) response &body body)
`(destructuring-bind (&key ,@properties &allow-other-keys) ,response
(check-response ,response ,command-name)
(defmacro with-message ((&rest properties) message &body body)
`(destructuring-bind (&key ,@properties &allow-other-keys) ,message

(defmacro with-response ((&rest properties) command-name &body body)
`(with-message (,@properties) *message*
(check-response *message* ,command-name)

Expand All @@ -84,46 +87,47 @@
(flet ((response-callback (message)
(let ((*message* message))
(funcall task))))
(setf (gethash next-id message-table) #'response-callback)
(unless (getf keys :no-reply)
(setf (gethash next-id message-table) #'response-callback))
(apply #'send-command this :message-id next-id keys))))))

(defun server-version (connector)
(-> (connector :command :version) ()
(with-response :version (version) *message*
(with-response (version) :version

(defun identify (connector name)
(-> (connector :command :identify :name name) ()
(with-response :identified (id name) *message*
(with-response (id name) :identified
(make-server-identity id name))))

(defun create-arena (connector name)
(-> (connector :command :create-arena :name name) ()
(with-response :ok () *message*)))
(with-response () :ok)))

(defun join-arena (connector name)
(-> (connector :command :join-arena :name name) ()
(with-response :ok () *message*)))
(with-response () :ok)))

(defun get-arena-list (connector)
(-> (connector :command :get-arena-list) ()
(with-response :arena-list (list) *message*
(with-response (list) :arena-list

(defun register-game-stream (connector peer-id)
(-> (connector :command :register-game-stream :peer-id peer-id) ()
(with-response :ok () *message*)))
(with-response () :ok)))

(defun ping-peer (connector)
(-> (connector :command :ping) ()
(with-response :ok () *message*)))
(with-response () :ok)))

(defmethod process-command ((command (eql :ping)) message)
Expand Down
19 changes: 14 additions & 5 deletions client/src/dude.lisp
Expand Up @@ -78,6 +78,7 @@
(defclass dude-model (model)
((mesh :initform nil)
(body :initform nil)
(player :initarg :player)
(program :initform nil)
(run-animation :initform nil)
(rest-animation :initform nil)
Expand Down Expand Up @@ -118,9 +119,11 @@
(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)))))))
((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)
Expand All @@ -135,5 +138,11 @@

(defmethod scene-pass ((this dude-model) (pass rendering-pass) input)
(defmethod scene-pass ((this dude-model) pass input)
(with-slots (player) this
(let* ((pos (position-of player))
(rot (rotation-of player))
(*model-matrix* (mult *model-matrix*
(translation-mat4 (x pos) 0.0 (- (y pos)))
(euler-angles->mat4 (vec3 0.0 (y rot) 0.0)))))
5 changes: 5 additions & 0 deletions client/src/events.lisp
@@ -0,0 +1,5 @@
(in-package :mortar-combat)

(defevent player-added-event ()
25 changes: 25 additions & 0 deletions client/src/game-client.lisp
@@ -0,0 +1,25 @@
(in-package :mortar-combat)

(defclass game-client (connector) ()
(:default-initargs :host "localhost" :port 8222))

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

(defun register-player (client name)
(run (-> (client :command :register-player
:name name)

(defun send-player-info (client name player)
(let ((pos (position-of player))
(rot (rotation-of player)))
(run (-> (client :command :player-info
:name name
:position (list (x pos) (y pos))
:rotation (list (x rot) (y rot)))
30 changes: 30 additions & 0 deletions client/src/game-server.lisp
@@ -0,0 +1,30 @@
(in-package :mortar-combat)

(defclass game-server (connector)
((players :initform (make-hash-table :test 'equal)))
(:default-initargs :host "localhost" :port 8222))

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

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

(defmethod process-command ((command (eql :player-info)) message)
(with-slots (players) *connector*
(with-message (name position rotation) message
(with-instance-lock-held (*connector*)
(when-let ((player (gethash name players)))
(setf (position-of player) (sequence->vec2 position)
(rotation-of player) (sequence->vec2 rotation))))))

0 comments on commit 29a4b8f

Please sign in to comment.