Sketch out an initial skeleton architecture
author |
Steve Losh <steve@stevelosh.com> |
date |
Thu, 08 Sep 2016 18:08:55 +0000 |
parents |
87b80a1dabb2
|
children |
86ab44c2dfa8
|
branches/tags |
(none) |
files |
README.markdown package.lisp scully.asd src/brains/random.lisp src/player.lisp src/scully.lisp |
Changes
--- a/README.markdown Thu Sep 08 14:53:36 2016 +0000
+++ b/README.markdown Thu Sep 08 18:08:55 2016 +0000
@@ -7,7 +7,7 @@
Skinner: As you compound the lies, you compound the consequences for them.
Scully: All lies lead to the truth.
-Scully is a [General Game Player][ggp] for imperfect-information games.
+Scully is a [General Game Player][ggp] for incomplete-information games.
* **License:** MIT/X11
--- a/package.lisp Thu Sep 08 14:53:36 2016 +0000
+++ b/package.lisp Thu Sep 08 18:08:55 2016 +0000
@@ -1,6 +1,19 @@
-(defpackage #:scully
+(defpackage #:scully.brains.random
(:use
#:cl
+ #:losh
+ #:iterate
+ #:cl-arrows
#:scully.quickutils)
(:export
))
+
+(defpackage #:scully.player
+ (:use
+ #:cl
+ #:losh
+ #:iterate
+ #:cl-arrows
+ #:scully.quickutils)
+ (:export
+ ))
--- a/scully.asd Thu Sep 08 14:53:36 2016 +0000
+++ b/scully.asd Thu Sep 08 18:08:55 2016 +0000
@@ -1,13 +1,18 @@
(asdf:defsystem #:scully
:name "scully"
- :description "A General Game Player for imperfect-information games"
+ :description "A General Game Player for incomplete-information games"
:author "Steve Losh <steve@stevelosh.com>"
:license "MIT/X11"
:version "1.0.0"
- :depends-on ()
+ :depends-on (#:iterate
+ #:losh
+ #:cl-arrows
+ #:cl-ggp
+ #:cl-conspack
+ #:usocket)
:serial t
:components ((:module "vendor"
@@ -17,5 +22,8 @@
(:file "package")
(:module "src"
:serial t
- :components ((:file "scully")))))
+ :components ((:module "brains"
+ :serial nil
+ :components ((:file "random")))
+ (:file "player")))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/brains/random.lisp Thu Sep 08 18:08:55 2016 +0000
@@ -0,0 +1,81 @@
+(in-package #:scully.brains.random)
+
+
+;;;; Data ---------------------------------------------------------------------
+(defparameter *brain* nil)
+(defparameter *server* nil)
+
+
+;;;; Random Brain -------------------------------------------------------------
+(defclass random-brain ()
+ ((role :type symbol :accessor brain-role)
+ (database :accessor brain-database)
+ (state :accessor brain-state)))
+
+
+(defun start-game (brain rules role timeout)
+ (setf (brain-role brain) role
+ (brain-database brain) (make-database))
+ (with-database (brain-database brain)
+ (load-gdl-preamble)
+ (push-logic-frame-with
+ (load-rules rules))
+ (setf (brain-state brain) (initial-state))))
+
+(defun stop-game (brain)
+ (setf (brain-state brain) nil
+ (brain-database brain) nil
+ (brain-role brain) nil))
+
+(defun update-game (brain moves)
+ (when moves
+ (with-database (brain-database brain)
+ (apply-state (brain-state brain))
+ (apply-moves moves)
+ (setf (brain-state brain) (next-state))
+ (clear-moves)
+ (clear-state))))
+
+(defun random-nth (list)
+ (nth (random (length list)) list))
+
+(defun select-move (brain timeout)
+ (with-database (brain-database brain)
+ (prog2
+ (apply-state (brain-state brain))
+ (cdr (random-nth (legal-moves-for (brain-role brain))))
+ (clear-state))))
+
+
+;;;; Sockets ------------------------------------------------------------------
+(defun read-message (stream)
+ (conspack:decode-stream stream))
+
+(defun write-message (out stream &rest message)
+ (format out "writing to stream... ~S~%" message)
+ (conspack:encode message :stream stream)
+ (finish-output stream))
+
+(defun handle (stream brain out)
+ (loop
+ (destructuring-bind (tag . arguments)
+ (read-message stream)
+ (case tag
+ (:quit (return-from handle))
+ (:double (write-message out stream (* 2 (car arguments))))
+ (t (format out "Unknown message: ~S ~S~%" tag arguments))))))
+
+(defun run-brain-server (brain port)
+ (setf *server*
+ (usocket:socket-server
+ "127.0.0.1" port
+ 'handle (list brain *standard-output*)
+ :in-new-thread t
+ :protocol :stream
+ :element-type '(unsigned-byte 8)
+ :reuse-address t)))
+
+(defun run-brain (port)
+ (let ((brain (make-instance 'random-brain)))
+ (setf *brain* brain)
+ (run-brain-server brain port)))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/player.lisp Thu Sep 08 18:08:55 2016 +0000
@@ -0,0 +1,94 @@
+(in-package #:scully.player)
+
+
+;;;; Brain Connections --------------------------------------------------------
+(defstruct (brain (:constructor %make-brain (name stream socket)))
+ name stream socket)
+
+
+(defun make-brain (name port)
+ (let ((socket (usocket:socket-connect "127.0.0.1" port
+ :protocol :stream
+ :element-type '(unsigned-byte 8))))
+ (%make-brain name (usocket:socket-stream socket) socket)))
+
+
+(defun brain-send (brain tag &rest arguments)
+ (conspack:encode (list* tag arguments)
+ :stream (brain-stream brain))
+ (finish-output (brain-stream brain))
+ (values))
+
+(defun brain-read (brain)
+ (values (conspack:decode-stream (brain-stream brain))))
+
+
+;;;; Player -------------------------------------------------------------------
+(defclass scully-player (ggp:ggp-player)
+ ((brains :accessor player-brains :initarg :brains)))
+
+(defun make-player ()
+ (make-instance 'scully-player
+ :name "Scully"
+ :port 5000
+ :brains (list (make-brain :random 5001))))
+
+
+(defun broadcast-to-brains (player tag &rest arguments)
+ (iterate (for brain :in (player-brains player))
+ (apply #'brain-send brain tag arguments))
+ (values))
+
+(defun gather-responses (player timeout)
+ (iterate
+ (with remaining = (player-brains player))
+ (with results = nil)
+ (when (null remaining)
+ (return results))
+ (for (values ready remaining-time) = (usocket:wait-for-input
+ (mapcar #'brain-socket remaining)
+ :timeout timeout
+ :ready-only t))
+ (if (null remaining-time)
+ (return results)
+ (progn
+ (setf timeout remaining-time)
+ (iterate
+ (for brain :in (copy-list remaining))
+ (when (member (brain-socket brain) ready)
+ (push (cons (brain-name brain) (brain-read brain)) results)
+ (setf remaining (remove brain remaining))))))))
+
+(defun select-move-response (responses)
+ (let ((resp-random (assoc :random responses)))
+ (cdr resp-random)))
+
+
+(defmethod ggp:player-start-game ((player scully-player) rules role timeout)
+ (broadcast-to-brains player :start rules role timeout))
+
+(defmethod ggp:player-stop-game ((player scully-player))
+ (broadcast-to-brains player :stop)
+ (broadcast-to-brains player :quit))
+
+(defmethod ggp:player-update-game ((player scully-player) moves)
+ (broadcast-to-brains player :update moves))
+
+(defmethod ggp:player-select-move ((player scully-player) timeout)
+ (broadcast-to-brains player :start-thinking)
+ (let ((seconds (* internal-time-units-per-second
+ (- timeout (get-internal-real-time)))))
+ (sleep (- seconds 2))
+ (broadcast-to-brains player :request-move)
+ (select-move-response (gather-responses player (- seconds 1)))))
+
+
+(defvar *player* nil)
+
+(defun start-player ()
+ (setf *player* (make-player))
+ (ggp:start-player *player*)
+ *player*)
+
+; (ggp:start-player *player*)
+; (ggp:kill-player *player*)
--- a/src/scully.lisp Thu Sep 08 14:53:36 2016 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1 +0,0 @@
-(in-package #:scully)