more tweaks to ui console and comms

gib-gab-gob/game.scm

@@ -1,4 +1,5 @@
 (define-module (gib-gab-gob game)
+  #:use-module (fibers conditions)
   #:use-module (goblins)
   #:use-module (goblins actor-lib methods)
   #:use-module (goblins actor-lib sealers)
@@ -6,39 +7,40 @@
   #:export (^ggg-controller))
 
 ;; Actual Tic Tac Toe game
-(define (^ggg-controller bcom won? peer)
+(define (^ggg-controller bcom board first? peer)
-  (define mark (if won? 'x 'o))
+  (define mark (if first? 'x 'o))
-  (define peer-mark (if won? 'o 'x))
+  (define peer-mark (if first? 'o 'x))
-  (define board (make-board))
+  (define %my-turn? first?)
-  (define my-turn? won?)
+  (define my-turn+ (make-condition))
-  (define (i-won?) (board-winner? board mark))
+  (define (switch-turn!)
-  (define (peer-won?) (board-winner? board peer-mark))
+    (set! %my-turn? (not %my-turn?))
-  (define (display)
+    (when %my-turn? (signal-condition! my-turn+)))
-    (board-display board)
+  (when first? (signal-condition! my-turn+))
-    (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)
   (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?))
+          (switch-turn!))
-          (display))
         (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)
+    (cond
+     ((board-winner? board mark) => 'won)
+     ((board-winner? board peer-mark) => 'lost)
+     (else 'play))]
    [(initialize!)
     (on (<- peer 'try-transition) (λ (status) (format #t "Peer's status: ~a\n" 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?))
+                (switch-turn!))))
-                (display))))
         (error "It's not my turn."))]))

gib-gab-gob/ui/console.scm

@@ -2,15 +2,24 @@
   #:use-module (gib-gab-gob board)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 exceptions)
+  #:use-module (srfi srfi-9)
+  #:use-module (fibers)
+  #:use-module (fibers channels)
+  #:use-module (fibers conditions)
+  #:use-module (goblins)
   #:export (begin-game-loop))
 
 ;; Module for simple console-based UI (no curses)
 
 ;; A single run of the loop for a bespoke REPL for playing the game
-(define (%loop b)
+(define (%loop board controller my-turn+)
-  (%print b)
+  (wait my-turn+)
-  (let ((coords (%read)))
+  (let ((state) ($ controller 'state))
-    (if coords (%eval coords) #f)))
+    (%print b state)
+    (if (eq? state 'play)
+        (let ((coords (%read)))
+          (if coords (%eval move-ch coords) #f))
+        #f)))
 
 (define (%read)
   (define line (read-line (current-input-port)))
@@ -21,17 +30,26 @@
                    (%prompt) (%read))
             coords))))
 
-(define (%eval coordinates)
+(define (%eval move-ch coordinates)
-  (format #t "Moving ~a\n" coordinates))
+  (format #t "Moving ~a\n" coordinates)
+  (put-message move-ch coordinates))
 
-(define (%print board)
+(define (%print b state)
-  (board-display board)
+  (%display b state)
   (%prompt))
 
-(define (%prompt)
+(define (%prompt) (format #t "Enter your move: "))
-  (format #t "Enter your move: "))
 
-(define (begin-game-loop board)
+(define (%display b state)
-  (while (%loop board))
+  (board-display b)
-  (format #t "bye-bye!\n")
+  (format #t "-> It is ~a turn!\n" (if %my-turn? "my" "peer's"))
-  #f)
+  (cond state
+   ('won => (format #t "*** I won! ***\n"))
+   ('lost => (format #t "*** I lost! ***\n"))))
+
+(define (begin-game-loop board controller my-turn+)
+  (spawn-fiber
+   (λ ()
+     (while (%loop board controller my-turn+))
+     (format #t "bye-bye!\n")
+     #f)))

hall.scm

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