6a94205a7e4f

Add GDL-II support
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Fri, 16 Sep 2016 14:22:01 +0000
parents a4e654d192f0
children d819a1f69da9
branches/tags (none)
files docs/03-reference.markdown docs/04-changelog.markdown package.lisp src/ggp.lisp

Changes

--- a/docs/03-reference.markdown	Wed Sep 14 15:22:18 2016 +0000
+++ b/docs/03-reference.markdown	Fri Sep 16 14:22:01 2016 +0000
@@ -151,13 +151,25 @@
 
   
 
+### `PLAYER-UPDATE-GAME-II` (generic function)
+
+    (PLAYER-UPDATE-GAME-II PLAYER MOVE PERCEPTS)
+
+Called after all players have made their moves in a GDL-II game.
+
+  `move` will be the move you played last turn.
+
+  `percepts` are all the percepts you see for the round.
+
+  
+
 ### `START-PLAYER` (function)
 
-    (START-PLAYER PLAYER &KEY (SERVER :HUNCHENTOOT))
+    (START-PLAYER PLAYER &KEY (SERVER :HUNCHENTOOT) (USE-THREAD T))
 
 Start the HTTP server for the given player.
 
-  The `:server` option will be passed along to Clack.
+  The `:server` and `:use-thread` options will be passed along to Clack.
 
   
 
--- a/docs/04-changelog.markdown	Wed Sep 14 15:22:18 2016 +0000
+++ b/docs/04-changelog.markdown	Fri Sep 16 14:22:01 2016 +0000
@@ -8,7 +8,9 @@
 Pending
 -------
 
-* `start-player` now takes a `:server` option which it passed along to Clack.
+* `start-player` now takes `:server` and `:use-thread` options which it passes
+  along to Clack.
+* Added rudimentary support for writing GDL-II players.
 
 v0.0.1
 ------
--- a/package.lisp	Wed Sep 14 15:22:18 2016 +0000
+++ b/package.lisp	Fri Sep 16 14:22:01 2016 +0000
@@ -6,6 +6,7 @@
 
     :player-start-game
     :player-update-game
+    :player-update-game-ii ; lol
     :player-select-move
     :player-stop-game
 
--- a/src/ggp.lisp	Wed Sep 14 15:22:18 2016 +0000
+++ b/src/ggp.lisp	Fri Sep 16 14:22:01 2016 +0000
@@ -1,6 +1,7 @@
 (in-package #:ggp)
 (named-readtables:in-readtable :fare-quasiquote)
 
+
 (defparameter *debug*
   t)
 
@@ -37,6 +38,10 @@
     ggp-rules::or
     ggp-rules::distinct
     ggp-rules::not
+
+    ;; GDL-II
+    ggp-rules::sees
+    ggp-rules::random
     ))
 
 
@@ -101,6 +106,16 @@
 
   "))
 
