91 lines
3.0 KiB
Scheme
91 lines
3.0 KiB
Scheme
(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)))))))
|