Add new note about board not being time travel friendly

- Need to figure out why main thread is blocking the vat promises from resolving.

Makefile.am

@@ -35,7 +35,8 @@ SUFFIXES = .scm .go
 
 SOURCES = gib-gab-gob/rps.scm \
 					gib-gab-gob/game.scm \
-					gib-gab-gob/board.scm
+					gib-gab-gob/board.scm \
+					gib-gab-gob/ui/console.scm
 
 TESTS =
 

bootstrap.sh

@@ -0,0 +1,3 @@
+#!/bin/sh
+
+autoreconf -vif

gib-gab-gob/board.scm

@@ -2,10 +2,15 @@
   #:use-module (srfi srfi-1)
   #:export (make-board
             board-ref
+            board-assert-vacant
             board-choose!
             board-display
             board-winner?))
 
+;; TODO: This board is no longer time-travel friendly!
+;; Have to decide if we go back to the old board with one actor per cell,
+;; or make a new version. Board could becom a new board containing the new mark.
+
 (define ggg-size 3) ;; tic tac toe with more than 3x3 grid?
 
 (define (make-board)
@@ -14,11 +19,13 @@
 (define (board-ref board x y)
   (array-ref board y x))
 
-(define (board-choose! board val x y)
+(define (board-assert-vacant board x y)
   (define ref (board-ref board x y))
-  (if ref
-      (error "That space is already occupied with:" ref)
-      (array-set! board val y x)))
+  (if ref (error "That space is already occupied with:" ref) ref))
+
+(define (board-choose! board val x y)
+  (board-assert-vacant board x y)
+  (array-set! board val y x))
 
 (define (board-display board)
   (array-slice-for-each-in-order

gib-gab-gob/game.scm

@@ -1,42 +1,59 @@
 (define-module (gib-gab-gob game)
+  #:use-module (fibers)
+  #:use-module (fibers channels)
   #:use-module (goblins)
+  #:use-module (goblins vat)
+  #:use-module (goblins actor-lib cell)
   #:use-module (goblins actor-lib methods)
   #:use-module (goblins actor-lib sealers)
   #:use-module (gib-gab-gob board)
   #:export (^ggg-controller))
 
 ;; Actual Tic Tac Toe game
-(define (^ggg-controller bcom won? peer)
-  (define mark (if won? 'x 'o))
-  (define peer-mark (if won? 'o 'x))
-  (define board (make-board))
-  (define my-turn? won?)
-  (define (i-won?) (board-winner? board mark))
-  (define (peer-won?) (board-winner? board peer-mark))
-  (define (display)
-    (board-display board)
-    (format #t "-> It is ~a turn!\n" (if my-turn? "my" "peer's"))
-    (when (i-won?) (format #t "*** I won! ***\n"))
-    (when (peer-won?) (format #t "*** I lost! ***\n")))
-   (display)
+(define (^ggg-controller bcom board state+ first? peer)
+  (define mark (if first? 'x 'o))
+  (define peer-mark (if first? 'o 'x))
+  (define %my-turn? (spawn ^cell first?))
+  (define (%state)
+    (cond
+     ((board-winner? board mark) 'won)
+     ((board-winner? board peer-mark) 'lost)
+     (else 'play)))
+  (define (signal-turn)
+    (syscaller-free-fiber (λ () (put-message state+ (%state))))
+    #f)
+  (define (switch-turn!)
+    (let ((new-turn (not ($ %my-turn?))))
+      ($ %my-turn? new-turn)
+      (when new-turn (signal-turn))
+      #f))
+  (when first? (signal-turn))
   (methods
    ;; The peer is telling us about the turn it took.
    [(peer-turn! x y)
-    (if (not my-turn?)
+    (if (not ($ %my-turn?))
         (begin
           (board-choose! board peer-mark x y)
-          (set! my-turn? (not my-turn?))
-          (display))
+          (switch-turn!))
         (error "It's my turn!"))]
    ;; TODO: These need to go somewhere else so the peer can't move or init for us!
    [(try-transition) 'playing]
+   [(my-turn?) ($ %my-turn?)]
+   [(my-mark) mark]
+   [(state) (%state)]
    [(initialize!)
-    (on (<- peer 'try-transition) (lambda (status) (format #t "Peer's status: ~a\n" status)) #:promise? #t)]
+    (on (<- peer 'try-transition)
+        (λ (status)
+          (format #t "Peer's status: ~a\n" status)
+          status) #:promise? #t)]
    [(my-turn! x y)
-    (if my-turn?
+    (if ($ %my-turn?)
         (begin
-          (board-choose! board mark x y)
-          (set! my-turn? (not my-turn?))
-          (display)
-          (<- peer 'peer-turn! x y))
+          (board-assert-vacant board x y)
+          (on (<- peer 'peer-turn! x y)
+              (λ (_)
+                (board-choose! board mark x y)
+                (switch-turn!)
+                (%state))
+              #:promise? #t))
         (error "It's not my turn."))]))

gib-gab-gob/rps.scm

@@ -6,48 +6,41 @@
   #:use-module (goblins ocapn captp)
   #:use-module (goblins ocapn ids)
   #:use-module (goblins ocapn netlayer onion)
-  #:export (make-initiator make-joiner ^game-initiator ^game-joiner))
+  #:use-module (gib-gab-gob board)
+  #:use-module (fibers conditions)
+  #:export (initiator/connect ^game-initiator ^game-joiner))
 
 ;;
 ;; Initiator logic
 ;;
-(define (make-initiator ^game-controller)
-  (with-vat (spawn-vat)
-            (define initiator (spawn ^game-initiator ^game-controller))
-            (define mycapn (spawn-mycapn (new-onion-netlayer)))
-            (define init-sref ($ mycapn 'register initiator 'testuds))
-            (format #t "Connect to: ~a\n" (ocapn-id->string init-sref))))
+;; use this one
+(define (initiator/connect initiator)
+  (define mycapn (spawn-mycapn (new-onion-netlayer)))
+  (define init-sref ($ mycapn 'register initiator 'onion))
+  (format #t "Connect to: ~a\n" (ocapn-id->string init-sref)))
 
-(define (^game-initiator bcom ^game-controller)
+(define (^game-initiator bcom ^game-controller board state+)
   (define pick (pick-rps))
   (define won? #nil)
   (define peer #nil)
   (methods
-   [(register-opponent name p sealed-pick)
+   [(register-opponent p sealed-pick)
     (set! peer p)
-    (format #t "Hey there, ~a! You sent me your pick of rock-paper-scissors; now I will send mine.\n" name)
+    (format #t "Hey there! You sent me your pick of rock-paper-scissors; now I will send mine.\n")
     (on (<- (<- peer 'pick->unsealer pick) sealed-pick)
         (λ (peer-pick)
           (set! won? (rps-winner pick peer-pick))
-          (format #t "Opponent ~a has picked ~a (do I win? ~a). Ready to be a controller.\n" name peer-pick won?)))]
+          (format #t "Opponent has picked ~a (do I win? ~a). Ready to be a controller.\n" peer-pick won?)))]
     [(try-transition)
      (if (eq? won? #nil)
          'connecting
-         (bcom (^game-controller bcom won? peer) 'ready-to-play))]))
+         (bcom (^game-controller bcom board state+ won? peer) 'ready-to-play))]))
 
 ;;
 ;; Joiner logic
 ;;
-(define (make-joiner ^game-controller user-name addr)
-  (with-vat (spawn-vat)
-            (define mycapn (spawn-mycapn (new-onion-netlayer)))
-            (define init-sref (string->ocapn-id addr))
-            (define initiator ($ mycapn 'enliven init-sref))
-            (define joiner (spawn ^game-joiner initiator ^game-controller))
-            (on (<- initiator 'register-opponent user-name joiner ($ joiner 'get-sealed-pick))
-                (λ (_) (format #t "~a finished the game.\n" user-name)))))
 
-(define (^game-joiner bcom initiator ^game-controller)
+(define (^game-joiner bcom initiator ^game-controller board state+)
   (define-values (seal-pick unseal-pick my-pick?)
     (spawn-sealer-triplet))
   (define pick (pick-rps))
@@ -59,7 +52,7 @@
     ;; We make the assumption that initiator is to become a controller.
     ;; Note second arg to bcom which will return the value (this is confusing to me)
     ;; see https://spritely.institute/files/docs/guile-goblins/0.11.0/Object-construction.html
-    (bcom (^game-controller bcom won? initiator) unseal-pick)]))
+    (bcom (^game-controller bcom board state+ won? initiator) unseal-pick)]))
 
 ;;
 ;; Standard rock paper scissors logic follows!

gib-gab-gob/ui/console.scm

@@ -0,0 +1,98 @@
+(define-module (gib-gab-gob ui console)
+  #:use-module (gib-gab-gob rps)
+  #:use-module (gib-gab-gob game)
+  #:use-module (gib-gab-gob board)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 exceptions)
+  #:use-module (ice-9 suspendable-ports)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-1)
+  #:use-module (fibers)
+  #:use-module (fibers channels)
+  #:use-module (goblins)
+  #:use-module (goblins vat)
+  #:use-module (goblins ocapn captp)
+  #:use-module (goblins ocapn ids)
+  #:use-module (goblins ocapn netlayer onion)
+  #:export (make-initiator make-joiner))
+
+;; https://www.gnu.org/software/guile/manual/guile.html#Non_002dBlocking-I_002fO
+(let* ((input (current-input-port))
+       (flags (fcntl input F_GETFL)))
+  (fcntl input F_SETFL (logior O_NONBLOCK flags)))
+(install-suspendable-ports!)
+
+(random-state-from-platform)
+
+;; Module for simple console-based UI (no curses)
+
+;; A single run of the loop for a bespoke REPL for playing the game
+(define (%loop vat b controller state+)
+  (define state (get-message state+))
+  (%print b state)
+  (if (eq? state 'play)
+      (let ((coords (%read)))
+        (with-vat
+         vat
+         (if coords (%eval vat b controller coords) #f)))
+      #f))
+
+(define (%read)
+  (%prompt)
+  (let ((line (read-line (current-input-port))))
+    (if (string-prefix? ",q" line) #f
+        (let ((coords (map string->number (string-tokenize line char-set:digit))))
+          (if (not (= (length coords) 2))
+              (begin (format #t "Must be two numbers, x y; or ,quit to quit. Try again.\n")
+                     (%prompt) (%read))
+              coords)))))
+
+(define (%eval vat b controller coordinates)
+  ;; weird?
+  (let ((x (first coordinates))
+        (y (second coordinates)))
+    (on (<- controller 'my-turn! x y)
+        (λ (state) (%display b state)))))
+
+(define (%print b state)
+  (%display b state))
+
+(define (%prompt) (format #t "Enter your move: "))
+
+(define (%display b state)
+  (board-display b)
+  (cond
+   ((eq? state 'won) (format #t "*** I won! ***\n"))
+   ((eq? state 'lost) (format #t "*** I lost! ***\n"))))
+
+(define (begin-game-loop board controller state+)
+  (define vat (spawn-vat #:name "UI"))
+  (syscaller-free-fiber
+   (λ ()
+     (while (%loop vat board controller state+))
+     (format #t "bye-bye!\n")
+     #f)))
+
+(define (make-initiator)
+  (with-vat
+   (spawn-vat #:name "Initiator Game")
+   (define state+ (make-channel))
+   (define board (make-board))
+   (define initiator (spawn ^game-initiator ^ggg-controller board state+))
+   (initiator/connect initiator)
+   (begin-game-loop board initiator state+)))
+
+(define (make-joiner ^game-controller addr)
+  (with-vat
+   (spawn-vat #:name "Joiner Game")
+   (define mycapn (spawn-mycapn (new-onion-netlayer)))
+   (define state+ (make-channel))
+   (define board (make-board))
+   (let* ((init-sref (string->ocapn-id addr))
+          (initiator ($ mycapn 'enliven init-sref))
+          (joiner (spawn ^game-joiner initiator ^game-controller board state+))
+          (sealed ($ joiner 'get-sealed-pick)))
+     (on (<- initiator 'register-opponent joiner sealed)
+         (λ (_)
+           (on ($ joiner 'initialize!)
+               (λ (status) (begin-game-loop board joiner state+) #f)))))))

guix.scm

@@ -3,17 +3,26 @@
   ((guix licenses) #:prefix license:)
   (guix download)
   (guix build-system gnu)
+	(guix gexp)
   (gnu packages)
   (gnu packages autotools)
   (gnu packages guile)
   (gnu packages guile-xyz)
   (gnu packages pkg-config)
-  (gnu packages texinfo))
+  (gnu packages texinfo)
+	(srfi srfi-1))
+
+(define (keep-file? file stat)
+  (not (any (lambda (my-string)
+              (string-contains file my-string))
+            (list ".git" ".dir-locals.el" "guix.scm"))))
 
 (package
   (name "gib-gab-gob")
   (version "0.1")
-  (source "./gib-gab-gob-0.1.tar.gz")
+  (source (local-file (dirname (current-filename))
+                      #:recursive? #t
+                      #:select? keep-file?))
   (build-system gnu-build-system)
   (arguments
     `(#:modules

hall.scm

@@ -16,30 +16,32 @@
   (files (libraries
            ((directory
               "gib-gab-gob"
-              ((compiled-scheme-file "game")
-               (scheme-file "rps")
-               (scheme-file "game")
+              ((directory "ui" ((scheme-file "console")))
                (compiled-scheme-file "board")
+               (scheme-file "game")
                (scheme-file "board")
+               (scheme-file "rps")
+               (compiled-scheme-file "game")
                (compiled-scheme-file "rps")))))
-         (tests ((directory "tests" ())))
+         (tests ())
          (programs
            ((directory
               "scripts"
-              ((in-file "make-joiner")
-               (in-file "make-initiator")
+              ((in-file "make-initiator")
+               (text-file "make-joiner")
                (text-file "make-initiator")
-               (text-file "make-joiner")))))
-         (documentation ((org-file "README")))
+               (in-file "make-joiner")))))
+         (documentation
+           ((text-file "COPYING") (org-file "README")))
          (infrastructure
-           ((in-file "pre-inst-env")
+           ((shell-file "bootstrap")
+            (scheme-file "guix")
+            (in-file "pre-inst-env")
             (directory
               "build-aux"
-              ((tex-file "texinfo")
-               (scheme-file "test-driver")
+              ((scheme-file "test-driver")
                (text-file "missing")
-               (text-file "install-sh")
-               (text-file "mdate-sh")))
+               (text-file "install-sh")))
             (scheme-file "hall")
             (text-file ".gitignore")
             (autoconf-file "configure")

scripts/make-initiator.in

@@ -4,7 +4,9 @@
 
 (use-modules
  (gib-gab-gob rps)
- (gib-gab-gob game))
-(make-initiator ^ggg-controller)
+ (gib-gab-gob game)
+ (gib-gab-gob ui console))
+
+(make-initiator)
 
 (while #t #f) ;; indefinitely

scripts/make-joiner.in

@@ -3,7 +3,7 @@
 !#
 
 (use-modules
- (gib-gab-gob rps)
+ (gib-gab-gob ui console)
  (gib-gab-gob game))
 (apply make-joiner (cons ^ggg-controller (cdr (command-line))))