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)
|
||||||
#: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)
|
||||||
|
|
|
@ -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!
|
||||||
|
|
|
@ -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)))))))
|
||||||
|
|
Loading…
Reference in a new issue