Added randomness and more cleanups

This commit is contained in:
Vivianne 2023-02-03 06:19:04 -08:00
parent afd422039f
commit b2bcaa8086
4 changed files with 28 additions and 9 deletions

7
gib-gab-gob.scm Normal file
View file

@ -0,0 +1,7 @@
(define-module (gib-gab-gob)
#:use-module (gib-gab-gob rps)
#:use-module (gib-gab-gob actors)
#:re-export (do-rps
join-rps))
(set! *random-state* (random-state-from-platform))

View file

@ -7,7 +7,7 @@
#:export (^rps ^client-picker)) #:export (^rps ^client-picker))
(define* (^rps bcom) (define* (^rps bcom)
(define pick 'scissors) (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)
@ -19,7 +19,7 @@
(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 'rock) (define pick (pick-rps))
(methods (methods
;; client always picks rock, it's the real good strat ;; client always picks rock, it's the real good strat
((get-sealed-pick) ($ seal-pick pick)) ((get-sealed-pick) ($ seal-pick pick))

View file

@ -6,7 +6,7 @@
#:use-module (goblins ocapn ids) #:use-module (goblins ocapn ids)
#:use-module (goblins ocapn netlayer testuds) #:use-module (goblins ocapn netlayer testuds)
#:use-module (oop goops) #:use-module (oop goops)
#:export (do-rps join-rps rps-winner rock-paper-scissors)) #:export (do-rps join-rps pick-rps rps-winner rock-paper-scissors))
(define-class <rps-host> () (define-class <rps-host> ()
(vat #:accessor vat) (vat #:accessor vat)
@ -27,7 +27,9 @@
(define (new-testuds-netlayer) (define (new-testuds-netlayer)
(spawn ^testuds-netlayer "/tmp/netlayers")) (define tmp "/tmp/netlayers")
(unless (access? tmp X_OK) (mkdir tmp))
(spawn ^testuds-netlayer tmp))
(define (do-rps user-name) (define (do-rps user-name)
(init (make <rps-host> #:user-name user-name))) (init (make <rps-host> #:user-name user-name)))
@ -43,14 +45,12 @@
(define uds-netlayer (new-testuds-netlayer)) (define uds-netlayer (new-testuds-netlayer))
(define mycapn (spawn-mycapn uds-netlayer)) (define mycapn (spawn-mycapn uds-netlayer))
(set! (rps client) (set! (rps client)
(<- mycapn 'enliven rps-sref)) (<- mycapn 'enliven rps-sref)))
(on (rps client) pk))
(define (join-rps user-name rps-addr) (define (join-rps user-name rps-addr)
(define client (make <rps-client> #:user-name user-name #:rps-addr rps-addr)) (define client (make <rps-client> #:user-name user-name #:rps-addr rps-addr))
(with-vat (vat client) (with-vat (vat client)
(init client) (init client)
(format #t "Tor will take a bit...\n")
(let ((client-picker (spawn ^client-picker)) (let ((client-picker (spawn ^client-picker))
(rps (rps client))) (rps (rps client)))
(on (<- rps 'register-opponent user-name client-picker ($ client-picker 'get-sealed-pick)) (on (<- rps 'register-opponent user-name client-picker ($ client-picker 'get-sealed-pick))
@ -60,6 +60,9 @@
(define rock-paper-scissors (list 'rock 'paper 'scissors)) (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) (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)

View file

@ -16,14 +16,23 @@
(files (libraries (files (libraries
((directory ((directory
"gib-gab-gob" "gib-gab-gob"
((scheme-file "rps") (scheme-file "actors"))))) ((compiled-scheme-file "actors")
(scheme-file "rps")
(scheme-file "actors")
(compiled-scheme-file "rps")))))
(tests ((directory "tests" ()))) (tests ((directory "tests" ())))
(programs ((directory "scripts" ()))) (programs ((directory "scripts" ())))
(documentation (documentation
((text-file "ChangeLog") ((text-file "ChangeLog")
(text-file "AUTHORS") (text-file "AUTHORS")
(text-file "NEWS") (text-file "NEWS")
(directory "doc" ((texi-file "gib-gab-gob"))) (directory
"doc"
((texi-file "version")
(text-file ".dirstamp")
(text-file "stamp-vti")
(info-file "gib-gab-gob")
(texi-file "gib-gab-gob")))
(text-file "COPYING") (text-file "COPYING")
(text-file "HACKING") (text-file "HACKING")
(text-file "README"))) (text-file "README")))