We have a working TTT protocol

This commit is contained in:
Vivianne 2023-07-06 21:33:23 -07:00
parent 493ad2349c
commit 32fb2edb71
2 changed files with 20 additions and 15 deletions

View file

@ -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

View file

@ -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))