87 lines
3.2 KiB
Scheme
87 lines
3.2 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 testuds)
|
|
#:export (make-initiator make-joiner))
|
|
|
|
;;
|
|
;; Helper to use testuds netlayer
|
|
;;
|
|
(define (new-testuds-netlayer)
|
|
(define tmp "/tmp/netlayers")
|
|
(unless (access? tmp X_OK) (mkdir tmp))
|
|
(spawn ^testuds-netlayer tmp))
|
|
|
|
;;
|
|
;; Initiator logic
|
|
;;
|
|
(define (make-initiator ^game-controller)
|
|
(with-vat (spawn-vat)
|
|
(define initiator (spawn ^game-initiator ^game-controller))
|
|
(define mycapn (spawn-mycapn (new-testuds-netlayer)))
|
|
(define init-sref ($ mycapn 'register initiator 'testuds))
|
|
(format #t "Connect to: ~a\n" (ocapn-id->string init-sref))))
|
|
|
|
(define (^game-initiator bcom ^game-controller)
|
|
(define pick (pick-rps))
|
|
|
|
(methods
|
|
[(register-opponent name peer sealed-pick)
|
|
(format #t "Hey there, ~a! You sent me your pick of rock-paper-scissors; now I will send mine.\n" name)
|
|
(on (<- (<- peer 'pick->unsealer pick) sealed-pick)
|
|
(λ (peer-pick)
|
|
(define won? (rps-winner pick peer-pick))
|
|
(format #t "Opponent ~a has picked ~a (do I win? ~a). Time to be a controller.\n" name peer-pick won?)
|
|
(bcom (^game-controller bcom won? peer))))]))
|
|
|
|
;;
|
|
;; Joiner logic
|
|
;;
|
|
(define (make-joiner ^game-controller user-name addr)
|
|
(pk user-name)
|
|
(pk addr)
|
|
(pk ^game-controller)
|
|
(with-vat (spawn-vat)
|
|
(define mycapn (spawn-mycapn (new-testuds-netlayer)))
|
|
(define init-sref (string->ocapn-id addr))
|
|
(define initiator ($ mycapn 'enliven init-sref))
|
|
(define joiner (spawn ^game-joiner initiator ^game-controller))
|
|
(on (<- initiator 'register-opponent user-name joiner ($ joiner 'get-sealed-pick))
|
|
(λ (_) (format #t "~a finished the game.\n" user-name)))))
|
|
|
|
(define (^game-joiner bcom initiator ^game-controller)
|
|
(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 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)))
|