2023-02-03 13:18:17 +00:00
|
|
|
(define-module (gib-gab-gob actors)
|
|
|
|
#:use-module (gib-gab-gob rps)
|
2023-02-10 09:02:59 +00:00
|
|
|
#:use-module (gib-gab-gob lib) ;; to go into goblins eventually!
|
2023-02-03 13:18:17 +00:00
|
|
|
#:use-module (goblins)
|
2023-02-18 20:02:19 +00:00
|
|
|
#:use-module (goblins vat)
|
2023-02-03 13:18:17 +00:00
|
|
|
#:use-module (goblins actor-lib methods)
|
|
|
|
#:use-module (goblins actor-lib sealers)
|
|
|
|
#:use-module (oop goops)
|
2023-02-12 05:37:38 +00:00
|
|
|
#:use-module (ice-9 match)
|
2023-02-12 08:42:07 +00:00
|
|
|
#:use-module (ice-9 rdelim)
|
2023-02-05 12:49:01 +00:00
|
|
|
#:export (^game-lobby ^client-picker))
|
2023-02-03 13:18:17 +00:00
|
|
|
|
2023-02-05 13:26:35 +00:00
|
|
|
(define (^game-lobby bcom)
|
2023-02-03 14:19:04 +00:00
|
|
|
(define pick (pick-rps))
|
2023-02-12 08:42:07 +00:00
|
|
|
|
|
|
|
(define gobbler #f)
|
|
|
|
|
2023-02-03 13:18:17 +00:00
|
|
|
(methods
|
2023-02-12 05:37:38 +00:00
|
|
|
[(register-opponent name peer sealed-pick)
|
2023-02-03 13:18:17 +00:00
|
|
|
(format #t "Hey there, ~a! You sent me your pick of rock-paper-scissors; now I will send mine.\n" name)
|
2023-02-12 05:37:38 +00:00
|
|
|
(on (<- (<- peer 'pick->unsealer pick) sealed-pick)
|
2023-02-03 13:18:17 +00:00
|
|
|
(lambda (peer-pick)
|
2023-02-06 11:12:28 +00:00
|
|
|
(define won? (rps-winner pick peer-pick))
|
|
|
|
(format #t "Opponent ~a has picked ~a (do I win? ~a)\n" name peer-pick won?)
|
2023-02-12 05:37:38 +00:00
|
|
|
;; Transition to gobbler/receiver
|
2023-02-12 08:42:07 +00:00
|
|
|
(let* ((g (spawn ^gib-gab-gobbler won? #f))
|
|
|
|
(receiver ($ g 'get-receiver)))
|
|
|
|
(set! gobbler g)
|
2023-02-12 05:37:38 +00:00
|
|
|
($ gobbler 'register-receiver (<- peer 'register-receiver receiver)))))]))
|
2023-02-03 13:18:17 +00:00
|
|
|
|
|
|
|
(define (^client-picker bcom)
|
|
|
|
(define-values (seal-pick unseal-pick my-pick?)
|
|
|
|
(spawn-sealer-triplet))
|
2023-02-03 14:19:04 +00:00
|
|
|
(define pick (pick-rps))
|
2023-02-12 05:37:38 +00:00
|
|
|
(define won? #f)
|
2023-02-12 08:42:07 +00:00
|
|
|
|
|
|
|
(define gobbler #f)
|
|
|
|
|
2023-02-03 13:18:17 +00:00
|
|
|
(methods
|
2023-02-05 14:20:04 +00:00
|
|
|
[(get-sealed-pick) ($ seal-pick pick)]
|
2023-02-05 14:23:22 +00:00
|
|
|
[(pick->unsealer peer-pick)
|
2023-02-12 05:37:38 +00:00
|
|
|
(set! won? (rps-winner pick peer-pick))
|
2023-02-06 11:12:28 +00:00
|
|
|
(format #t "Peer picked ~a... a bold choice (do I win? ~a), I will send my unsealer\n" peer-pick won?)
|
2023-02-12 05:37:38 +00:00
|
|
|
unseal-pick]
|
2023-02-12 08:42:07 +00:00
|
|
|
[(register-receiver receiver)
|
2023-02-18 21:40:38 +00:00
|
|
|
(set! gobbler (spawn ^gib-gab-gobbler won? receiver))
|
|
|
|
($ gobbler 'get-receiver)]))
|
2023-02-06 11:12:28 +00:00
|
|
|
|
|
|
|
|
|
|
|
;; Actual Tic Tac Toe game
|
|
|
|
(define ggg-size 3) ;; tic tac toe with more than 3x3 grid?
|
|
|
|
|
2023-02-12 05:37:38 +00:00
|
|
|
(define (^gib-gab-gobbler bcom initiator arg-peer)
|
|
|
|
(format #t "Creating gobbler\n")
|
|
|
|
|
2023-02-12 05:50:40 +00:00
|
|
|
(define mark (if initiator "x" "o"))
|
|
|
|
(define peer-mark (if initiator "o" "x"))
|
|
|
|
|
|
|
|
(define board (selfish-spawn ^peer-board))
|
2023-02-12 05:37:38 +00:00
|
|
|
|
|
|
|
;; Move Receiver actor which receives moves from the peer.
|
|
|
|
(define (^move-receiver bcom)
|
|
|
|
(methods
|
|
|
|
;; Receive the move from the peer.
|
|
|
|
[(exchange-move peer coords)
|
|
|
|
(format #t "exchange-move ~s\n" coords)
|
2023-02-12 05:50:40 +00:00
|
|
|
($ board 'choose! coords peer-mark)
|
2023-02-12 06:00:18 +00:00
|
|
|
(move!)]))
|
2023-02-12 05:37:38 +00:00
|
|
|
|
|
|
|
(define receiver (spawn ^move-receiver))
|
|
|
|
|
|
|
|
;; Convert from a prompt to a valid move.
|
|
|
|
;; TODO: validation
|
2023-02-18 20:02:19 +00:00
|
|
|
;; Careful! This does not play nice with the REPL!
|
2023-02-12 05:37:38 +00:00
|
|
|
(define (prompt->move)
|
2023-02-12 08:42:07 +00:00
|
|
|
(format #t "enter move? > ")
|
|
|
|
(map string->number (string-tokenize (read-line (current-input-port)) char-set:digit)))
|
2023-02-12 05:37:38 +00:00
|
|
|
|
2023-02-12 08:42:07 +00:00
|
|
|
;; Do our move.
|
2023-02-12 06:00:18 +00:00
|
|
|
(define (move!)
|
2023-02-18 20:02:19 +00:00
|
|
|
(on (spawn-fibrous-vow (lambda () (prompt->move)))
|
|
|
|
(lambda (move)
|
|
|
|
(format #t "move is ~s\n" move)
|
|
|
|
($ board 'choose! move mark)
|
2023-02-18 21:40:38 +00:00
|
|
|
move)
|
|
|
|
#:promise? #t))
|
2023-02-12 06:00:18 +00:00
|
|
|
|
2023-02-12 06:02:21 +00:00
|
|
|
(define (loop-move peer)
|
2023-02-12 05:37:38 +00:00
|
|
|
(format #t "begin move w ~s\n" peer)
|
2023-02-18 21:40:38 +00:00
|
|
|
(on (move!)
|
|
|
|
(lambda (move)
|
|
|
|
(on (<- peer 'exchange-move receiver move)
|
|
|
|
;; get exchange
|
|
|
|
(lambda (peer-move)
|
|
|
|
;; Actually respond to the move
|
|
|
|
(format #t "Peer move ~s\n" peer-move)
|
|
|
|
($ board 'choose! peer-move peer-mark)
|
|
|
|
;; And now we repeat!
|
|
|
|
(loop-move peer))))))
|
2023-02-12 05:37:38 +00:00
|
|
|
|
|
|
|
;; Initial logic. If the peer is not set we wait until we receive it.
|
|
|
|
;; If we don't go first we also wait.
|
|
|
|
(when (and arg-peer initiator)
|
2023-02-12 06:02:21 +00:00
|
|
|
(loop-move arg-peer))
|
2023-02-12 05:37:38 +00:00
|
|
|
|
2023-02-06 11:12:28 +00:00
|
|
|
(methods
|
2023-02-12 05:37:38 +00:00
|
|
|
[(get-receiver) receiver]
|
|
|
|
;; Learn about the receiver from the peer. Then do our move if we are first.
|
|
|
|
[(register-receiver peer)
|
|
|
|
(when initiator
|
2023-02-12 06:02:21 +00:00
|
|
|
(loop-move peer))]))
|
2023-02-12 05:37:38 +00:00
|
|
|
|
|
|
|
;; Board logic
|
2023-02-06 11:12:28 +00:00
|
|
|
|
2023-02-12 05:50:40 +00:00
|
|
|
(define (^peer-board bcom self)
|
2023-02-06 11:12:28 +00:00
|
|
|
;; Define the array with unspecified values, then fill
|
|
|
|
(define arr (make-array *unspecified* ggg-size ggg-size))
|
|
|
|
(array-map! arr (lambda () (spawn ^mark)))
|
|
|
|
|
2023-02-10 09:02:59 +00:00
|
|
|
(methods
|
2023-02-12 06:34:46 +00:00
|
|
|
;; Switch coords for clarity
|
2023-02-18 20:02:19 +00:00
|
|
|
[(ref coords)
|
2023-02-18 21:40:38 +00:00
|
|
|
(match coords ((x y) (array-ref arr y x)))]
|
2023-02-12 05:50:40 +00:00
|
|
|
[(chosen? coords) (not (not ($ ($ self 'ref coords) 'get)))]
|
|
|
|
[(choose! coords mark-char)
|
2023-02-18 21:40:38 +00:00
|
|
|
(let* ((mark ($ self 'ref coords))
|
|
|
|
(char ($ mark 'get)))
|
|
|
|
(if (not (not char))
|
|
|
|
(error "coords already chosen:" coords)
|
|
|
|
(begin
|
|
|
|
($ mark 'choose! mark-char)
|
|
|
|
($ self 'display))))]
|
2023-02-10 09:02:59 +00:00
|
|
|
[(display)
|
2023-02-06 11:12:28 +00:00
|
|
|
(define (print-mark mark)
|
2023-02-12 05:50:40 +00:00
|
|
|
(let ((mark ($ mark 'get)))
|
|
|
|
(or mark " ")))
|
2023-02-06 11:12:28 +00:00
|
|
|
;; this is .. probably messy?
|
|
|
|
(array-slice-for-each-in-order
|
|
|
|
1
|
|
|
|
(lambda (x)
|
|
|
|
(map (lambda (i) (format #t "[~a]" (print-mark i)))
|
|
|
|
(array->list x))
|
2023-02-10 09:02:59 +00:00
|
|
|
(format #t "\n")) arr)]))
|
2023-02-06 11:12:28 +00:00
|
|
|
|
2023-02-12 05:50:40 +00:00
|
|
|
(define* (^mark bcom #:optional [mark #f])
|
2023-02-06 11:12:28 +00:00
|
|
|
(methods
|
2023-02-12 05:50:40 +00:00
|
|
|
[(get) mark]
|
|
|
|
[(choose! mark-char)
|
|
|
|
(if mark
|
2023-02-06 11:12:28 +00:00
|
|
|
(error "this mark is already chosen")
|
2023-02-12 05:50:40 +00:00
|
|
|
(bcom (^mark bcom mark-char)))]))
|