Skip to content
Permalink
Browse files
Add arena creation and joining to GUI
  • Loading branch information
borodust committed Apr 24, 2017
1 parent bbf5d6f commit 7cdabebbf9ea2c7ffbd10771c8254d63738bc938
Showing with 87 additions and 24 deletions.
  1. +1 −0 client/mortar-combat.conf.lisp
  2. +8 −0 client/src/events.lisp
  3. +27 −7 client/src/main.lisp
  4. +51 −17 client/src/ui.lisp
@@ -1,3 +1,4 @@
'(:engine
(:systems (mortar-combat::mortar-combat))
:server-address "borodust.org"
:assets "assets/")
@@ -46,3 +46,11 @@


(defevent exit-requested () ())


(defevent new-arena-requested ()
(name))


(defevent arena-join-requested ()
(name))
@@ -52,7 +52,13 @@
(-> ((mortar-combat)) ()
(setf arena new-arena
game-server server)
(update-player-camera scene arena)))))))
(update-player-camera scene arena))
(-> ((host)) ()
(lock-cursor)))))))


(define-event-handler on-arena-create new-arena-requested (ev name)
(create-combat-arena name))


(defun join-combat-arena (name)
@@ -65,7 +71,18 @@
(setf arena new-arena
game-client client)
(update-player-camera scene arena)
(register-player client (server-identity-name identity))))))))
(register-player client (server-identity-name identity)))
(-> ((host)) ()
(lock-cursor)))))))


(defun load-arena-list ()
(with-slots (remote-server) (mortar-combat)
(get-arena-list remote-server)))


(define-event-handler on-arena-join arena-join-requested (ev name)
(join-combat-arena name))


(defun ping-game-server ()
@@ -117,8 +134,10 @@
'camera-rotated
'movement-changed
'trigger-pulled
'button-click-event
'exit-requested)
'exit-requested
'new-arena-requested
'arena-join-requested)
(register-poiu-events (events))
(setf keymap (make-instance 'keymap)
task-queue (make-task-queue))
(let ((prev-x nil)
@@ -208,12 +227,13 @@
(run looped-flow)))))))


(defmethod discard-system ((this mortar-combat))
(defmethod discard-system :before ((this mortar-combat))
(with-slots (scene remote-server game-client game-server arena) this
(dolist (server (list remote-server game-client game-server))
(when server
(disconnect-from-server server)))
(dispose scene)
;; fixme: dispose scene after all
#++(dispose scene)
(setf remote-server nil
game-client nil
game-server nil)
@@ -228,7 +248,7 @@

(defun stop ()
(shutdown)
(mt:open-latch *main-latch* ))
(mt:open-latch *main-latch*))


(define-event-handler on-close viewport-hiding-event (ev)
@@ -7,18 +7,23 @@
(enable-cursor-input board)
(enable-keyboard-input board)

(let ((main-menu (make-board-window board 300 150 200 200 :hidden t))
(let ((main-menu (make-board-window board 300 150 200 82 :hidden t))
(arena-creation-dialog (make-board-window board 300 200 200 145
:title "Enter arena name:"
:headerless nil
:hidden t))
(game-menu (make-board-window board 20 536 760 44 :hidden t))
(combat-zone (make-board-window board 10 10 780 580 :hidden t))
(login (make-board-window board 300 200 200 145
(login-dialog (make-board-window board 300 200 200 145
:title "Enter your name:"
:headerless nil)))
(adopt-layout-by (main-menu)
((dynamic-row-layout 32 1)
((label-button "Combat zone" :name :combat-zone))
((label-button "Quit" :name :quit))))

(adopt-layout-by (login)

(adopt-layout-by (login-dialog)
((dynamic-row-layout 32)
((text-edit :name :nickname)))
((static-row-layout 16 1))
@@ -27,6 +32,16 @@
((spacing))
((label-button "Log in" :name :login))))


(adopt-layout-by (arena-creation-dialog)
((dynamic-row-layout 32)
((text-edit :name :arena-name)))
((static-row-layout 16 1))
((dynamic-row-layout 32)
((label-button "Cancel" :name :arena-cancel))
((spacing))
((label-button "Go!" :name :arena-create))))

(adopt-layout-by (game-menu)
((dynamic-row-layout 32)
((label-button "Leave arena" :name :leave))
@@ -36,22 +51,41 @@
((dynamic-row-layout 32)
((label-button "Create" :name :create))
((label-button "Join" :name :join))
((label-button "Refresh " :name :refresh))
((label-button "Main menu" :name :zone-to-main-menu)))
((dynamic-row-layout 32 1)
((text-label "Available arenas:"))
((list-select 32 :name :arena-list))))

(let ((nickname-edit (find-element login :nickname))
(arena-list (find-element combat-zone :arena-list)))
(add-item arena-list "Here")
(add-item arena-list "and")
(add-item arena-list "There")
(subscribe-body-to (button-click-event (poiu-button)) (events)
(case (name-of poiu-button)
(:login (connect (text-of nickname-edit))
;; fixme: not thread safe
(hide-window login)
(show-window main-menu))
(:combat-zone (hide-window main-menu) (show-window combat-zone))
(:zone-to-main-menu (hide-window combat-zone) (show-window main-menu))
(:quit (post (make-exit-requested) (events))))))))
(let ((nickname-edit (find-element login-dialog :nickname))
(arena-name-edit (find-element arena-creation-dialog :arena-name))
(arena-list (find-element combat-zone :arena-list))
(selected-arena))
(flet ((refresh-arena-list ()
(run (>> (load-arena-list)
(-> ((mortar-combat)) (list)
(clear arena-list)
(dolist (name list)
(add-item arena-list name)))))))
(subscribe-body-to (button-click-event (poiu-button)) (events)
(run (-> ((mortar-combat)) ()
(case (name-of poiu-button)
(:login (connect (text-of nickname-edit))
(hide-window login-dialog)
(show-window main-menu))
(:combat-zone (refresh-arena-list)
(hide-window main-menu)
(show-window combat-zone))
(:zone-to-main-menu (hide-window combat-zone) (show-window main-menu))
(:refresh (refresh-arena-list))
(:create (hide-window combat-zone) (show-window arena-creation-dialog))
(:join (when selected-arena
(post (make-arena-join-requested selected-arena) (events))
(hide-window combat-zone)))
(:arena-cancel (hide-window arena-creation-dialog) (show-window combat-zone))
(:arena-create (post (make-new-arena-requested (text-of arena-name-edit)) (events))
(hide-window arena-creation-dialog))
(:quit (post (make-exit-requested) (events))))))))
(subscribe-body-to (item-selected (source item)) (events)
(when (eq source arena-list)
(setf selected-arena (item-name-of item)))))))

0 comments on commit 7cdabeb

Please sign in to comment.