TakeV
/
gib-gab-gob
forked from vv/gib-gab-gob
1
0
Fork 0
Code Pull Requests Activity

More tweaks and tidies and fixes to unnecessary things

This commit is contained in:
Vivianne 2023-02-05 06:20:04 -08:00
parent 71e35eb2d5
commit af674390cb
2 changed files with 16 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gib-gab-gob/actors.scm
View File

@ -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]))

25
gib-gab-gob/rps.scm
View File

@ -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)))