We have a working TTT protocol
This commit is contained in:
parent
493ad2349c
commit
32fb2edb71
2 changed files with 20 additions and 15 deletions
|
@ -6,16 +6,16 @@
|
||||||
#:export (^ggg-controller))
|
#:export (^ggg-controller))
|
||||||
|
|
||||||
;; Actual Tic Tac Toe game
|
;; Actual Tic Tac Toe game
|
||||||
(define (^ggg-controller bcom initiator? peer)
|
(define (^ggg-controller bcom won? peer)
|
||||||
(define mark (if initiator? 'x 'o))
|
(define mark (if won? 'x 'o))
|
||||||
(define peer-mark (if initiator? 'o 'x))
|
(define peer-mark (if won? 'o 'x))
|
||||||
(define board (make-board))
|
(define board (make-board))
|
||||||
(define my-turn? (not initiator?))
|
(define my-turn? won?)
|
||||||
(define (i-won?) (board-winner? board mark))
|
(define (i-won?) (board-winner? board mark))
|
||||||
(define (peer-won?) (board-winner? board peer-mark))
|
(define (peer-won?) (board-winner? board peer-mark))
|
||||||
(define (display)
|
(define (display)
|
||||||
(board-display board)
|
(board-display board)
|
||||||
(format #t "-> It is ~a turn\n" (if my-turn? "my" "peer's"))
|
(format #t "-> It is ~a turn!\n" (if my-turn? "my" "peer's"))
|
||||||
(when (i-won?) (format #t "*** I won! ***\n"))
|
(when (i-won?) (format #t "*** I won! ***\n"))
|
||||||
(when (peer-won?) (format #t "*** I lost! ***\n")))
|
(when (peer-won?) (format #t "*** I lost! ***\n")))
|
||||||
(display)
|
(display)
|
||||||
|
@ -28,7 +28,10 @@
|
||||||
(set! my-turn? (not my-turn?))
|
(set! my-turn? (not my-turn?))
|
||||||
(display))
|
(display))
|
||||||
(error "It's my turn!"))]
|
(error "It's my turn!"))]
|
||||||
;; TODO: This needs to go somewhere else so the peer can't move for us!
|
;; TODO: These need to go somewhere else so the peer can't move or init for us!
|
||||||
|
[(try-transition) 'playing]
|
||||||
|
[(initialize!)
|
||||||
|
(on (<- peer 'try-transition) (lambda (status) (format #t "Peer's status: ~a\n" status)) #:promise? #t)]
|
||||||
[(my-turn! x y)
|
[(my-turn! x y)
|
||||||
(if my-turn?
|
(if my-turn?
|
||||||
(begin
|
(begin
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
#:use-module (goblins ocapn captp)
|
#:use-module (goblins ocapn captp)
|
||||||
#:use-module (goblins ocapn ids)
|
#:use-module (goblins ocapn ids)
|
||||||
#:use-module (goblins ocapn netlayer testuds)
|
#:use-module (goblins ocapn netlayer testuds)
|
||||||
#:export (make-initiator make-joiner))
|
#:export (make-initiator make-joiner ^game-initiator ^game-joiner))
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; Helper to use testuds netlayer
|
;; Helper to use testuds netlayer
|
||||||
|
@ -28,23 +28,25 @@
|
||||||
|
|
||||||
(define (^game-initiator bcom ^game-controller)
|
(define (^game-initiator bcom ^game-controller)
|
||||||
(define pick (pick-rps))
|
(define pick (pick-rps))
|
||||||
|
(define won? #nil)
|
||||||
|
(define peer #nil)
|
||||||
(methods
|
(methods
|
||||||
[(register-opponent name peer sealed-pick)
|
[(register-opponent name p sealed-pick)
|
||||||
|
(set! peer p)
|
||||||
(format #t "Hey there, ~a! You sent me your pick of rock-paper-scissors; now I will send mine.\n" name)
|
(format #t "Hey there, ~a! You sent me your pick of rock-paper-scissors; now I will send mine.\n" name)
|
||||||
(on (<- (<- peer 'pick->unsealer pick) sealed-pick)
|
(on (<- (<- peer 'pick->unsealer pick) sealed-pick)
|
||||||
(λ (peer-pick)
|
(λ (peer-pick)
|
||||||
(define won? (rps-winner pick peer-pick))
|
(set! won? (rps-winner pick peer-pick))
|
||||||
(format #t "Opponent ~a has picked ~a (do I win? ~a). Time to be a controller.\n" name peer-pick won?)
|
(format #t "Opponent ~a has picked ~a (do I win? ~a). Ready to be a controller.\n" name peer-pick won?)))]
|
||||||
(bcom (^game-controller bcom won? peer))))]))
|
[(try-transition)
|
||||||
|
(if (eq? won? #nil)
|
||||||
|
'connecting
|
||||||
|
(bcom (^game-controller bcom won? peer) 'ready-to-play))]))
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; Joiner logic
|
;; Joiner logic
|
||||||
;;
|
;;
|
||||||
(define (make-joiner ^game-controller user-name addr)
|
(define (make-joiner ^game-controller user-name addr)
|
||||||
(pk user-name)
|
|
||||||
(pk addr)
|
|
||||||
(pk ^game-controller)
|
|
||||||
(with-vat (spawn-vat)
|
(with-vat (spawn-vat)
|
||||||
(define mycapn (spawn-mycapn (new-testuds-netlayer)))
|
(define mycapn (spawn-mycapn (new-testuds-netlayer)))
|
||||||
(define init-sref (string->ocapn-id addr))
|
(define init-sref (string->ocapn-id addr))
|
||||||
|
|
Loading…
Reference in a new issue