73 lines
2.5 KiB
Scheme
73 lines
2.5 KiB
Scheme
(define-module (gib-gab-gob rps)
|
|
#:use-module (gib-gab-gob actors)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (goblins)
|
|
#:use-module (goblins ocapn captp)
|
|
#:use-module (goblins ocapn ids)
|
|
#:use-module (goblins ocapn netlayer testuds)
|
|
#:use-module (oop goops)
|
|
#:export (do-rps join-rps rps-winner rock-paper-scissors))
|
|
|
|
(define-class <rps-host> ()
|
|
(vat #:accessor vat)
|
|
(rps #:accessor rps)
|
|
(user-name #:accessor user-name #:init-keyword #:user-name)
|
|
(ocapn-vat #:getter ocapn-vat #:init-thunk spawn-vat))
|
|
|
|
(define-method (init (host <rps-host>))
|
|
(set! (vat host) (spawn-vat))
|
|
(with-vat (vat host)
|
|
(set! (rps host)
|
|
(spawn ^rps)))
|
|
(with-vat (ocapn-vat host)
|
|
(define uds-netlayer (new-testuds-netlayer))
|
|
(define mycapn (spawn-mycapn uds-netlayer))
|
|
(let ((rps-sref ($ mycapn 'register (rps host) 'testuds)))
|
|
(format #t "Connect to: ~a\n" (ocapn-id->string rps-sref)))))
|
|
|
|
|
|
(define (new-testuds-netlayer)
|
|
(spawn ^testuds-netlayer "/tmp/netlayers"))
|
|
|
|
(define (do-rps user-name)
|
|
(init (make <rps-host> #:user-name user-name)))
|
|
|
|
(define-class <rps-client> ()
|
|
(vat #:accessor vat #:init-keyword #:vat #:init-thunk spawn-vat)
|
|
(rps #:accessor rps)
|
|
(rps-addr #:accessor rps-addr #:init-keyword #:rps-addr)
|
|
(user-name #:accessor user-name #:init-keyword #:user-name))
|
|
|
|
(define-method (init (client <rps-client>))
|
|
(define rps-sref (string->ocapn-id (rps-addr client)))
|
|
(define uds-netlayer (new-testuds-netlayer))
|
|
(define mycapn (spawn-mycapn uds-netlayer))
|
|
(set! (rps client)
|
|
(<- mycapn 'enliven rps-sref))
|
|
(on (rps client) pk))
|
|
|
|
(define (join-rps user-name rps-addr)
|
|
(define client (make <rps-client> #:user-name user-name #:rps-addr rps-addr))
|
|
(with-vat (vat client)
|
|
(init client)
|
|
(format #t "Tor will take a bit...\n")
|
|
(let ((client-picker (spawn ^client-picker))
|
|
(rps (rps client)))
|
|
(on (<- rps 'register-opponent user-name client-picker ($ client-picker 'get-sealed-pick))
|
|
(lambda (_)
|
|
(format #t "Ok! we are registered.\n"))))))
|
|
|
|
|
|
(define rock-paper-scissors (list '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)
|
|
(('paper 'scissors) #f)
|
|
((x y) (not (rps-winner y x))))
|
|
(error "Unexpected item in the shooting area" a b)))
|