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

-Added a way of dealing with timed out players

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)))

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)))))
 

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)))

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")
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 

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)))
 

strifebarge.asd

@@ -28,7 +28,7 @@
 	       #:ironclad
                #:parenscript
                #:cl-css
-               #:swank
+	       #:cl-actors
                #:clsql)
   :components ((:file "package")
 	       (:file "util") (:file "model") 

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")
 

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)))