Skip to content
Browse files

-Added cl-actors into the mix for game-state management

-Added a way of dealing with timed out players
  • Loading branch information...
1 parent 52cf52f commit 018adc827bf05476e30034681cb621e0eb001108 inaimathi committed Mar 15, 2012
Showing with 61 additions and 10 deletions.
  1. +38 −2 game.lisp
  2. +1 −1 js.lisp
  3. +8 −2 model.lisp
  4. +4 −2 package.lisp
  5. +3 −0 player.lisp
  6. +1 −1 strifebarge.asd
  7. +2 −1 strifebarge.lisp
  8. +4 −1 util.lisp
View
40 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))
+ 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)))
View
2 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)))))
View
10 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)))
+ (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)))
View
6 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")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
View
3 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)))
View
2 strifebarge.asd
@@ -28,7 +28,7 @@
#:ironclad
#:parenscript
#:cl-css
- #:swank
+ #:cl-actors
#:clsql)
:components ((:file "package")
(:file "util") (:file "model")
View
3 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")
View
5 util.lisp
@@ -68,4 +68,7 @@ for each slot in instance."
;;;;;;;;;; flow control
(defmacro redirect-unless (predicate &optional (target "/"))
- `(unless ,predicate (redirect ,target)))
+ `(unless ,predicate (redirect ,target)))
+
+;;;;;;;;;; other
+(defun now () (clsql-sys::utime->time (get-universal-time)))

0 comments on commit 018adc8

Please sign in to comment.
Something went wrong with that request. Please try again.