From 018adc827bf05476e30034681cb621e0eb001108 Mon Sep 17 00:00:00 2001 From: inaimathi Date: Thu, 15 Mar 2012 01:35:59 -0400 Subject: [PATCH] -Added cl-actors into the mix for game-state management -Added a way of dealing with timed out players --- game.lisp | 40 ++++++++++++++++++++++++++++++++++++++-- js.lisp | 2 +- model.lisp | 10 ++++++++-- package.lisp | 6 ++++-- player.lisp | 3 +++ strifebarge.asd | 2 +- strifebarge.lisp | 3 ++- util.lisp | 5 ++++- 8 files changed, 61 insertions(+), 10 deletions(-) diff --git a/game.lisp b/game.lisp index 5778cb0..99a8324 100644 --- a/game.lisp +++ b/game.lisp @@ -13,6 +13,12 @@ (defun get-game (game-name) (cdr (assoc game-name *games-table* :test #'string=))) +(defmethod remaining-players ((g game)) + (remove-if #'dead-p (players g))) + +(defmethod current-player ((g game)) + (car (turn-stack g))) + (defmethod ships ((g game)) (mapcan-f #'ships (players g))) @@ -39,7 +45,18 @@ (defmethod advance-turn ((g game)) (if (cdr (turn-stack g)) (pop (turn-stack g)) - (setf (turn-stack g) (players g)))) + (setf (turn-stack g) (players g))) + (setf (turn-started g) (now)) + (incf (turn-count g))) + +(defmethod kick ((g game) (p player)) + (setf (players g) (remove p (players g)))) + +(defmethod victory-p ((g game)) + "Returns nil if a victory is undecided, otherwise +returns the winning player." + (let ((players (remaining-players g))) + (when (= 1 (length players)) (car players)))) (defmethod fire ((g game) (p player) x y) (let* ((space (space-at (board g) x y)) @@ -54,4 +71,23 @@ (push-record g "ship-damage" (to-json ship)) (death-check g ship))) (setf (move space) result) - result)) \ No newline at end of file + result)) + +;;;;;;;;;;;;;;;;;;;; ongoing actions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defactor ticker ((game-list *games-table*)) (m) + (sleep *game-ticker-frequency*) + (loop for (game-name . g) in game-list + do (update-state g)) + (send self nil) + next) + +(defvar *ticker* (ticker)) +(send *ticker* nil) + +(defmethod update-state ((g game)) + (when (>= (turns-missed (current-player g)) (turns-missed-allowed g)) + (kick g (current-player g))) + (when (duration> (time-difference (turn-started g) (now)) (turn-time-limit g)) + (incf (turns-missed (current-player g))) + (advance-turn g))) \ No newline at end of file diff --git a/js.lisp b/js.lisp index 6b230ea..467ee1e 100644 --- a/js.lisp +++ b/js.lisp @@ -3,7 +3,7 @@ (compile-js "js/strifebarge.js" "strifebarge-js.lisp" (ps (define-event-source source "update-map") - + (define-event-listener source "turn" (lambda (e) ($ "#turn-marker" (text (chain e data))))) diff --git a/model.lisp b/model.lisp index 081686c..c3be2fa 100644 --- a/model.lisp +++ b/model.lisp @@ -30,7 +30,8 @@ (defclass player () ((score :accessor score :initform 0) (sunken :accessor sunken :initarg :sunken) - (ships :accessor ships :initarg :ships))) + (ships :accessor ships :initarg :ships) + (turns-missed :accessor turns-missed :initform 0))) (defclass board-space () ((x :reader x :initarg :x) @@ -49,4 +50,9 @@ (waiting-for :accessor waiting-for :initarg :waiting-for) (turn-stack :accessor turn-stack :initarg :turn-stack) (finished-p :accessor finished-p :initform nil) - (history :accessor history :initform nil))) \ No newline at end of file + (history :accessor history :initform nil) + (turn-count :accessor turn-count :initform 0) + + (turn-started :accessor turn-started :initform (now)) + (turn-time-limit :accessor turn-time-limit :initarg :turn-time-limit :initform (make-duration :minute 3)) + (turns-missed-allowed :accessor turns-missed-allowed :initarg :turns-missed-allowed :initform 3))) \ No newline at end of file diff --git a/package.lisp b/package.lisp index 6fc73d4..d607452 100644 --- a/package.lisp +++ b/package.lisp @@ -1,7 +1,8 @@ ;;;; package.lisp (defpackage #:strifebarge - (:use #:cl #:cl-who #:cl-css #:clsql #:hunchentoot #:parenscript) + (:use #:cl #:cl-who #:cl-css #:clsql #:hunchentoot #:parenscript #:cl-actors) + (:import-from #:cl-actors #:self) (:import-from #:json #:encode-json-to-string #:decode-json-from-string) (:import-from #:cl-ppcre #:scan-to-strings) (:import-from #:ironclad @@ -25,7 +26,8 @@ (defparameter *server-port* 5050) (defparameter *board-square-size* 35) - +(defparameter *game-ticker-frequency* 30 + "How often, in seconds, the game clock should tick") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/player.lisp b/player.lisp index 76a37eb..9216455 100644 --- a/player.lisp +++ b/player.lisp @@ -13,6 +13,9 @@ (defmethod opponents ((g game) &optional (player (session-value :player))) (remove player (players g))) +(defmethod live-opponents ((g game) &optional (player (session-value :player))) + (remove-if #'dead-p (opponents g player))) + (defmethod dead-p ((p player)) (every #'dead-p (ships p))) diff --git a/strifebarge.asd b/strifebarge.asd index 77848a2..19c4f07 100644 --- a/strifebarge.asd +++ b/strifebarge.asd @@ -28,7 +28,7 @@ #:ironclad #:parenscript #:cl-css - #:swank + #:cl-actors #:clsql) :components ((:file "package") (:file "util") (:file "model") diff --git a/strifebarge.lisp b/strifebarge.lisp index b7d543e..56234bd 100644 --- a/strifebarge.lisp +++ b/strifebarge.lisp @@ -48,7 +48,8 @@ (define-easy-handler (quit-game :uri "/quit-game") () (redirect-unless (not (null (session-value :player)))) - (push (session-value :player) (waiting-for (session-value :game))) + (unless (dead-p (session-value :player)) + (push (session-value :player) (waiting-for (session-value :game)))) (setf (session-value :player) nil (session-value :game) nil) "You have quit the game") diff --git a/util.lisp b/util.lisp index ca6956e..3c89b65 100644 --- a/util.lisp +++ b/util.lisp @@ -68,4 +68,7 @@ for each slot in instance." ;;;;;;;;;; flow control (defmacro redirect-unless (predicate &optional (target "/")) - `(unless ,predicate (redirect ,target))) \ No newline at end of file + `(unless ,predicate (redirect ,target))) + +;;;;;;;;;; other +(defun now () (clsql-sys::utime->time (get-universal-time))) \ No newline at end of file