2023-07-03 02:56:06 +00:00
|
|
|
(define-module (gib-gab-gob game)
|
2023-07-10 05:03:21 +00:00
|
|
|
#:use-module (fibers)
|
|
|
|
#:use-module (fibers channels)
|
2023-02-03 13:18:17 +00:00
|
|
|
#:use-module (goblins)
|
2023-07-17 02:59:42 +00:00
|
|
|
#:use-module (goblins vat)
|
|
|
|
#:use-module (goblins actor-lib cell)
|
2023-02-03 13:18:17 +00:00
|
|
|
#:use-module (goblins actor-lib methods)
|
|
|
|
#:use-module (goblins actor-lib sealers)
|
2023-07-03 08:43:01 +00:00
|
|
|
#:use-module (gib-gab-gob board)
|
2023-07-03 02:52:44 +00:00
|
|
|
#:export (^ggg-controller))
|
2023-02-06 11:12:28 +00:00
|
|
|
|
|
|
|
;; Actual Tic Tac Toe game
|
2023-07-17 02:59:42 +00:00
|
|
|
(define (^ggg-controller bcom board state+ first? peer)
|
2023-07-10 02:35:12 +00:00
|
|
|
(define mark (if first? 'x 'o))
|
|
|
|
(define peer-mark (if first? 'o 'x))
|
2023-07-17 02:59:42 +00:00
|
|
|
(define %my-turn? (spawn ^cell first?))
|
2023-07-10 03:23:00 +00:00
|
|
|
(define (%state)
|
|
|
|
(cond
|
2023-07-10 05:59:29 +00:00
|
|
|
((board-winner? board mark) 'won)
|
|
|
|
((board-winner? board peer-mark) 'lost)
|
2023-07-10 03:23:00 +00:00
|
|
|
(else 'play)))
|
2023-07-10 05:03:21 +00:00
|
|
|
(define (signal-turn)
|
2023-07-17 02:59:42 +00:00
|
|
|
(syscaller-free-fiber (λ () (put-message state+ (%state))))
|
2023-07-10 05:45:57 +00:00
|
|
|
#f)
|
2023-07-10 02:35:12 +00:00
|
|
|
(define (switch-turn!)
|
2023-07-17 02:59:42 +00:00
|
|
|
($ %my-turn? (not %my-turn?))
|
|
|
|
(when ($ %my-turn?) (signal-turn))
|
2023-07-10 05:03:21 +00:00
|
|
|
#f)
|
|
|
|
(when first? (signal-turn))
|
2023-02-06 11:12:28 +00:00
|
|
|
(methods
|
2023-07-03 05:14:07 +00:00
|
|
|
;; The peer is telling us about the turn it took.
|
2023-07-03 08:09:56 +00:00
|
|
|
[(peer-turn! x y)
|
2023-07-17 02:59:42 +00:00
|
|
|
(if (not ($ %my-turn?))
|
2023-07-03 05:14:07 +00:00
|
|
|
(begin
|
2023-07-03 08:09:56 +00:00
|
|
|
(board-choose! board peer-mark x y)
|
2023-07-10 02:35:12 +00:00
|
|
|
(switch-turn!))
|
2023-07-03 05:14:07 +00:00
|
|
|
(error "It's my turn!"))]
|
2023-07-07 04:33:23 +00:00
|
|
|
;; TODO: These need to go somewhere else so the peer can't move or init for us!
|
|
|
|
[(try-transition) 'playing]
|
2023-07-17 02:59:42 +00:00
|
|
|
[(my-turn?) ($ %my-turn?)]
|
2023-07-10 02:35:12 +00:00
|
|
|
[(my-mark) mark]
|
2023-07-10 03:23:00 +00:00
|
|
|
[(state) (%state)]
|
2023-07-07 04:33:23 +00:00
|
|
|
[(initialize!)
|
2023-07-10 05:45:57 +00:00
|
|
|
(on (<- peer 'try-transition)
|
|
|
|
(λ (status)
|
|
|
|
(format #t "Peer's status: ~a\n" status)
|
|
|
|
status) #:promise? #t)]
|
2023-07-03 08:09:56 +00:00
|
|
|
[(my-turn! x y)
|
2023-07-17 02:59:42 +00:00
|
|
|
(if ($ %my-turn?)
|
2023-07-03 05:14:07 +00:00
|
|
|
(begin
|
2023-07-07 06:07:56 +00:00
|
|
|
(board-assert-vacant board x y)
|
|
|
|
(on (<- peer 'peer-turn! x y)
|
|
|
|
(λ (_)
|
|
|
|
(board-choose! board mark x y)
|
2023-07-10 03:23:00 +00:00
|
|
|
(switch-turn!)
|
|
|
|
(%state))
|
|
|
|
#:promise? #t))
|
2023-07-03 05:14:07 +00:00
|
|
|
(error "It's not my turn."))]))
|