Permalink
Browse files

Add score table

  • Loading branch information...
borodust committed Apr 24, 2017
1 parent 7925fdb commit 9179e6bc0a4f331d346825e3ac1370e7412b5d05
@@ -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)
@@ -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))
@@ -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))
nil)
(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)))
contacts)
(defmethod filter-contacts (contacts (that dude-bounds) (this ball-geom))
(filter-contacts contacts this that))
;;
(defclass ball-body (disposable)
(body geom))
@@ -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
@@ -57,3 +57,7 @@
(defevent arena-leave-requested () ())
(defevent hit-detected ()
(player))
@@ -49,3 +49,14 @@
(when-let ((dude (find-dude arena player-name)))
(post (make-trigger-pulled dude) (events)))))
nil)
(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)))
(cond
(dude (register-hit arena dude))
((equal player-name (name-of player)) (register-hit arena player))))))
nil)
@@ -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)
@@ -137,7 +137,8 @@
'exit-requested
'new-arena-requested
'arena-join-requested
'arena-leave-requested)
'arena-leave-requested
'hit-detected)
(register-poiu-events (events))
(setf keymap (make-instance 'keymap)
task-queue (make-task-queue))
@@ -1,6 +1,14 @@
(in-package :mortar-combat)
(defun fill-score-table (layout arena)
(abandon-all layout)
(loop for (name . score) in (score arena)
do
(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)
@@ -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)))
@@ -32,7 +39,6 @@
((spacing))
((label-button "Log in" :name :login))))
(adopt-layout-by (arena-creation-dialog)
((dynamic-row-layout 32)
((text-edit :name :arena-name)))
@@ -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))
(selected-arena))
(flet ((refresh-arena-list ()
(run (>> (load-arena-list)
@@ -73,8 +83,10 @@
(run (>> (-> ((mortar-combat)) ()
(let ((hidden-p (hiddenp game-menu)))
(if hidden-p
(show-window game-menu)
(hide-window game-menu))
(progn
(fill-score-table score-table (arena-of *system*))
(show-window game-menu))
(hide-window game-menu))
hidden-p))
(-> ((host)) (was-hidden-p)
(if was-hidden-p
@@ -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")

0 comments on commit 9179e6b

Please sign in to comment.