gib-gab-gob/gib-gab-gob/rps.scm

74 lines
2.6 KiB
Scheme

(define-module (gib-gab-gob rps)
#:use-module (ice-9 match)
#:use-module (goblins)
#:use-module (goblins actor-lib methods)
#:use-module (goblins actor-lib sealers)
#:use-module (goblins ocapn captp)
#:use-module (goblins ocapn ids)
#:use-module (goblins ocapn netlayer onion)
#:use-module (gib-gab-gob board)
#:use-module (fibers conditions)
#:export (initiator/connect ^game-initiator ^game-joiner))
;;
;; Initiator logic
;;
;; use this one
(define (initiator/connect initiator)
(define mycapn (spawn-mycapn (new-onion-netlayer)))
(define init-sref ($ mycapn 'register initiator 'onion))
(format #t "Connect to: ~a\n" (ocapn-id->string init-sref)))
(define (^game-initiator bcom ^game-controller board state+)
(define pick (pick-rps))
(define won? #nil)
(define peer #nil)
(methods
[(register-opponent p sealed-pick)
(set! peer p)
(format #t "Hey there! You sent me your pick of rock-paper-scissors; now I will send mine.\n")
(on (<- (<- peer 'pick->unsealer pick) sealed-pick)
(λ (peer-pick)
(set! won? (rps-winner pick peer-pick))
(format #t "Opponent has picked ~a (do I win? ~a). Ready to be a controller.\n" peer-pick won?)))]
[(try-transition)
(if (eq? won? #nil)
'connecting
(bcom (^game-controller bcom board state+ won? peer) 'ready-to-play))]))
;;
;; Joiner logic
;;
(define (^game-joiner bcom initiator ^game-controller board state+)
(define-values (seal-pick unseal-pick my-pick?)
(spawn-sealer-triplet))
(define pick (pick-rps))
(methods
[(get-sealed-pick) ($ seal-pick pick)]
[(pick->unsealer peer-pick)
(define won? (rps-winner pick peer-pick))
(format #t "Peer picked ~a... a bold choice (do I win? ~a), I will become a controller and send my unsealer.\n" peer-pick won?)
;; 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)
;; see https://spritely.institute/files/docs/guile-goblins/0.11.0/Object-construction.html
(bcom (^game-controller bcom board state+ won? initiator) unseal-pick)]))
;;
;; Standard rock paper scissors logic follows!
;;
(define rock-paper-scissors (list 'rock 'paper 'scissors))
(define (pick-rps)
(list-ref rock-paper-scissors (random (length rock-paper-scissors))))
(define (rps-winner a b)
(if (and (memq a rock-paper-scissors) (memq b rock-paper-scissors))
(match (list a b)
[(x x) 'tie]
[('rock 'scissors) #t]
[('rock 'paper) #f]
[('scissors 'paper) #t]
[(x y) (not (rps-winner y x))])
(error "Unexpected item in the shooting area" a b)))