Some tweaks which break things, oops.

This commit is contained in:
Vivianne 2023-07-16 19:59:42 -07:00
parent 79737e6528
commit 36ff5f887c
3 changed files with 33 additions and 32 deletions

View file

@ -2,41 +2,42 @@
#:use-module (fibers) #:use-module (fibers)
#:use-module (fibers channels) #:use-module (fibers channels)
#:use-module (goblins) #:use-module (goblins)
#:use-module (goblins vat)
#:use-module (goblins actor-lib cell)
#:use-module (goblins actor-lib methods) #:use-module (goblins actor-lib methods)
#:use-module (goblins actor-lib sealers) #:use-module (goblins actor-lib sealers)
#:use-module (gib-gab-gob board) #:use-module (gib-gab-gob board)
#:export (^ggg-controller)) #:export (^ggg-controller))
;; Actual Tic Tac Toe game ;; 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 mark (if first? 'x 'o))
(define peer-mark (if first? 'o 'x)) (define peer-mark (if first? 'o 'x))
(define %my-turn? first?) (define %my-turn? (spawn ^cell first?))
(define (%state) (define (%state)
(cond (cond
((board-winner? board mark) 'won) ((board-winner? board mark) 'won)
((board-winner? board peer-mark) 'lost) ((board-winner? board peer-mark) 'lost)
(else 'play))) (else 'play)))
(define (signal-turn) (define (signal-turn)
;; any better way to do this? (syscaller-free-fiber (λ () (put-message state+ (%state))))
(spawn-fiber (λ () (put-message my-turn+ #t)))
#f) #f)
(define (switch-turn!) (define (switch-turn!)
(set! %my-turn? (not %my-turn?)) ($ %my-turn? (not %my-turn?))
(when %my-turn? (signal-turn)) (when ($ %my-turn?) (signal-turn))
#f) #f)
(when first? (signal-turn)) (when first? (signal-turn))
(methods (methods
;; The peer is telling us about the turn it took. ;; The peer is telling us about the turn it took.
[(peer-turn! x y) [(peer-turn! x y)
(if (not %my-turn?) (if (not ($ %my-turn?))
(begin (begin
(board-choose! board peer-mark x y) (board-choose! board peer-mark x y)
(switch-turn!)) (switch-turn!))
(error "It's my turn!"))] (error "It's my turn!"))]
;; TODO: These need to go somewhere else so the peer can't move or init for us! ;; TODO: These need to go somewhere else so the peer can't move or init for us!
[(try-transition) 'playing] [(try-transition) 'playing]
[(my-turn?) %my-turn?] [(my-turn?) ($ %my-turn?)]
[(my-mark) mark] [(my-mark) mark]
[(state) (%state)] [(state) (%state)]
[(initialize!) [(initialize!)
@ -45,7 +46,7 @@
(format #t "Peer's status: ~a\n" status) (format #t "Peer's status: ~a\n" status)
status) #:promise? #t)] status) #:promise? #t)]
[(my-turn! x y) [(my-turn! x y)
(if %my-turn? (if ($ %my-turn?)
(begin (begin
(board-assert-vacant board x y) (board-assert-vacant board x y)
(on (<- peer 'peer-turn! x y) (on (<- peer 'peer-turn! x y)

View file

@ -19,7 +19,7 @@
(define init-sref ($ mycapn 'register initiator 'onion)) (define init-sref ($ mycapn 'register initiator 'onion))
(format #t "Connect to: ~a\n" (ocapn-id->string init-sref))) (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 pick (pick-rps))
(define won? #nil) (define won? #nil)
(define peer #nil) (define peer #nil)
@ -34,13 +34,13 @@
[(try-transition) [(try-transition)
(if (eq? won? #nil) (if (eq? won? #nil)
'connecting '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 ;; 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?) (define-values (seal-pick unseal-pick my-pick?)
(spawn-sealer-triplet)) (spawn-sealer-triplet))
(define pick (pick-rps)) (define pick (pick-rps))
@ -52,7 +52,7 @@
;; We make the assumption that initiator is to become a controller. ;; 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) ;; 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 ;; 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! ;; Standard rock paper scissors logic follows!

View file

@ -9,6 +9,7 @@
#:use-module (fibers) #:use-module (fibers)
#:use-module (fibers channels) #:use-module (fibers channels)
#:use-module (goblins) #:use-module (goblins)
#:use-module (goblins vat)
#: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 onion) #:use-module (goblins ocapn netlayer onion)
@ -17,16 +18,15 @@
;; Module for simple console-based UI (no curses) ;; Module for simple console-based UI (no curses)
;; A single run of the loop for a bespoke REPL for playing the game ;; A single run of the loop for a bespoke REPL for playing the game
(define (%loop vat b controller my-turn+) (define (%loop vat b controller state+)
(get-message my-turn+) (define state (get-message state+))
(with-vat vat
(on (<- controller 'state)
(λ (state)
(%print b state) (%print b state)
(if (eq? state 'play) (if (eq? state 'play)
(let ((coords (%read))) (let ((coords (%read)))
(if coords (%eval vat b controller coords) #f)) (with-vat
#f))))) vat
(if coords (%eval vat b controller coords) #f)))
#f))
(define (%read) (define (%read)
(define line (read-line (current-input-port))) (define line (read-line (current-input-port)))
@ -56,34 +56,34 @@
((eq? state 'won) (format #t "*** I won! ***\n")) ((eq? state 'won) (format #t "*** I won! ***\n"))
((eq? state 'lost) (format #t "*** I lost! ***\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")) (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") (format #t "bye-bye!\n")
#f))) #f)))
(define (make-initiator) (define (make-initiator)
(with-vat (with-vat
(spawn-vat #:name "Initiator Game") (spawn-vat #:name "Initiator Game")
(define my-turn+ (make-channel)) (define state+ (make-channel))
(define board (make-board)) (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) (initiator/connect initiator)
(begin-game-loop board initiator my-turn+))) (begin-game-loop board initiator state+)))
(define (make-joiner ^game-controller addr) (define (make-joiner ^game-controller addr)
(with-vat (with-vat
(spawn-vat #:name "Joiner Game") (spawn-vat #:name "Joiner Game")
(define mycapn (spawn-mycapn (new-onion-netlayer))) (define mycapn (spawn-mycapn (new-onion-netlayer)))
(define my-turn+ (make-channel)) (define state+ (make-channel))
(define board (make-board)) (define board (make-board))
(let* ((init-sref (string->ocapn-id addr)) (let* ((init-sref (string->ocapn-id addr))
(initiator ($ mycapn 'enliven init-sref)) (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))) (sealed ($ joiner 'get-sealed-pick)))
(on (<- initiator 'register-opponent joiner sealed) (on (<- initiator 'register-opponent joiner sealed)
(λ (_) (λ (_)
(on ($ joiner 'initialize!) (on ($ joiner 'initialize!)
(λ (status) (begin-game-loop board joiner my-turn+) #f))))))) (λ (status) (begin-game-loop board joiner state+) #f)))))))