From 48fb1ff7f5dd064068d4dc07e1a3cbb523d7347d Mon Sep 17 00:00:00 2001 From: rsiddharth Date: Sun, 21 Jun 2020 15:49:52 -0400 Subject: Add net/ricketyspace/ror/thirteen --- net/ricketyspace/ror/thirteen/client.rkt | 189 +++++++++++++++++++++++++++++++ net/ricketyspace/ror/thirteen/run.rkt | 13 +++ net/ricketyspace/ror/thirteen/server.rkt | 147 ++++++++++++++++++++++++ net/ricketyspace/ror/thirteen/shared.rkt | 28 +++++ 4 files changed, 377 insertions(+) create mode 100644 net/ricketyspace/ror/thirteen/client.rkt create mode 100644 net/ricketyspace/ror/thirteen/run.rkt create mode 100644 net/ricketyspace/ror/thirteen/server.rkt create mode 100644 net/ricketyspace/ror/thirteen/shared.rkt diff --git a/net/ricketyspace/ror/thirteen/client.rkt b/net/ricketyspace/ror/thirteen/client.rkt new file mode 100644 index 0000000..dc3b184 --- /dev/null +++ b/net/ricketyspace/ror/thirteen/client.rkt @@ -0,0 +1,189 @@ +#lang racket + +(require 2htdp/image 2htdp/universe "shared.rkt") + +(provide launch-guess-client) + +(struct client-state (type clue guess action done)) + +(define ClientState0 (client-state -1 "" #f "" #f)) + +(define SCENE-WIDTH 300) +(define SCENE-HEIGHT 200) + +(define (launch-guess-client n host) + (big-bang ClientState0 + (on-draw draw-guess) + (on-key handle-keys) + (name n) + (register host) + (on-receive handle-msg))) + +(define (handle-keys w key) + (cond [(= (client-state-type w) PLAYER) (handle-keys-player w key)] + [(= (client-state-type w) GUESSER) (handle-keys-guesser w key)] + [else w])) + +(define (handle-keys-player w key) + (define (action) + (client-state-action w)) + (define (guess) + (client-state-guess w)) + (define (set-clue clue) + (client-state PLAYER clue (guess) (action) #f)) + (cond [(and (string=? (action) "c") (key=? key "c")) + (make-package w (server-msg PLAYER "c" ""))] + [(and (string=? (action) "a") (key=? key "up")) + (make-package (set-clue "up") (server-msg PLAYER "a" "up"))] + [(and (string=? (action) "a") (key=? key "down")) + (make-package (set-clue "down") (server-msg PLAYER "a" "down"))] + [(and (string=? (action) "a") (key=? key "=")) + (make-package (set-clue "=") (server-msg PLAYER "a" "="))] + [else w])) + +(define (handle-keys-guesser w key) + (define (action) + (client-state-action w)) + (cond [(and (string=? (action) "c") (key=? key "c") + (make-package w (server-msg GUESSER "c" "")))] + [(and (string=? (action) "g") (key=? key "g") + (make-package w (server-msg GUESSER "g" "")))] + [else w])) + +(define (handle-msg c c-msg) + (cond [(not (client-msg? c-msg)) c] + [(= (client-msg-type c-msg) PLAYER) + (handle-msg-player c c-msg)] + [(= (client-msg-type c-msg) GUESSER) + (handle-msg-guesser c c-msg)] + [else c])) + +(define (handle-msg-player c c-msg) + (define (is-done) + (client-msg-done c-msg)) + (define (action) + (client-msg-action c-msg)) + (define (set-done) + (let ([guess (client-msg-guess c-msg)]) + (client-state PLAYER "" guess "" #t))) + (define (set-check) + (let ([clue (client-state-clue c)]) + (client-state PLAYER clue #f "c" #f))) + (define (set-act) + (let ([guess (client-msg-guess c-msg)]) + (client-state PLAYER "" guess "a" #f))) + (cond [(is-done) (set-done)] + [(string=? (action) "c") (set-check)] + [(string=? (action) "a") (set-act)] + [else c])) + +(define (handle-msg-guesser c c-msg) + (define (is-done) + (client-msg-done c-msg)) + (define (action) + (client-msg-action c-msg)) + (define (set-done) + (let ([guess (client-msg-guess c-msg)]) + (client-state GUESSER "" guess "" #t))) + (define (set-check) + (let ([clue (client-msg-clue c-msg)] + [guess (client-msg-guess c-msg)]) + (client-state GUESSER clue guess "c" #f))) + (define (set-guess) + (let ([clue (client-msg-clue c-msg)] + [guess (client-msg-guess c-msg)]) + (client-state GUESSER clue guess "g" #f))) + (cond [(is-done) (set-done)] + [(string=? (action) "c") (set-check)] + [(string=? (action) "g") (set-guess)] + [else c])) + +(define (draw-guess c) + (define (render type result desc help) + (place-image/align + type 5 5 "left" "top" + (overlay (above result desc help) + (empty-scene SCENE-WIDTH SCENE-HEIGHT)))) + (let ([type (draw-type c)] + [result (draw-result c)] + [desc (draw-desc c)] + [help (draw-help c)]) + (render type result desc help))) + +(define (draw-type c) + (text (cond [(= (client-state-type c) PLAYER) "Player"] + [(= (client-state-type c) GUESSER) "Guesser"] + [else "..."]) + 14 "black")) + +(define (draw-result c) + (text (cond [(= (client-state-type c) PLAYER) + (draw-result-player c)] + [else (draw-result-guesser c)]) + 14 "black")) + +(define (draw-result-player c) + (define (done) + (client-state-done c)) + (define (action) + (client-state-action c)) + (define (guess) + (number->string (client-state-guess c))) + (cond [(and (not (done)) (string=? (action) "")) "..."] + [(done) (string-append (guess) " it is!")] + [(string=? (action) "a") (string-append "Guess: " (guess))] + [else ""])) + +(define (draw-result-guesser c) + (define (done) + (client-state-done c)) + (define (action) + (client-state-action c)) + (define (guess) + (let ([g (client-state-guess c)]) + (cond [(number? g) (number->string g)] + [else ""]))) + (define (clue) + (cond [(string=? (client-state-clue c) "up") ">"] + [else "<"])) + (cond [(and (not (done)) (string=? (action) "") "...")] + [(done) (string-append (guess) " it is!")] + [(and (string=? (action) "g") (> (string-length (guess)) 0)) + (string-append "Number " (clue) " " (guess))] + [(string=? (action) "c") (string-append "Guess: " (guess))] + [else ""])) + +(define (draw-desc c) + (text (cond [(= (client-state-type c) PLAYER) ""] + [else (draw-desc-guesser c)]) + 10 "black")) + +(define (draw-desc-guesser c) + (define (action) + (client-state-action c)) + (cond [(string=? (action) "c") "Waiting for player to act on guess"] + [else ""])) + +(define (draw-help c) + (define (type) + (client-state-type c)) + (text (cond [(= (type) PLAYER) (draw-help-player c)] + [else (draw-help-guesser c)]) + 10 "black")) + +(define (draw-help-player c) + (define (action) + (client-state-action c)) + (cond [(string=? (action) "c") "Press 'c' to check"] + [(string=? (action) "a") "Press ↑, ↓, or = "] + [else ""])) + +(define (draw-help-guesser c) + (define (action) + (client-state-action c)) + (define (done) + (client-state-done c)) + (cond [(string=? (action) "g") "Press 'g' to guess"] + [(string=? (action) "c") "Press 'c' to check"] + [(done) "Good Job!"] + [else ""])) diff --git a/net/ricketyspace/ror/thirteen/run.rkt b/net/ricketyspace/ror/thirteen/run.rkt new file mode 100644 index 0000000..b8726ac --- /dev/null +++ b/net/ricketyspace/ror/thirteen/run.rkt @@ -0,0 +1,13 @@ +#lang racket + +(require 2htdp/universe "client.rkt" "server.rkt") + +(define (run) + (launch-many-worlds (launch-guess-client "Adam" LOCALHOST) + (launch-guess-server) + (launch-guess-client "Eve" LOCALHOST))) + +(define (bad) + (launch-many-worlds (launch-guess-client "Adam" LOCALHOST) + (launch-guess-server) + (launch-guess-client "Beatrice" LOCALHOST))) diff --git a/net/ricketyspace/ror/thirteen/server.rkt b/net/ricketyspace/ror/thirteen/server.rkt new file mode 100644 index 0000000..2e57867 --- /dev/null +++ b/net/ricketyspace/ror/thirteen/server.rkt @@ -0,0 +1,147 @@ +#lang racket + +(provide launch-guess-server) + +(require 2htdp/image 2htdp/universe "shared.rkt") + +(struct interval (small big) #:transparent) + +;; paction -> 'c' or 'a' +;; gaction -> 'c' or 'g' +(struct server-state (interval clue guess paction gaction clients done)) + +(define u0 (server-state (interval LOWER UPPER) "" #f "c" "" 1 #f)) + +(define (launch-guess-server) + (universe #f + (state #t) + (on-new connect) + (on-msg handle-msg))) + +(define (connect u client) + (cond [(false? u) + (make-bundle + u0 + (list (make-mail client (client-msg PLAYER "" #f "c" #f))) + '())] + [(= (server-state-clients u) 1) + (make-bundle + (server-state + (server-state-interval u) (server-state-clue u) + (server-state-guess u) (server-state-paction u) + "g" 2 #f) + (list (make-mail client (client-msg GUESSER "" #f "g" #f))) + '())] + [else (make-bundle u empty (list client))])) + +(define (handle-msg u client s-msg) + (cond [(not (server-msg? s-msg)) (make-bundle u empty (list client))] + [(= (server-msg-type s-msg) PLAYER) + (handle-msg-player u client s-msg)] + [(= (server-msg-type s-msg) GUESSER) + (handle-msg-guesser u client s-msg)] + [else (make-bundle u empty (list client))])) + +(define (handle-msg-player u client s-msg) + (define (set-paction paction) + (let ([interval (server-state-interval u)] + [clue (server-state-clue u)] + [guess (server-state-guess u)] + [gaction (server-state-gaction u)] + [clients (server-state-clients u)]) + (server-state interval clue guess paction gaction clients #f))) + (define (set-clue clue) + (let ([interval (server-state-interval u)] + [guess (server-state-guess u)] + [gaction (server-state-gaction u)] + [clients (server-state-clients u)] + [done (server-state-done u)]) + (server-state interval clue guess "c" gaction clients done))) + (define (set-done) + (let ([interval (server-state-interval u)] + [guess (server-state-guess u)] + [gaction (server-state-gaction u)] + [clients (server-state-clients u)]) + (server-state interval "" guess "" gaction clients #t))) + (define (mail clue guess action done) + (list (make-mail client (client-msg PLAYER clue guess action done)))) + (let* ([clue (server-state-clue u)] + [guess (server-state-guess u)] + [action (server-msg-action s-msg)] + [done (server-state-done u)] + [action-ok (string=? (server-state-paction u) action)] + [has-guess (number? guess)] + [data (server-msg-data s-msg)]) + (cond [(not action-ok) + (make-bundle u empty (list client))] + [(and (string=? action "c") (not has-guess)) + (make-bundle u (mail clue guess action done) empty)] + [(and (string=? action "c") has-guess) + (make-bundle (set-paction "a") (mail clue guess "a" done) empty)] + [(and (string=? action "a") (member data '("up" "down"))) + (make-bundle (set-clue data) (mail data #f "c" done) empty)] + [(and (string=? action "a") (string=? data "=")) + (make-bundle (set-done) (mail "" guess "" #t) empty)] + [else (make-bundle u empty (list client))]))) + +(define (handle-msg-guesser u client s-msg) + (define (set-guess interval clue guess) + (let ([paction (server-state-paction u)] + [clients (server-state-clients u)] + [done (server-state-done u)]) + (server-state interval clue guess paction "c" clients done))) + (define (set-gaction-guess) + (let ([interval (server-state-interval u)] + [clue (server-state-clue u)] + [guess (server-state-guess u)] + [paction (server-state-paction u)] + [clients (server-state-clients u)] + [done (server-state-done u)]) + (server-state interval clue guess paction "g" clients done))) + (define (has-clue) + (> (string-length (server-state-clue u)) 0)) + (define (is-done) + (server-state-done u)) + (define (mail clue guess action done) + (list (make-mail client + (client-msg GUESSER clue guess action done)))) + (let* ([action (server-msg-action s-msg)] + [interval (server-state-interval u)] + [clue (server-state-clue u)] + [current-guess (server-state-guess u)] + [done (server-state-done u)] + [action-ok (string=? (server-state-gaction u) action)]) + (cond [(not action-ok) (make-bundle u empty (list client))] + [(is-done) (make-bundle u (mail "" current-guess "" #t) empty)] + [(and (string=? action "g") (not (has-clue))) + (let ([guess (guess interval)]) + (make-bundle (set-guess interval "" guess) + (mail "" guess "c" done) empty))] + [(and (string=? action "g") (has-clue)) + (let* ([n-interval (next-interval interval clue)] + [guess (guess n-interval)]) + (make-bundle (set-guess n-interval "" guess) + (mail "" guess "c" done) empty))] + [(and (string=? action "c") (has-clue)) + (make-bundle (set-gaction-guess) + (mail clue current-guess "g" done) empty)] + [else (make-bundle u (mail clue current-guess action done) + empty)]))) + +(define (next-interval interval clue) + (cond [(not (string? clue)) interval] + [(string=? "up" clue) (bigger interval)] + [(string=? "down" clue) (smaller interval)] + [else interval])) + +(define (single? w) + (= (interval-small w) (interval-big w))) + +(define (guess w) + (quotient (+ (interval-small w) (interval-big w)) 2)) + +(define (smaller w) + (interval (interval-small w) (max (interval-small w) (sub1 (guess w))))) + +(define (bigger w) + (interval (min (interval-big w) (add1 (guess w))) (interval-big w))) diff --git a/net/ricketyspace/ror/thirteen/shared.rkt b/net/ricketyspace/ror/thirteen/shared.rkt new file mode 100644 index 0000000..176c429 --- /dev/null +++ b/net/ricketyspace/ror/thirteen/shared.rkt @@ -0,0 +1,28 @@ +#lang racket + +(provide + UPPER + LOWER + PLAYER + GUESSER + client-msg + client-msg? + client-msg-type + client-msg-clue + client-msg-guess + client-msg-action + client-msg-done + server-msg + server-msg? + server-msg-type + server-msg-action + server-msg-data) + +(define UPPER 100) +(define LOWER 0) + +(define PLAYER 0) +(define GUESSER 1) + +(struct client-msg (type clue guess action done) #:prefab) +(struct server-msg (type action data) #:prefab) -- cgit v1.2.3