# HG changeset patch # User Steve Losh # Date 1474035721 0 # Node ID 6a94205a7e4f0afd550b7754ab06fd7e1ec2650d # Parent a4e654d192f0f31547461d1fc9b311a6d799f93a Add GDL-II support diff -r a4e654d192f0 -r 6a94205a7e4f docs/03-reference.markdown --- 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. diff -r a4e654d192f0 -r 6a94205a7e4f docs/04-changelog.markdown --- 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 ------ diff -r a4e654d192f0 -r 6a94205a7e4f package.lisp --- 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 diff -r a4e654d192f0 -r 6a94205a7e4f src/ggp.lisp --- 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))