Some tweaks which break things, oops.
This commit is contained in:
parent
79737e6528
commit
36ff5f887c
3 changed files with 33 additions and 32 deletions
|
@ -2,41 +2,42 @@
|
|||
#:use-module (fibers)
|
||||
#:use-module (fibers channels)
|
||||
#:use-module (goblins)
|
||||
#:use-module (goblins vat)
|
||||
#:use-module (goblins actor-lib cell)
|
||||
#:use-module (goblins actor-lib methods)
|
||||
#:use-module (goblins actor-lib sealers)
|
||||
#:use-module (gib-gab-gob board)
|
||||
#:export (^ggg-controller))
|
||||
|
||||
;; Actual Tic Tac Toe game
|
||||
(define (^ggg-controller bcom board my-turn+ first? peer)
|
||||
(define (^ggg-controller bcom board state+ first? peer)
|
||||
(define mark (if first? 'x 'o))
|
||||
(define peer-mark (if first? 'o 'x))
|
||||
(define %my-turn? first?)
|
||||
(define %my-turn? (spawn ^cell first?))
|
||||
(define (%state)
|
||||
(cond
|
||||
((board-winner? board mark) 'won)
|
||||
((board-winner? board peer-mark) 'lost)
|
||||
(else 'play)))
|
||||
(define (signal-turn)
|
||||
;; any better way to do this?
|
||||
(spawn-fiber (λ () (put-message my-turn+ #t)))
|
||||
(syscaller-free-fiber (λ () (put-message state+ (%state))))
|
||||
#f)
|
||||
(define (switch-turn!)
|
||||
(set! %my-turn? (not %my-turn?))
|
||||
(when %my-turn? (signal-turn))
|
||||
($ %my-turn? (not %my-turn?))
|
||||
(when ($ %my-turn?) (signal-turn))
|
||||
#f)
|
||||
(when first? (signal-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)
|
||||
(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-turn?) ($ %my-turn?)]
|
||||
[(my-mark) mark]
|
||||
[(state) (%state)]
|
||||
[(initialize!)
|
||||
|
@ -45,7 +46,7 @@
|
|||
(format #t "Peer's status: ~a\n" status)
|
||||
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)
|
||||
|
|
|
@ -19,7 +19,7 @@
|
|||
(define init-sref ($ mycapn 'register initiator 'onion))
|
||||
(format #t "Connect to: ~a\n" (ocapn-id->string init-sref)))
|
||||
|
||||
(define (^game-initiator bcom ^game-controller board my-turn+)
|
||||
(define (^game-initiator bcom ^game-controller board state+)
|
||||
(define pick (pick-rps))
|
||||
(define won? #nil)
|
||||
(define peer #nil)
|
||||
|
@ -34,13 +34,13 @@
|
|||
[(try-transition)
|
||||
(if (eq? won? #nil)
|
||||
'connecting
|
||||
(bcom (^game-controller bcom board my-turn+ won? peer) 'ready-to-play))]))
|
||||
(bcom (^game-controller bcom board state+ won? peer) 'ready-to-play))]))
|
||||
|
||||
;;
|
||||
;; Joiner logic
|
||||
;;
|
||||
|
||||
(define (^game-joiner bcom initiator ^game-controller board my-turn+)
|
||||
(define (^game-joiner bcom initiator ^game-controller board state+)
|
||||
(define-values (seal-pick unseal-pick my-pick?)
|
||||
(spawn-sealer-triplet))
|
||||
(define pick (pick-rps))
|
||||
|
@ -52,7 +52,7 @@
|
|||
;; We make the assumption that initiator is to become a controller.
|
||||
;; Note second arg to bcom which will return the value (this is confusing to me)
|
||||
;; see https://spritely.institute/files/docs/guile-goblins/0.11.0/Object-construction.html
|
||||
(bcom (^game-controller bcom board my-turn+ won? initiator) unseal-pick)]))
|
||||
(bcom (^game-controller bcom board state+ won? initiator) unseal-pick)]))
|
||||
|
||||
;;
|
||||
;; Standard rock paper scissors logic follows!
|
||||
|
|
|
@ -9,6 +9,7 @@
|
|||
#:use-module (fibers)
|
||||
#:use-module (fibers channels)
|
||||
#:use-module (goblins)
|
||||
#:use-module (goblins vat)
|
||||
#:use-module (goblins ocapn captp)
|
||||
#:use-module (goblins ocapn ids)
|
||||
#:use-module (goblins ocapn netlayer onion)
|
||||
|
@ -17,16 +18,15 @@
|
|||
;; 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 (%loop vat b controller state+)
|
||||
(define state (get-message state+))
|
||||
(%print b state)
|
||||
(if (eq? state 'play)
|
||||
(let ((coords (%read)))
|
||||
(with-vat
|
||||
vat
|
||||
(if coords (%eval vat b controller coords) #f)))
|
||||
#f))
|
||||
|
||||
(define (%read)
|
||||
(define line (read-line (current-input-port)))
|
||||
|
@ -56,34 +56,34 @@
|
|||
((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 (begin-game-loop board controller state+)
|
||||
(define vat (spawn-vat #:name "UI"))
|
||||
(spawn-fiber
|
||||
(syscaller-free-fiber
|
||||
(λ ()
|
||||
(while (%loop vat board controller my-turn+))
|
||||
(while (%loop vat board controller state+))
|
||||
(format #t "bye-bye!\n")
|
||||
#f)))
|
||||
|
||||
(define (make-initiator)
|
||||
(with-vat
|
||||
(spawn-vat #:name "Initiator Game")
|
||||
(define my-turn+ (make-channel))
|
||||
(define state+ (make-channel))
|
||||
(define board (make-board))
|
||||
(define initiator (spawn ^game-initiator ^ggg-controller board my-turn+))
|
||||
(define initiator (spawn ^game-initiator ^ggg-controller board state+))
|
||||
(initiator/connect initiator)
|
||||
(begin-game-loop board initiator my-turn+)))
|
||||
(begin-game-loop board initiator state+)))
|
||||
|
||||
(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 state+ (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+))
|
||||
(joiner (spawn ^game-joiner initiator ^game-controller board state+))
|
||||
(sealed ($ joiner 'get-sealed-pick)))
|
||||
(on (<- initiator 'register-opponent joiner sealed)
|
||||
(λ (_)
|
||||
(on ($ joiner 'initialize!)
|
||||
(λ (status) (begin-game-loop board joiner my-turn+) #f)))))))
|
||||
(λ (status) (begin-game-loop board joiner state+) #f)))))))
|
||||
|
|
Loading…
Reference in a new issue