+(defgeneric player-update-game-ii (player move percepts)
+  (:documentation
+    "Called after all players have made their moves in a GDL-II game.
+
+  `move` will be the move you played last turn.
+
+  `percepts` are all the percepts you see for the round.
+
+  "))
+
 (defgeneric player-select-move (player timeout)
   (:documentation "Called when it's time for the player to select a move to play.
 
@@ -130,6 +145,9 @@
 (defmethod player-update-game ((player ggp-player) moves)
   nil)
 
+(defmethod player-update-game-ii ((player ggp-player) move percepts)
+  nil)
+
 (defmethod player-select-move ((player ggp-player) timeout)
   (error "Required method player-select-move is not implemented for ~A" player))
 
@@ -174,7 +192,8 @@
 ;;;; Clack Horseshit
 (defun l (&rest args)
   (when *debug*
-    (apply #'format *debug-io* args)))
+    (let ((*package* *rules-package*))
+      (apply #'format *debug-io* args))))
 
 (defun resp (body &key (code 200) (content-type "text/acl"))
   (list code
@@ -199,14 +218,15 @@
     (ggp-rules::species ggp-rules::alien)))
 
 (defun handle-start (player match-id role rules start-clock play-clock)
-  (setf (slot-value player 'current-match) match-id)
-  (setf (slot-value player 'start-clock) start-clock)
-  (setf (slot-value player 'play-clock) play-clock)
-  (setf (slot-value player 'match-roles) (find-roles rules))
+  (setf (slot-value player 'current-match) match-id
+        (slot-value player 'start-clock) start-clock
+        (slot-value player 'play-clock) play-clock
+        (slot-value player 'match-roles) (find-roles rules))
   (l "Starting match ~S as ~S~%" match-id role)
   (player-start-game player rules role (calculate-timeout player start-clock))
   'ggp-rules::ready)
 
+
 (defun handle-play (player match-id moves)
   (declare (ignore match-id))
   (l "Handling play request with moves ~S~%" moves)
@@ -214,13 +234,32 @@
   (player-select-move player
                       (calculate-timeout player (slot-value player 'play-clock))))
 
+(defun handle-play-ii (player match-id turn move percepts)
+  (declare (ignore match-id))
+  (l "Handling GDL-II play request (turn ~D)~%    with move: ~S~%    and percepts: ~S~%"
+     turn move percepts)
+  (player-update-game-ii player move percepts)
+  (player-select-move player
+                      (calculate-timeout player (slot-value player 'play-clock))))
+
+
+(defun cleanup-game (player)
+  (player-stop-game player)
+  (setf (slot-value player 'match-roles) nil)
+  (clear-rules-package)
+  (setf (slot-value player 'current-match) nil))
+
 (defun handle-stop (player match-id moves)
   (l "Handling stop request for ~S~%" match-id)
   (player-update-game player (zip-moves player moves))
-  (player-stop-game player)
-  (setf (slot-value player 'current-match) nil)
-  (setf (slot-value player 'match-roles) nil)
-  (clear-rules-package)
+  (cleanup-game player)
+  'ggp-rules::done)
+
+(defun handle-stop-ii (player match-id turn move percepts)
+  (declare (ignore turn))
+  (l "Handling GDL-II stop request for ~S~%" match-id)
+  (player-update-game-ii player move percepts)
+  (cleanup-game player)
   'ggp-rules::done)
 
 
@@ -233,9 +272,15 @@
     (`(ggp-rules::play ,match-id ,moves)
      (handle-play player match-id moves))
 
+    (`(ggp-rules::play ,match-id ,turn ,move ,percepts)
+     (handle-play-ii player match-id turn move percepts))
+
     (`(ggp-rules::stop ,match-id ,moves)
      (handle-stop player match-id moves))
 
+    (`(ggp-rules::stop ,match-id ,turn ,move ,percepts)
+     (handle-stop-ii player match-id turn move percepts))
+
     (`(ggp-rules::start ,match-id ,role ,rules ,start-clock ,play-clock)
      (handle-start player match-id role rules start-clock play-clock))
 
@@ -258,8 +303,8 @@
              (should-log (should-log-p request)))
         (when should-log
           (l "~%~%Got a request ====================================~%")
-          (l "~S~%" body)
-          (l "~A~%" (render-to-string request))
+          ; (l "~S~%" body)
+          (l "~A~%" request)
           (l "==================================================~%"))
         (let* ((response (route player request))
                (rendered-response (render-to-string response)))
@@ -272,16 +317,17 @@
 
 
 ;;;; Spinup/spindown
-(defun start-player (player &key (server :hunchentoot))
+(defun start-player (player &key (server :hunchentoot) (use-thread t))
   "Start the HTTP server for the given player.
 
-  The `:server` option will be passed along to Clack.
+  The `:server` and `:use-thread` options will be passed along to Clack.
 
   "
   (let* ((player-handler #'(lambda (env) (app player env)))
          (server (clack:clackup player-handler
                                 :port (player-port player)
-                                :server server)))
+                                :server server
+                                :use-thread use-thread)))
     (setf (slot-value player 'server) server)
     player))