diff --git a/gib-gab-gob/game.scm b/gib-gab-gob/game.scm index fdbb8d7..39eea66 100644 --- a/gib-gab-gob/game.scm +++ b/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 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 first? peer) + (define mark (if first? 'x 'o)) + (define peer-mark (if first? 'o 'x)) + (define %my-turn? first?) + (define my-turn+ (make-condition)) + (define (switch-turn!) + (set! %my-turn? (not %my-turn?)) + (when %my-turn? (signal-condition! my-turn+))) + (when first? (signal-condition! my-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) + (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?)) - (display)))) + (switch-turn!)))) (error "It's not my turn."))])) diff --git a/gib-gab-gob/ui/console.scm b/gib-gab-gob/ui/console.scm index ae59fff..013d1d0 100644 --- a/gib-gab-gob/ui/console.scm +++ b/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) - (%print b) - (let ((coords (%read))) - (if coords (%eval coords) #f))) +(define (%loop board controller my-turn+) + (wait my-turn+) + (let ((state) ($ controller 'state)) + (%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) - (format #t "Moving ~a\n" coordinates)) +(define (%eval move-ch coordinates) + (format #t "Moving ~a\n" coordinates) + (put-message move-ch coordinates)) -(define (%print board) - (board-display board) +(define (%print b state) + (%display b state) (%prompt)) -(define (%prompt) - (format #t "Enter your move: ")) +(define (%prompt) (format #t "Enter your move: ")) -(define (begin-game-loop board) - (while (%loop board)) - (format #t "bye-bye!\n") - #f) +(define (%display b state) + (board-display b) + (format #t "-> It is ~a turn!\n" (if %my-turn? "my" "peer's")) + (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))) diff --git a/hall.scm b/hall.scm index 19a3a80..2418a90 100644 --- a/hall.scm +++ b/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")))))