Skip to content


Add :exit-arena message
Browse files Browse the repository at this point in the history
Add additional checking for handling arenas
  • Loading branch information
borodust committed Apr 22, 2017
1 parent b5fa9e1 commit 687a95e
Show file tree
Hide file tree
Showing 8 changed files with 62 additions and 28 deletions.
5 changes: 0 additions & 5 deletions client/src/connector.lisp
Expand Up @@ -74,11 +74,6 @@
(finish-output stream)))

(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 Down
4 changes: 2 additions & 2 deletions client/src/main.lisp
Expand Up @@ -52,8 +52,8 @@
(run (>> (register-game-stream client (server-identity-id identity))
(join-arena remote-server name)
(instantly ()
(setf game-client client))))
(register-player client (server-identity-name identity)))))
(setf game-client client)
(register-player client (server-identity-name identity))))))))

(defun ping-game-server ()
Expand Down
1 change: 0 additions & 1 deletion client/src/proxy.lisp

This file was deleted.

3 changes: 2 additions & 1 deletion common/packages.lisp
Expand Up @@ -6,4 +6,5 @@
(:export +ok-reply+
5 changes: 5 additions & 0 deletions common/process-command.lisp
Expand Up @@ -5,6 +5,11 @@
:test #'equal)

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

(defgeneric process-command (command message)
(:method (command message)
(list :command :error
Expand Down
12 changes: 11 additions & 1 deletion proxy/arena.lisp
Expand Up @@ -45,14 +45,24 @@
(dolist (client (clients-of arena))
(remhash client arena-table))
(remhash (server-of arena) arena-table)
(remhash arena-by-name (name-of arena))))))
(remhash (name-of arena) arena-by-name)))))

(defun find-arena-by-peer (registry peer)
(with-slots (arena-table) registry
(gethash peer arena-table)))

(defun remove-peer-from-arena (registry peer)
(when-let ((arena (find-arena-by-peer registry peer)))
(if (eq peer (server-of arena))
(remove-arena-by-server registry peer)
(with-slots (clients) arena
(with-slots (arena-table) registry
(deletef clients peer)
(remhash peer arena-table))))))

(defun find-arena-by-name (registry name)
(with-slots (arena-by-name) registry
(gethash name arena-by-name)))
54 changes: 37 additions & 17 deletions proxy/commands.lisp
Expand Up @@ -19,9 +19,11 @@
(reg (peer-registry-of *system*))
(peer (or *peer* (register-peer reg *connection* (format nil "~A" name)))))
(if peer
(list :command :identified
:name (name-of peer)
:id (id-of peer))
(log:debug "Peer '~A' identified" name)
(list :command :identified
:name (name-of peer)
:id (id-of peer)))
(list :command :error
:type :name-unavailable
:text (format nil "Name '~A' taken" name)))))
Expand All @@ -34,29 +36,47 @@

(defmethod process-command ((command (eql :create-arena)) message)
(destructuring-bind (&key name &allow-other-keys) message
(if-let ((arena (register-arena (arena-registry-of *system*) (format nil "~A" name) *peer*)))
(with-message (name) message
(let ((reg (arena-registry-of *system*)))
(if-let ((assigned-arena (find-arena-by-peer reg *peer*)))
(list :command :error
:type :arena-exist
:text (format nil "Arena with name '~A' exists" name))))))
:type :already-in-arena
:text (format nil "Already assigned to '~A' arena" (name-of assigned-arena)))
(if-let ((arena (register-arena reg (format nil "~A" name) *peer*)))
(list :command :error
:type :arena-exist
:text (format nil "Arena with name '~A' exists" name))))))))

(defmethod process-command ((command (eql :join-arena)) message)
(destructuring-bind (&key name &allow-other-keys) message
(let ((reg (arena-registry-of *system*)))
(if-let ((arena (find-arena-by-name reg name)))
(with-message (name) message
(let* ((reg (arena-registry-of *system*))
(client-arena (find-arena-by-peer reg *peer*))
(requested-arena (find-arena-by-name reg name)))
((and client-arena (or (eq *peer* (server-of client-arena))
(not (eq client-arena requested-arena))))
(list :command :error
:type :already-in-arena
:text (format nil "Already joined '~A' arena" (name-of requested-arena))))
((null requested-arena)
(list :command :error
:type :arena-not-found
:text (format nil "Arena with name '~A' not found" name)))
;; fixme: add client limit
(prog1 +ok-reply+
(add-arena-client reg arena *peer*))
(list :command :error
:type :arena-not-found
:text (format nil "Arena with name '~A' not found" name)))))))
(t (prog1 +ok-reply+
(add-arena-client reg requested-arena *peer*))))))))

(defmethod process-command ((command (eql :exit-arena)) message)
(remove-peer-from-arena (arena-registry-of *system*) *peer*)))

(defmethod process-command ((command (eql :register-game-stream)) message)
(destructuring-bind (&key peer-id &allow-other-keys) message
(with-message (peer-id) message
(let ((reg (peer-registry-of *system*)))
(if-let ((peer (find-peer-by-id reg peer-id)))
(prog1 +ok-reply+
Expand Down
6 changes: 5 additions & 1 deletion proxy/proxy.lisp
Expand Up @@ -66,13 +66,17 @@
(when-let ((peer (find-peer-by-property peer-reg connection)))
(remove-arena-by-server arena-reg peer)
(remove-peer peer-reg peer)
(log:debug "Peer \"~A\" disconnected" (name-of peer)))))
(log:debug "Peer '~A' disconnected" (name-of peer)))))

(defmethod process-condition ((condi as:socket-eof))
(disconnect-peer (as:socket condi)))

(defmethod process-condition ((condi as:socket-reset))
(log:warn "Peer disconnected unexpectedly"))

(defmethod initialize-system :after ((this mortar-combat-proxy))
(with-slots (proxy-server info-server peer-registry) this
(labels ((on-accept (socket)
Expand Down

0 comments on commit 687a95e

Please sign in to comment.