Add arena leaving

client/mortar-combat-devel.conf.lisp

@@ -1,5 +1,5 @@
'(:engine
  (:systems (mortar-combat::mortar-combat)
   :log-level :debug)
  :server-address "borodust.org"
  :server-address "127.0.0.1"
  :assets "assets/")

client/src/connector.lisp

@@ -34,19 +34,20 @@
              (handler-case
                  (progn
                    (usocket:wait-for-input connection)
                    (let* ((stream (connection-stream-of this))
                           (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)))
                            (progn
                              (remhash reply-id message-table)
                              (funcall handler message))
                            (log:error "Handler not found for message with id ~A" reply-id)))
                        (when-let ((reply (process-command (getf message :command) message)))
                          (encode-message reply stream)
                          (force-output stream)))))
                    (when enabled-p
                      (let* ((stream (connection-stream-of this))
                             (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)))
                              (progn
                                (remhash reply-id message-table)
                                (funcall handler message))
                              (log:error "Handler not found for message with id ~A" reply-id)))
                          (when-let ((reply (process-command (getf message :command) message)))
                            (encode-message reply stream)
                            (force-output stream))))))
                (end-of-file ()
                  (setf enabled-p nil)
                  (log:debug "Disconnected from server"))))
@@ -56,7 +57,8 @@
(defun disconnect-from-server (connector)
  (with-slots (enabled-p connection) connector
    (when enabled-p
      (usocket:socket-close connection))))
      (usocket:socket-close connection)
      (setf enabled-p nil))))


(defun check-response (message expected-command)
@@ -119,6 +121,11 @@
    (with-response () :ok)))


(defun leave-arena (connector)
  (-> (connector :command :exit-arena) ()
    (with-response () :ok)))


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

client/src/main.lisp

@@ -15,7 +15,8 @@
   (identity :initform nil)

   (keymap :initform nil)
   (arena :initform nil :reader arena-of))
   (arena :initform nil :reader arena-of)
   (arena-leave-handler :initform nil))
  (:default-initargs :depends-on '(event-system
                                   graphics-system
                                   physics-system
@@ -43,6 +44,27 @@
    (setf (player-of cam) (player-of arena))))


(defun register-arena-leave-handler (this)
  (with-slots (arena-leave-handler scene remote-server arena
                                   game-server game-client)
      this
    (flet ((node (name)
             (find-node (root-of scene) name)))
      (setf arena-leave-handler
            (subscribe-body-to (arena-leave-requested ()) (events)
              (run (>> (leave-arena remote-server)
                       (-> this ()
                         (disable-node (node :camera))
                         (abandon-all (node :dude-group))
                         (abandon-all (node :ball-group))
                         (let ((conn (or game-server game-client)))
                           (disconnect-from-server conn)
                           (dispose conn))
                         (setf arena nil
                               game-server nil
                               game-client nil)))))))))


(defun create-combat-arena (name)
  (with-slots (remote-server identity game-server arena scene) (mortar-combat)
    (let* ((new-arena (make-instance 'arena :player-name (server-identity-name identity)))
@@ -203,6 +225,8 @@

    (enable-keymap keymap)

    (register-arena-leave-handler this)

    (run (>> (-> ((host)) ()
               (setf (viewport-title) "Mortar Combat")
               (setf (viewport-size) (vec2 800 600)))
@@ -244,10 +268,14 @@


(defmethod discard-system :before ((this mortar-combat))
  (with-slots (scene remote-server game-client game-server arena) this
  (with-slots (scene remote-server game-client game-server arena
                     arena-leave-handler)
      this
    (dolist (server (list remote-server game-client game-server))
      (when server
        (disconnect-from-server server)))
    (when arena-leave-handler
      (unsubscribe-from 'arena-leave-requested arena-leave-handler (events)))
    ;; fixme: dispose scene after all
    #++(dispose scene)
    (setf remote-server nil

client/src/ui.lisp

@@ -113,6 +113,7 @@
                                  (hide-window arena-creation-dialog)
                                  (subscribe-to 'keyboard-event #'toggle-game-menu (events)))
                   (:leave (unsubscribe-from 'keyboard-event #'toggle-game-menu (events))
                           (hide-window game-menu) (show-window main-menu)
                           (post (make-arena-leave-requested) (events)))
                   (:quit (post (make-exit-requested) (events))))))))
      (subscribe-body-to (item-selected (source item)) (events)

proxy/Makefile

@@ -18,10 +18,11 @@ manifest: prepare
	     --eval "(ql:write-asdf-manifest-file \"$(MANIFEST_FILE)\" :if-exists :supersede)"

executable: prepare manifest
	buildapp --output $(BUILD_DIR)/server/server.bin	\
		 --entry "mortar-combat.proxy::main"		\
		 --manifest-file $(MANIFEST_FILE)		\
		 --load-system "mortar-combat/proxy"		\
	buildapp --output $(BUILD_DIR)/server/server.bin		\
		 --entry "mortar-combat.proxy::main"			\
		 --manifest-file $(MANIFEST_FILE)			\
		 --eval "(push :bodge-production-mode *features*)"	\
		 --load-system "mortar-combat/proxy"			\
		 --compress-core

image: executable

proxy/commands.lisp

@@ -72,7 +72,8 @@

(defmethod process-command ((command (eql :exit-arena)) message)
  (when-peer-identified
    (remove-peer-from-arena (arena-registry-of *system*) *peer*)))
   (remove-peer-from-arena (arena-registry-of *system*) *peer*)
   +ok-reply+))


(defmethod process-command ((command (eql :register-game-stream)) message)

proxy/proxy.lisp

@@ -64,17 +64,15 @@
         (peer-reg (peer-registry-of proxy))
         (arena-reg (arena-registry-of proxy)))
    (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)))))
      (when (eq connection (info-connection-of peer))
        (remove-arena-by-server arena-reg peer)
        (remove-peer peer-reg 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 process-condition ((condi as:socket-error))
  (log-errors
    (disconnect-peer (as:socket condi))))


(defmethod initialize-system :after ((this mortar-combat-proxy))