77db7de3a21c

Sketch out an initial skeleton architecture
[view raw] [browse files]
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)