Skip to content


Browse files Browse the repository at this point in the history
Add score table
  • Loading branch information
borodust committed Apr 24, 2017
1 parent 7925fdb commit 9179e6b
Show file tree
Hide file tree
Showing 8 changed files with 91 additions and 15 deletions.
17 changes: 16 additions & 1 deletion client/src/arena.lisp
Expand Up @@ -3,7 +3,8 @@

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

(defun dudes-of (arena)
Expand All @@ -24,6 +25,20 @@
(gethash name dudes))))

(defun register-hit (arena player)
(with-slots (score-table) arena
(with-instance-lock-held (arena)
(incf (gethash (name-of player) score-table 0)))))

(defun score (arena)
(with-slots (score-table) arena
(with-instance-lock-held (arena)
(loop for name being the hash-key of score-table
using (hash-value score)
collect (cons name score)))))

(defun update-game-state (this state timestamp)
(with-slots (dudes player) this
(dolist (dude-state (getf state :player-list))
Expand Down
22 changes: 21 additions & 1 deletion client/src/ball.lisp
@@ -1,7 +1,26 @@
(in-package :mortar-combat)

(defclass ball-geom (ownable collidable sphere-geom) ())
(defclass ball-geom (ownable collidable sphere-geom)
((body :initarg :body :accessor body-of)))

(defmethod collide ((this ball-geom) (that ball-geom))

(defmethod filter-contacts (contacts (this ball-geom) (that dude-bounds))
(unless (or (eq (owner-of this) (owner-of that))
(< (vector-length (linear-velocity-of (body-of this))) 10))
(post (make-hit-detected (owner-of that)) (events)))

(defmethod filter-contacts (contacts (that dude-bounds) (this ball-geom))
(filter-contacts contacts this that))

(defclass ball-body (disposable)
(body geom))

Expand All @@ -10,6 +29,7 @@
(with-slots (body geom) this
(setf body (make-rigid-body)
geom (make-instance 'ball-geom
:body body
:owner owner
:radius (/ 1.025 2)))
(when force
Expand Down
4 changes: 4 additions & 0 deletions client/src/events.lisp
Expand Up @@ -57,3 +57,7 @@

(defevent arena-leave-requested () ())

(defevent hit-detected ()
11 changes: 11 additions & 0 deletions client/src/game-client.lisp
Expand Up @@ -49,3 +49,14 @@
(when-let ((dude (find-dude arena player-name)))
(post (make-trigger-pulled dude) (events)))))

(defmethod process-command ((command (eql :server-hit-info)) message)
(with-slots (arena) *connector*
(with-message (player-name) message
(let ((dude (find-dude arena player-name))
(player (player-of arena)))
(dude (register-hit arena dude))
((equal player-name (name-of player)) (register-hit arena player))))))
19 changes: 16 additions & 3 deletions client/src/game-server.lisp
Expand Up @@ -18,10 +18,23 @@

(defun broadcast-hit-info (server player)
(run (-> (server :command :server-hit-info
:no-reply t
:player-name (name-of player))

(defmethod initialize-instance :after ((this game-server) &key)
(flet ((broadcast-shot (ev)
(broadcast-shot-info this (player-from ev))))
(register-event-handler 'trigger-pulled #'broadcast-shot)))
(with-slots (arena) this
(flet ((broadcast-shot (ev)
(broadcast-shot-info this (player-from ev)))
(broadcast-hit (ev)
(let ((player (player-from ev)))
(register-hit arena player)
(broadcast-hit-info this player))))
(register-event-handler 'trigger-pulled #'broadcast-shot)
(register-event-handler 'hit-detected #'broadcast-hit))))

(defmethod process-command ((command (eql :register-player)) message)
Expand Down
3 changes: 2 additions & 1 deletion client/src/main.lisp
Expand Up @@ -137,7 +137,8 @@
(register-poiu-events (events))
(setf keymap (make-instance 'keymap)
task-queue (make-task-queue))
Expand Down
28 changes: 20 additions & 8 deletions client/src/ui.lisp
@@ -1,6 +1,14 @@
(in-package :mortar-combat)

(defun fill-score-table (layout arena)
(abandon-all layout)
(loop for (name . score) in (score arena)
(adopt layout (make-text-label name :align :left))
(adopt layout (make-text-label (format nil "~A" score) :align :right))))

(defun make-ui (board)
(enable-mouse-input board)
(enable-character-input board)
Expand All @@ -12,17 +20,16 @@
:title "Enter arena name:"
:headerless nil
:hidden t))
(game-menu (make-board-window board 20 536 760 44 :hidden t))
(game-menu (make-board-window board 20 236 760 250 :hidden t))
(combat-zone (make-board-window board 10 10 780 580 :hidden t))
(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)
((dynamic-row-layout 32 :columns 1)
((label-button "Combat zone" :name :combat-zone))
((label-button "Quit" :name :quit))))

(adopt-layout-by (login-dialog)
((dynamic-row-layout 32)
((text-edit :name :nickname)))
Expand All @@ -32,7 +39,6 @@
((label-button "Log in" :name :login))))

(adopt-layout-by (arena-creation-dialog)
((dynamic-row-layout 32)
((text-edit :name :arena-name)))
Expand All @@ -45,21 +51,25 @@
(adopt-layout-by (game-menu)
((dynamic-row-layout 32)
((label-button "Leave arena" :name :leave))
((label-button "Quit" :name :quit))))
((label-button "Quit" :name :quit)))
((dynamic-row-layout 26)
((text-label "Score:")))
((dynamic-row-layout 32 :columns 2 :name :score-table)))

(adopt-layout-by (combat-zone)
((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)
((dynamic-row-layout 32 :columns 1)
((text-label "Available arenas:"))
((list-select 32 :name :arena-list))))

(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))
(score-table (find-element game-menu :score-table))
(flet ((refresh-arena-list ()
(run (>> (load-arena-list)
Expand All @@ -73,8 +83,10 @@
(run (>> (-> ((mortar-combat)) ()
(let ((hidden-p (hiddenp game-menu)))
(if hidden-p
(show-window game-menu)
(hide-window game-menu))
(fill-score-table score-table (arena-of *system*))
(show-window game-menu))
(hide-window game-menu))
(-> ((host)) (was-hidden-p)
(if was-hidden-p
Expand Down
2 changes: 1 addition & 1 deletion mortar-combat.asd
Expand Up @@ -35,9 +35,9 @@
(:file "arena")
(:file "camera")
(:file "room")
(:file "ball")
(:file "mortar")
(:file "dude")
(:file "ball")
(:file "shaders/dude")
(:file "shaders/passthru")
(:file "connector")
Expand Down

0 comments on commit 9179e6b

Please sign in to comment.