-Split game.lisp off into three files (game, player and history-event)

-Removed some testing code that managed to slip by
-Amended .asd
-Added finished-p field to game (though it's not used yet)

game.lisp

@@ -4,12 +4,6 @@
 
 ;;;;;;;;;;;;;;;;;;;; game creation and setup
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun make-player (&rest ship-types)
-  (let ((p (make-instance 'player)))
-    (setf (ships p)
-	  (mapcar (lambda (s) (make-instance s :player p)) ship-types))
-    p))
-
 (defun make-game (&rest players)
   (let ((board (make-board (mapcan-f #'ships players))))
     (make-instance 'game :board board :players players :waiting-for players :turn-stack players)))
@@ -22,49 +16,9 @@
 (defmethod ships ((g game)) 
   (mapcan-f #'ships (players g)))
 
-(defmethod opponents ((g game) &optional (player (session-value :player)))
-  (remove player (players g)))
-
 (defmethod turn-p ((g game) &optional (player (session-value :player))) 
   (eq (car (turn-stack g)) player))
 
-(defmethod dead-p ((p player))
-  (every #'dead-p (ships p)))
-
-;;;;;;;;;;;;;;;;;;;; history related
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; creation
-(defmethod to-json ((m move))
-  (encode-json-to-string `((x . ,(x m)) (y . ,(y m)) 
-			   (text . ,(echo m (session-value :player))))))
-
-(defmethod push-record ((g game) event-type message)
-  (push (make-instance 'history-event
-		       :id (length (history g))
-		       :event-type event-type
-		       :message message)
-	(history g)))
-
-;;; display
-(defmethod emit-record ((g game) (p player))
-  (apply #'concatenate 
-	 (cons 'string 
-	       (mapcar (lambda (r) (emit-record r p)) 
-		       (reverse (take 10 (history g)))))))
-
-(defmethod emit-record ((e history-event) (p player))
-  (format nil "id: ~a~%event: ~a~%data: ~a~%~%"
-	  (id e) (event-type e) (message e)))
-
-;;; game logic
-(defmethod death-check ((g game) (s ship))
-  (when (dead-p s) 
-    (push-record g "ship-sunk" 
-		 (encode-json-to-string `((:type . ,(type-of s)) 
-					  (:id . ,(instance-to-id s))))))
-  (when (dead-p (player s))
-    (push-record g "player-eliminated" (instance-to-id (player s)))))
-
 ;;;;;;;;;;;;;;;;;;;; display
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defmethod echo ((g game) (p player)) (echo (board g) p))
@@ -80,29 +34,6 @@
 		      do (echo-opponent a-player)))
 	  (:a :class "menu-item" :href "/quit-game" "Quit Game"))))
 
-(defmethod echo-opponent ((p player))
-  (html-to-stout
-    (:h5 :id (instance-to-id p) 
-	 :class (when (dead-p p) "dead-player") 
-	 "An Opponent")
-    (:ul (loop for s in (shuffle (ships p)) 
-	       do (echo-opponent-ship s)))))
-
-(defmethod echo-opponent-ship ((s ship))
-  (html-to-stout 
-    (:li :class (format nil "~a ~@[~a~]" 
-			(instance-to-id s) 
-			(when (dead-p s) "dead-ship"))  
-	 (str (if (dead-p s)
-		  (string-downcase (type-of s))
-		  "???")))))
-
-(defmethod echo-stats ((p player))
-  (html-to-stout 
-    (:div :class "player-ships"
-	  (loop for s in (ships p)
-		do (str (echo-stats s))))))
-
 ;;;;;;;;;;;;;;;;;;;; actions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defmethod advance-turn ((g game))

history-event.lisp

@@ -0,0 +1,36 @@
+(in-package :strifebarge)
+
+;;;;;;;;;;;;;;;;;;;; creation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmethod to-json ((m move))
+  (encode-json-to-string `((x . ,(x m)) (y . ,(y m)) 
+			   (text . ,(echo m (session-value :player))))))
+
+(defmethod push-record ((g game) event-type message)
+  (push (make-instance 'history-event
+		       :id (length (history g))
+		       :event-type event-type
+		       :message message)
+	(history g)))
+
+;;;;;;;;;;;;;;;;;;;; display
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmethod emit-record ((g game) (p player))
+  (apply #'concatenate 
+	 (cons 'string 
+	       (mapcar (lambda (r) (emit-record r p)) 
+		       (reverse (take 10 (history g)))))))
+
+(defmethod emit-record ((e history-event) (p player))
+  (format nil "id: ~a~%event: ~a~%data: ~a~%~%"
+	  (id e) (event-type e) (message e)))
+
+;;;;;;;;;;;;;;;;;;;; game logic
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmethod death-check ((g game) (s ship))
+  (when (dead-p s) 
+    (push-record g "ship-sunk" 
+		 (encode-json-to-string `((:type . ,(type-of s)) 
+					  (:id . ,(instance-to-id s))))))
+  (when (dead-p (player s))
+    (push-record g "player-eliminated" (instance-to-id (player s)))))

model.lisp

@@ -48,4 +48,5 @@
    (players :accessor players :initarg :players)
    (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)))

player.lisp

@@ -0,0 +1,33 @@
+(in-package :strifebarge)
+
+;;;;;;;;;;;;;;;;;;;; player creation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun make-player (&rest ship-types)
+  (let ((p (make-instance 'player)))
+    (setf (ships p)
+	  (mapcar (lambda (s) (make-instance s :player p)) ship-types))
+    p))
+
+;;;;;;;;;;;;;;;;;;;; predicates and getters
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmethod opponents ((g game) &optional (player (session-value :player)))
+  (remove player (players g)))
+
+(defmethod dead-p ((p player))
+  (every #'dead-p (ships p)))
+
+;;;;;;;;;;;;;;;;;;;; display
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmethod echo-stats ((p player))
+  (html-to-stout 
+    (:div :class "player-ships"
+	  (loop for s in (ships p)
+		do (str (echo-stats s))))))
+
+(defmethod echo-opponent ((p player))
+  (html-to-stout
+    (:h5 :id (instance-to-id p) 
+	 :class (when (dead-p p) "dead-player") 
+	 "An Opponent")
+    (:ul (loop for s in (shuffle (ships p)) 
+	       do (echo-opponent-ship s)))))

ship.lisp

@@ -68,4 +68,13 @@ ensuring there are no collisions."
 		       :style (inline-css `(:left ,(css-left s) :top ,(px (board-scale (y s)))
 					    :width ,(board-scale (len s)) :height ,(board-scale (wid s))
 					    ,@(when (eq :vertical direction) (css-rotate 90))))
-		       :src (image-file s)))))
+		       :src (image-file s)))))
+
+(defmethod echo-opponent-ship ((s ship))
+  (html-to-stout 
+    (:li :class (format nil "~a ~@[~a~]" 
+			(instance-to-id s) 
+			(when (dead-p s) "dead-ship"))  
+	 (str (if (dead-p s)
+		  (string-downcase (type-of s))
+		  "???")))))

strifebarge.asd

@@ -33,7 +33,7 @@
   :components ((:file "package")
 	       (:file "util") (:file "model") 
 	       (:file "js-macros") (:file "js") (:file "css")
-	       (:file "space") (:file "ship") (:file "board") (:file "game")
+	       (:file "space") (:file "ship") (:file "board") (:file "game") (:file "history-event") (:file "player")
                (:file "strifebarge")
 	       (:file "start")))
 

strifebarge.lisp

@@ -11,11 +11,9 @@
 		  (:link :rel "stylesheet" :type "text/css" :href "/css/strifebarge.css"))
 	   (:body (:a :class "menu-item" :href "/new-game" "New Game")
 		  (:div :id "Games Menu"
-			(loop for (name . g) in *games-table*
-			      do (htm (:li (:a :href (format nil "/join-game?game-name=~a" name)
-					       (str (format nil "~a[~a]" name (length (waiting-for g)))))))))
-		  (:p (str (format nil "~{~a~}" (list (session-value :game)
-						      (session-value :player)))))))))
+			(:ul (loop for (name . g) in *games-table*
+				   do (htm (:li (:a :href (format nil "/join-game?game-name=~a" name)
+						    (str (format nil "~a[~a]" name (length (waiting-for g))))))))))))))
 
 (define-easy-handler (new-game :uri "/new-game") (player-count)
   (if (> 20 (length *games-table*))