more tweaks to ui console and comms
This commit is contained in:
parent
559f9832f5
commit
7708870b45
|
@ -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."))]))
|
||||
|
|
|
@ -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)
|
||||
(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 coords) #f)))
|
||||
(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))
|
||||
(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)
|
||||
#f)))
|
||||
|
|
27
hall.scm
27
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")))))
|
||||
|
|
Loading…
Reference in New Issue