From 9d23e66fe8332abc7a1bbd9022f3e58e1133b3fb Mon Sep 17 00:00:00 2001 From: rsiddharth Date: Fri, 3 Jul 2020 15:49:09 -0400 Subject: name directories like the realm repo. --- thirteen/server.rkt | 149 ---------------------------------------------------- 1 file changed, 149 deletions(-) delete mode 100644 thirteen/server.rkt (limited to 'thirteen/server.rkt') diff --git a/thirteen/server.rkt b/thirteen/server.rkt deleted file mode 100644 index 12ff10a..0000000 --- a/thirteen/server.rkt +++ /dev/null @@ -1,149 +0,0 @@ -#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 gaction) - (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 gaction 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 (set-gaction "") - (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 "g") - (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))) -- cgit v1.2.3