# HG changeset patch # User Steve Losh # Date 1473358135 0 # Node ID 77db7de3a21c44087cdb2ee67ae87abe322be2f6 # Parent 87b80a1dabb28ee33fa2619e7b384cf681cc1e84 Sketch out an initial skeleton architecture diff -r 87b80a1dabb2 -r 77db7de3a21c README.markdown --- 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 diff -r 87b80a1dabb2 -r 77db7de3a21c package.lisp --- 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 + )) diff -r 87b80a1dabb2 -r 77db7de3a21c scully.asd --- 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 " :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"))))) diff -r 87b80a1dabb2 -r 77db7de3a21c src/brains/random.lisp --- /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))) diff -r 87b80a1dabb2 -r 77db7de3a21c src/player.lisp --- /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*) diff -r 87b80a1dabb2 -r 77db7de3a21c src/scully.lisp --- 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)