gib-gab-gob/gib-gab-gob/ui/console.scm

59 lines
1.7 KiB
Scheme

(define-module (gib-gab-gob ui console)
#: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 vat b controller my-turn+)
(wait my-turn+)
(let ((state ($ controller 'state)))
(%print b state)
(if (eq? state 'play)
(let ((coords (%read)))
(if coords (%eval vat 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 controller coordinates)
(format #t "Moving ~a\n" coordinates)
(with-vat
vat
(on (<- controller 'my-turn! coordinates)
(λ (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)))