More tweaks and tidies and fixes to unnecessary things
This commit is contained in:
parent
71e35eb2d5
commit
af674390cb
|
@ -9,18 +9,18 @@
|
||||||
(define (^game-lobby bcom)
|
(define (^game-lobby bcom)
|
||||||
(define pick (pick-rps))
|
(define pick (pick-rps))
|
||||||
(methods
|
(methods
|
||||||
((register-opponent name client sealed-pick)
|
[(register-opponent name client sealed-pick)
|
||||||
(format #t "Hey there, ~a! You sent me your pick of rock-paper-scissors; now I will send mine.\n" name)
|
(format #t "Hey there, ~a! You sent me your pick of rock-paper-scissors; now I will send mine.\n" name)
|
||||||
(on (<- (<- client 'exchange-pick-for-unsealer pick) sealed-pick)
|
(on (<- (<- client 'exchange-pick-for-unsealer pick) sealed-pick)
|
||||||
(lambda (peer-pick)
|
(lambda (peer-pick)
|
||||||
(format #t "The peer has picked ~a (do I win? ~s)\n" peer-pick (rps-winner pick peer-pick)))))))
|
(format #t "The peer has picked ~a (do I win? ~s)\n" peer-pick (rps-winner pick peer-pick))))]))
|
||||||
|
|
||||||
(define (^client-picker bcom)
|
(define (^client-picker bcom)
|
||||||
(define-values (seal-pick unseal-pick my-pick?)
|
(define-values (seal-pick unseal-pick my-pick?)
|
||||||
(spawn-sealer-triplet))
|
(spawn-sealer-triplet))
|
||||||
(define pick (pick-rps))
|
(define pick (pick-rps))
|
||||||
(methods
|
(methods
|
||||||
((get-sealed-pick) ($ seal-pick pick))
|
[(get-sealed-pick) ($ seal-pick pick)]
|
||||||
((exchange-pick-for-unsealer peer-pick)
|
[(exchange-pick-for-unsealer peer-pick)
|
||||||
(format #t "Peer picked ~a... a bold choice (do I win? ~s), i will send my unsealer\n" peer-pick (rps-winner pick peer-pick))
|
(format #t "Peer picked ~a... a bold choice (do I win? ~s), i will send my unsealer\n" peer-pick (rps-winner pick peer-pick))
|
||||||
unseal-pick)))
|
unseal-pick]))
|
||||||
|
|
|
@ -29,17 +29,14 @@
|
||||||
(unless (access? tmp X_OK) (mkdir tmp))
|
(unless (access? tmp X_OK) (mkdir tmp))
|
||||||
(spawn ^testuds-netlayer tmp))
|
(spawn ^testuds-netlayer tmp))
|
||||||
|
|
||||||
(define (do-rps user-name)
|
|
||||||
(make <rps-host> #:user-name user-name))
|
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; Client logic
|
;; Client logic
|
||||||
;;
|
;;
|
||||||
(define-class <rps-client> ()
|
(define-class <rps-client> ()
|
||||||
(vat #:accessor vat #:init-keyword #:vat #:init-thunk spawn-vat)
|
(vat #:accessor vat #:init-thunk spawn-vat)
|
||||||
(lobby #:accessor lobby)
|
(user-name #:accessor user-name #:init-keyword #:user-name)
|
||||||
(addr #:accessor addr #:init-keyword #:addr)
|
(addr #:accessor addr #:init-keyword #:addr)
|
||||||
(user-name #:accessor user-name #:init-keyword #:user-name))
|
(lobby #:accessor lobby))
|
||||||
|
|
||||||
(define-method (initialize (client <rps-client>) initargs)
|
(define-method (initialize (client <rps-client>) initargs)
|
||||||
(next-method)
|
(next-method)
|
||||||
|
@ -47,7 +44,7 @@
|
||||||
(define lobby-sref (string->ocapn-id (addr client)))
|
(define lobby-sref (string->ocapn-id (addr client)))
|
||||||
(define mycapn (spawn-mycapn (new-testuds-netlayer)))
|
(define mycapn (spawn-mycapn (new-testuds-netlayer)))
|
||||||
(set! (lobby client)
|
(set! (lobby client)
|
||||||
(<- mycapn 'enliven lobby-sref))))
|
($ mycapn 'enliven lobby-sref))))
|
||||||
|
|
||||||
(define (join-rps user-name addr)
|
(define (join-rps user-name addr)
|
||||||
(define client (make <rps-client> #:user-name user-name #:addr addr))
|
(define client (make <rps-client> #:user-name user-name #:addr addr))
|
||||||
|
@ -67,10 +64,10 @@
|
||||||
|
|
||||||
(define (rps-winner a b)
|
(define (rps-winner a b)
|
||||||
(if (and (memq a rock-paper-scissors) (memq b rock-paper-scissors))
|
(if (and (memq a rock-paper-scissors) (memq b rock-paper-scissors))
|
||||||
(match (list a b)
|
(match (list a b)
|
||||||
((x x) 'tie)
|
[(x x) 'tie]
|
||||||
(('rock 'scissors) #t)
|
[('rock 'scissors) #t]
|
||||||
(('rock 'paper) #f)
|
[('rock 'paper) #f]
|
||||||
(('scissors 'paper) #t)
|
[('scissors 'paper) #t]
|
||||||
((x y) (not (rps-winner y x))))
|
[(x y) (not (rps-winner y x))])
|
||||||
(error "Unexpected item in the shooting area" a b)))
|
(error "Unexpected item in the shooting area" a b)))
|
||||||
|
|
Loading…
Reference in New Issue