summaryrefslogtreecommitdiffstats
path: root/thirteen/server.rkt
diff options
context:
space:
mode:
authorrsiddharth <s@ricketyspace.net>2020-07-03 15:49:09 -0400
committerrsiddharth <s@ricketyspace.net>2020-07-03 15:49:09 -0400
commit9d23e66fe8332abc7a1bbd9022f3e58e1133b3fb (patch)
tree5bf435cd979dcb785624d43c75f379ae684f97e3 /thirteen/server.rkt
parent0f072be231d0bd875d1c87ff127834e60979263a (diff)
name directories like the realm repo.
Diffstat (limited to 'thirteen/server.rkt')
-rw-r--r--thirteen/server.rkt149
1 files changed, 0 insertions, 149 deletions
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)))