Code for joiner too! It works!

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 =
 

gib-gab-gob/game.scm

@@ -1,4 +1,6 @@
 (define-module (gib-gab-gob game)
+  #:use-module (fibers)
+  #:use-module (fibers channels)
   #:use-module (goblins)
   #:use-module (goblins actor-lib methods)
   #:use-module (goblins actor-lib sealers)
@@ -6,39 +8,50 @@
   #: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 my-turn+ first? peer)
+  (define mark (if first? 'x 'o))
+  (define peer-mark (if first? 'o 'x))
+  (define %my-turn? first?)
+  (define (%state)
+    (cond
+     ((board-winner? board mark) => 'won)
+     ((board-winner? board peer-mark) => 'lost)
+     (else 'play)))
+  (define (signal-turn)
+    ;; any better way to do this?
+    (spawn-fiber (λ () (put-message my-turn+ #t)))
+    #f)
+  (define (switch-turn!)
+    (set! %my-turn? (not %my-turn?))
+    (when %my-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) (λ (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-assert-vacant board x y)
           (on (<- peer 'peer-turn! x y)
               (λ (_)
                 (board-choose! board mark x y)
-                (set! my-turn? (not my-turn?))
-                (display))))
+                (switch-turn!)
+                (%state))
+              #:promise? #t))
         (error "It's not my turn."))]))

gib-gab-gob/rps.scm

@@ -6,26 +6,20 @@
   #:use-module (goblins ocapn captp)
   #:use-module (goblins ocapn ids)
   #:use-module (goblins ocapn netlayer onion)
-  #:export (make-initiator make-joiner initiator/connect resolve-initiator ^game-initiator ^game-joiner))
+  #:use-module (gib-gab-gob board)
+  #:use-module (fibers conditions)
+  #:export (initiator/connect ^game-initiator ^game-joiner))
 
 ;;
 ;; Initiator logic
 ;;
-;; todo: refactor?
-(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 my-turn+)
   (define pick (pick-rps))
   (define won? #nil)
   (define peer #nil)
@@ -40,21 +34,13 @@
     [(try-transition)
      (if (eq? won? #nil)
          'connecting
-         (bcom (^game-controller bcom won? peer) 'ready-to-play))]))
+         (bcom (^game-controller bcom board my-turn+ won? peer) 'ready-to-play))]))
 
 ;;
 ;; Joiner logic
 ;;
-(define (make-joiner ^game-controller addr)
-  (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 joiner ($ joiner 'get-sealed-pick))
-      (lambda (_) (<- initiator 'try-transition)))
-  joiner)
 
-(define (^game-joiner bcom initiator ^game-controller)
+(define (^game-joiner bcom initiator ^game-controller board my-turn+)
   (define-values (seal-pick unseal-pick my-pick?)
     (spawn-sealer-triplet))
   (define pick (pick-rps))
@@ -66,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 my-turn+ won? initiator) unseal-pick)]))
 
 ;;
 ;; Standard rock paper scissors logic follows!

gib-gab-gob/ui/console.scm

@@ -0,0 +1,90 @@
+(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 (srfi srfi-9)
+  #:use-module (srfi srfi-1)
+  #:use-module (fibers)
+  #:use-module (fibers channels)
+  #:use-module (goblins)
+  #:use-module (goblins ocapn captp)
+  #:use-module (goblins ocapn ids)
+  #:use-module (goblins ocapn netlayer onion)
+  #:export (make-initiator make-joiner))
+
+;; 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 my-turn+)
+  (get-message my-turn+)
+  (with-vat vat
+            (on (<- controller 'state)
+                (λ (state)
+                  (%print b state)
+                  (if (eq? state 'play)
+                      (let ((coords (%read)))
+                        (if coords (%eval vat b controller coords) #f))
+                      #f)))))
+
+(define (%read)
+  (define 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)
+  (format #t "Moving ~a\n" 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)
+  (%prompt))
+
+(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 my-turn+)
+  (define vat (spawn-vat #:name "UI"))
+  (spawn-fiber
+   (λ ()
+     (while (%loop vat board controller my-turn+))
+     (format #t "bye-bye!\n")
+     #f)))
+
+(define (make-initiator)
+  (with-vat
+   (spawn-vat #:name "Initiator Game")
+   (define my-turn+ (make-channel))
+   (define board (make-board))
+   (define initiator (spawn ^game-initiator ^ggg-controller board my-turn+))
+   (initiator/connect initiator)
+   (begin-game-loop board initiator my-turn+)))
+
+(define (make-joiner ^game-controller addr)
+  (with-vat
+   (spawn-vat #:name "Joiner Game")
+   (define mycapn (spawn-mycapn (new-onion-netlayer)))
+   (define my-turn+ (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 my-turn+))
+          (sealed ($ joiner 'get-sealed-pick)))
+     (on (<- initiator 'register-opponent joiner sealed)
+         (λ (_)
+           (on ($ joiner 'initialize!)
+               (λ (status) (begin-game-loop board joiner my-turn+) #f)))))))

hall.scm

@@ -16,32 +16,33 @@
   (files (libraries
            ((directory
               "gib-gab-gob"
-              ((compiled-scheme-file "board")
-               (compiled-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 ())
          (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-initiator")
+               (in-file "make-joiner")))))
          (documentation
-           ((org-file "README") (text-file "COPYING")))
+           ((text-file "COPYING") (org-file "README")))
          (infrastructure
-           ((automake-file "Makefile")
-            (autoconf-file "configure")
-            (text-file ".gitignore")
-            (scheme-file "hall")
+           ((shell-file "bootstrap")
+            (scheme-file "guix")
+            (in-file "pre-inst-env")
             (directory
               "build-aux"
               ((scheme-file "test-driver")
                (text-file "missing")
                (text-file "install-sh")))
-            (in-file "pre-inst-env")
-            (scheme-file "guix")
-            (shell-file "bootstrap")))))
+            (scheme-file "hall")
+            (text-file ".gitignore")
+            (autoconf-file "configure")
+            (automake-file "Makefile")))))

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))))