name directories like the realm repo.

1 files changed, 0 insertions, 1065 deletions

diff --git a/fourteen/server.rkt b/fourteen/server.rkt
deleted file mode 100644
index 078533b..0000000
--- a/fourteen/server.rkt
+++ /dev/null
@@ -1,1065 +0,0 @@
-#lang racket
-
-;; This module implements the server for the Hungry Henry game
-
-(provide 
- bon-appetit ;; -> Void 
- ;; launch the server for Hungry Henry 
- )
-
-(require "shared.rkt" 2htdp/universe) 
-
-#| -----------------------------------------------------------------------------
-The server is responsible for: 
--- starting the game 
--- moving Henrys 
--- have Henrys eat, remove food on collision 
--- collecting and broadcasting information about the movement of players
--- ending games
-|#
-
-;                                                                                      
-;                                                                                      
-;                                                                                      
-;   ;   ;                                            ;   ;                             
-;   ;   ;                                            ;   ;                             
-;   ;   ;  ;   ;  ; ;;    ;; ;  ; ;;;  ;   ;         ;   ;   ;;;   ; ;;   ; ;;;  ;   ; 
-;   ;   ;  ;   ;  ;;  ;  ;  ;;  ;;  ;  ;   ;         ;   ;  ;   ;  ;;  ;  ;;  ;  ;   ; 
-;   ;;;;;  ;   ;  ;   ;  ;   ;  ;       ;  ;         ;;;;;  ;   ;  ;   ;  ;       ;  ; 
-;   ;   ;  ;   ;  ;   ;  ;   ;  ;       ; ;          ;   ;  ;;;;;  ;   ;  ;       ; ;  
-;   ;   ;  ;   ;  ;   ;  ;   ;  ;       ; ;          ;   ;  ;      ;   ;  ;       ; ;  
-;   ;   ;  ;  ;;  ;   ;  ;  ;;  ;        ;           ;   ;  ;      ;   ;  ;        ;   
-;   ;   ;   ;; ;  ;   ;   ;; ;  ;        ;           ;   ;   ;;;;  ;   ;  ;        ;   
-;                            ;           ;                                         ;   
-;                         ;;;          ;;                                        ;;    
-;                                                                                      
-
-
-;; Init Constants
-(define TICK .1)
-(define PLAYER-LIMIT 2)
-(define START-TIME 0)
-(define WAIT-TIME 250)
-
-(define FOOD*PLAYERS 5)
-
-(define WEIGHT-FACTOR 2.1)
-(define BASE-SPEED (/ (expt PLAYER-SIZE 2) WEIGHT-FACTOR))
-
-;; Data Definitions 
-(struct join (clients [time #:mutable]) #:transparent)
-(struct play (players food spectators) #:transparent #:mutable)
-
-;; plus some update primitives: 
-
-;; JoinUniverse Player -> JoinUniverse
-(define (join-add-player j new-p)
-  (join (cons new-p (join-clients j)) (join-time j)))
-
-;; PlayUniverse IP -> PlayUniverse
-(define (play-add-spectator pu new-s)
-  (define players (play-players pu))
-  (define spectators (play-spectators pu))
-  (play players (play-food pu) (cons new-s spectators)))
-
-;; PlayUniverse IWorld -> PlayUniverse
-;; removes player that uses iworld
-(define (play-remove p iw)
-  (define players (play-players p))
-  (define spectators (play-spectators p))
-  (play (rip iw players) (play-food p) (rip iw spectators)))
-
-;; JoinUniverse IWorld -> JoinUniverse 
-;; removes players and spectators that use iw from this world 
-(define (join-remove j iw)
-  (join (rip iw (join-clients j)) (join-time j)))
-
-;; IWorld [Listof Player] -> [Listof Player]
-;; remove player that contains the given IWorld 
-(define (rip iw players)
-  (remove iw players (lambda (iw p) (iworld=? iw (ip-iw p)))))
-
-;; LIKE: 
-;; (struct ip ip? ip-id ip-iw ip-body ip-waypoints ip-player)
-(define-values 
-  (ip ip? ip-id ip-iw ip-body ip-waypoints ip-player)
-  (let ()
-    (struct ip (id iw body waypoints player) #:transparent)
-    (define (create iw id body waypoints)
-      (ip id iw body waypoints (player id body waypoints)))
-    (values 
-     create ip? ip-id ip-iw ip-body ip-waypoints ip-player)))
-
-;; ServerState is one of
-;; -- JoinUniverse
-;; -- PlayUniverse
-;; JoinUniververse = (join [Listof IPs] Nat)
-;; interpretation: 
-;; -- the first field lists the currently connected client-player
-;; -- the second field is the number of ticks since the server started
-;; PlayUniverse    = (play [Listof IPs] [Listof Food] [Listof IP])
-;; interpretation: 
-;; -- the first field lists all participating players
-;; -- the second field lists the cupcakes 
-;; --- the third field enumerates the spectating players 
-;; IP              = (ip Id IWorld Body [Listof Complex] Feaster)
-;; interpretation: 
-;; the struct represents the Universe's perspective of a connected player 
-;; -- the first field is the assigned unique Id 
-;; -- the second field is the IWorld representing the remote connection to the client 
-;; -- the third field is the Body of the player 
-;; -- the fourth field is the list of player-chosen Waypoints, 
-;;     ordered from oldest click to most-recent
-;;     meaning the first one has to be visited first by the Henry 
-;; -- the fifth field is the serialized representation of the first four fields 
-
-(define JOIN0 (join empty START-TIME))
-
-;                                  
-;                                  
-;                                  
-;                                  
-;   ;;; ;;;            ;           
-;    ;; ;;                         
-;    ;; ;;   ;;;;    ;;;    ;; ;;  
-;    ; ; ;  ;    ;     ;     ;;  ; 
-;    ; ; ;   ;;;;;     ;     ;   ; 
-;    ;   ;  ;    ;     ;     ;   ; 
-;    ;   ;  ;   ;;     ;     ;   ; 
-;   ;;; ;;;  ;;; ;;  ;;;;;  ;;; ;;;
-;                                  
-;                                  
-;                                  
-;                                  
-
-(define (bon-appetit) 
-  (universe JOIN0 
-            (on-new connect)
-            (on-msg handle-goto-message)
-            (on-tick tick-tock TICK)
-            (on-disconnect disconnect)))
-
-;; ServerState IWorld -> Bundle
-;; adds a new connection to a JoinUniverse and ticks. Ignores otherwise
-(define (connect s iw)
-  (cond [(join? s) (add-player s iw)]
-        [(play? s)   (add-spectator s iw)]))
-
-;; ServerState IWorld Sexpr -> Bundle
-;; accepts goto messages from clients
-(define (handle-goto-message s iw msg)
-  (cond [(and (play? s) (goto? msg)) (goto s iw msg)]
-        [else                        (empty-bundle s)]))
-
-;; ServerState -> Bundle
-;; handle a tick event
-(define (tick-tock s)
-  (cond [(join? s) (wait-or-play s)]
-        [(play? s) (move-and-eat s)]))
-
-;; ServerState IWorld -> Bundle
-;; handles loss of a client
-(define (disconnect s iw)
-  (cond [(join? s) (drop-client s iw)]
-        [(play? s) (drop-player s iw)]))
-
-;                                                   
-;                                                   
-;                                                   
-;  ;     ;          ;             ;                 
-;  ;     ;                ;                         
-;  ;     ; ;;;;   ;;;    ;;;;;  ;;;    ; ;;    ;; ; 
-;  ;  ;  ;     ;    ;     ;       ;    ;;  ;  ;  ;; 
-;  ;  ;  ;     ;    ;     ;       ;    ;   ;  ;   ; 
-;   ;; ;;   ;;;;    ;     ;       ;    ;   ;  ;   ; 
-;   ;; ;;  ;   ;    ;     ;       ;    ;   ;  ;   ; 
-;   ;   ;  ;  ;;    ;     ;       ;    ;   ;  ;  ;; 
-;   ;   ;   ;;  ;   ;      ;;;    ;    ;   ;   ;; ; 
-;                                                 ; 
-;                                              ;;;  
-;                                                   
-
-;; JoinUniverse -> Bundle
-;; count down and might transition
-(define (wait-or-play j)
-  (cond [(keep-waiting? j) (keep-waiting j)]
-        [else              (start-game j)]))
-
-;; JoinUniverse -> Boolean
-;; is it time to start?
-(define (keep-waiting? j)
-  (or (> PLAYER-LIMIT (length (join-clients j)))
-      (> WAIT-TIME (join-time j))))
-
-;; JoinUniverse -> [Bundle JoinUniverse]
-(define (keep-waiting j)
-  (set-join-time! j (+ (join-time j) 1))
-  (time-broadcast j))
-
-;; JoinUniverse -> [Bundle JoinUniverse]
-;; broadcasts the new load time fraction to the players
-(define (time-broadcast j)
-  (define iworlds (map ip-iw (join-clients j)))
-  (define load%   (min 1 (/ (join-time j) WAIT-TIME)))
-  (make-bundle j (broadcast iworlds load%) empty))
-
-;; JoinUniverse -> [Bundle PlayUniverse]
-;; starts the game
-(define (start-game j)
-  (define clients  (join-clients j))
-  (define cupcakes (bake-cupcakes (length clients)))
-  (broadcast-universe (play clients cupcakes empty)))
-
-;; Number -> [Listof Food]
-;; creates the amount of food for that number of players
-(define (bake-cupcakes player#)
-  (for/list ([i (in-range (* player# FOOD*PLAYERS))])
-    (create-a-body CUPCAKE)))
-
-;                                                   
-;                                                   
-;          ;;;                                      
-;   ;;;;     ;                    ;                 
-;   ;   ;    ;                                      
-;   ;   ;    ;    ;;;;   ;   ;  ;;;    ; ;;    ;; ; 
-;   ;  ;     ;        ;  ;   ;    ;    ;;  ;  ;  ;; 
-;   ;;;      ;        ;   ;  ;    ;    ;   ;  ;   ; 
-;   ;        ;     ;;;;   ; ;     ;    ;   ;  ;   ; 
-;   ;        ;    ;   ;   ; ;     ;    ;   ;  ;   ; 
-;   ;        ;    ;  ;;    ;      ;    ;   ;  ;  ;; 
-;   ;        ;     ;;  ;   ;      ;    ;   ;   ;; ; 
-;                          ;                      ; 
-;                        ;;                    ;;;  
-;                                                   
-
-;; PlayUniverse -> Bundle
-;; moves everything. eats. may end game
-(define (move-and-eat pu)
-  (define nplayers  (move-player* (play-players pu)))
-  (define nfood (feed-em-all nplayers (play-food pu)))
-  (progress nplayers nfood (play-spectators pu)))
-
-;; [Listof IP] -> [Listof IP]
-;; moves all players
-(define (move-player* players)
-  (for/list ([p players])
-    (define waypoints (ip-waypoints p))
-    (cond [(empty? waypoints) p]
-          [else (define body  (ip-body p))
-                (define nwpts 
-                  (move-toward-waypoint body waypoints))
-                (ip (ip-iw p) (ip-id p) body nwpts)])))
-
-;; Body [Listof Complex] -> [Listof Complex]
-;; effect: set body's location 
-;; determine new waypoints for player 
-;; pre: (cons? waypoints)
-(define (move-toward-waypoint body waypoints)
-  (define goal  (first waypoints))
-  (define bloc  (body-loc body))
-  (define line  (- goal bloc))
-  (define dist  (magnitude line))
-  (define speed (/ BASE-SPEED (body-size body)))
-  (cond
-    [(<= dist speed) 
-     (set-body-loc! body goal)
-     (rest waypoints)]
-    [else ; (> distance speed 0)
-     (set-body-loc! body (+ bloc (* (/ line dist) speed)))
-     waypoints]))
-
-;; [Listof Player] [Listof Food] -> [Listof Food]
-;; feeds all players and removes food
-(define (feed-em-all players foods)
-  (for/fold ([foods foods]) ([p players])
-    (eat-all-the-things p foods)))
-
-;; IP [Listof Food] -> [Listof Food]
-;; effect: fatten player as he eats 
-;; determine left-over foods 
-(define (eat-all-the-things player foods)
-  (define b (ip-body player))
-  (define (new-cupcakes)
-    (cond [(> (length foods) 10) '()]
-          [else
-           (for/list ([i (in-range (random 1 3))])
-             (create-a-body CUPCAKE))]))
-  (for/fold ([foods '()]) ([f foods])
-    (cond
-      [(body-collide? f b)
-       (set-body-size! b (+ PLAYER-FATTEN-DELTA (body-size b)))
-       (append foods (new-cupcakes))]
-      [else (cons f foods)])))
-
-;; body body -> Boolean
-;; Have two bodys collided?
-(define (body-collide? s1 s2)
-  (<= (magnitude (- (body-loc s1) (body-loc s2)))
-      (+ (body-size s1) (body-size s2))))
-
-;; [Listof Ip] [Listof Food] [Listof IP] -> Bundle
-;; moves all objects. may end game
-(define (progress pls foods spectators)
-  (define p (play pls foods spectators))
-  (define (max-score)
-    (foldl (λ (pl max)
-             (let ([pl-score (cadr pl)])
-               (if (> pl-score max) pl-score max)))
-           0 (score pls)))
-  (define (end-game?)
-    (or (empty? foods) (> (max-score) 30)))
-  (cond [(end-game?) (end-game-broadcast p)]
-        [else (broadcast-universe p)]))
-
-;; PlayUniverse -> [Bundle JoinUniverse]
-;; ends the game, and restarts it
-(define (end-game-broadcast p)
-  (define iws (get-iws p))
-  (define msg (list SCORE (score (play-players p))))
-  (define mls (broadcast iws msg)) 
-  (make-bundle (remake-join p) mls empty))
-
-;; Play-Universe -> JoinUniverse
-;; Readies the ServerState for a new game
-(define (remake-join p)
-  (define players (refresh (play-players p)))
-  (define spectators (play-spectators p))
-  (join (append players spectators) START-TIME))
-
-;; [Listof Players] -> [Listof Players]
-;; creates new players for new game
-(define (refresh players)
-  (for/list ([p players])
-    (create-player (ip-iw p) (ip-id p))))
-
-;; [Listof IP] -> [Listof (list Id Score)]
-;; makes the endgame message informing clients of all the size
-(define (score ps)
-  (for/list ([p ps])
-    (list (ip-id p) (get-score (body-size (ip-body p))))))
-
-;                                                                  
-;                                                                  
-;                                                                  
-;                                                                  
-;   ;;; ;;;                                                        
-;    ;; ;;                                                         
-;    ;; ;;   ;;;;    ;;;;;   ;;;;;   ;;;;    ;;; ;;  ;;;;    ;;;;; 
-;    ; ; ;  ;    ;  ;    ;  ;    ;  ;    ;  ;   ;;  ;    ;  ;    ; 
-;    ; ; ;  ;;;;;;   ;;;;    ;;;;    ;;;;;  ;    ;  ;;;;;;   ;;;;  
-;    ;   ;  ;            ;       ;  ;    ;  ;    ;  ;            ; 
-;    ;   ;  ;       ;    ;  ;    ;  ;   ;;  ;   ;;  ;       ;    ; 
-;   ;;; ;;;  ;;;;;  ;;;;;   ;;;;;    ;;; ;;  ;;; ;   ;;;;;  ;;;;;  
-;                                                ;                 
-;                                            ;;;;                  
-;                                                                  
-;                                                                  
-
-;; -----------------------------------------------------------------------------
-;; Play Universe
-
-;; Message -> Boolean
-;; checks if message is a drag
-(define (goto? msg)
-  (and (list? msg)
-       (= GOTO-LENGTH (length msg))
-       (symbol? (first msg))
-       (number? (second msg))
-       (number? (third msg))
-       (symbol=? GOTO (first msg))
-       (<= 0 (second msg) WIDTH)
-       (<= 0 (third msg) HEIGHT)))
-
-;; PlayUniverse IWorld GotoMessage -> PlayUniverse
-;; handles a player clicking. checks for collisions, updates score, removes food
-;; Effect: changes a player's waypoints
-(define (goto p iw msg)
-  (define c (make-rectangular (second msg) (third msg)))
-  (set-play-players! p (add-waypoint (play-players p) c iw))
-  (broadcast-universe p))
-
-;; [Listof IPs] Complex IWorld -> [Listof IPs]
-;; adds that complex to the waypoints of the given players
-(define (add-waypoint ps c iw)
-  (for/list ([p ps])
-    (cond [(iworld=? (ip-iw p) iw)
-           (ip (ip-iw p)
-               (ip-id p) 
-               (ip-body p) 
-               (append (ip-waypoints p) (list c)))]
-          [else p])))
-
-;                                                                                  
-;                                                                                  
-;                                                                                  
-;                                                                                  
-;     ;;;;                                                     ;                   
-;    ;   ;                                           ;                             
-;   ;        ;;;;   ;; ;;   ;; ;;    ;;;;    ;;; ;  ;;;;;    ;;;     ;;;;   ;; ;;  
-;   ;       ;    ;   ;;  ;   ;;  ;  ;    ;  ;   ;;   ;         ;    ;    ;   ;;  ; 
-;   ;       ;    ;   ;   ;   ;   ;  ;;;;;;  ;        ;         ;    ;    ;   ;   ; 
-;   ;       ;    ;   ;   ;   ;   ;  ;       ;        ;         ;    ;    ;   ;   ; 
-;    ;   ;  ;    ;   ;   ;   ;   ;  ;       ;    ;   ;   ;     ;    ;    ;   ;   ; 
-;     ;;;    ;;;;   ;;; ;;; ;;; ;;;  ;;;;;   ;;;;     ;;;    ;;;;;   ;;;;   ;;; ;;;
-;                                                                                  
-;                                                                                  
-;                                                                                  
-;                                                                                  
-
-
-;; -----------------------------------------------------------------------------
-;; Join Universe
-
-;; [Universe Player -> Universe] -> [Universe IWorld -> [Bundle Universe]]
-;; creates a function that deals with a new connection during join or play phase 
-(define (make-connection adder)
-  (lambda (u iw)
-    (define player (named-player iw))
-    (define mails  (list (make-mail iw (ip-id player))))
-    (make-bundle (adder u player) mails empty)))
-
-;; JoinUniverse IWorld ID -> [Bundle JoinUniverse]
-;; creates an internal player for the IWorld, adds it to Universe as waiting player 
-(define add-player (make-connection join-add-player))
-
-;; PlayUniverse IWorld -> [Bundle PlayUniverse]
-;; creates an internal player for the IWorld, adds it to Universe as spectator 
-(define add-spectator (make-connection play-add-spectator))
-
-;; [Listof IP] IWorld ->* Player 
-(define (named-player iw)
-  (create-player iw (symbol->string (gensym (iworld-name iw)))))
-
-;                                                                          
-;                                                                          
-;                                                                          
-;                                                                          
-;    ;;; ;                     ;              ;;       ;                   
-;   ;   ;;                                     ;                           
-;   ;        ;;;;   ;; ;;;   ;;;     ;;;;      ;     ;;;     ;;;;;   ;;;;  
-;    ;;;;   ;    ;   ;;        ;    ;    ;     ;       ;     ;  ;   ;    ; 
-;        ;  ;;;;;;   ;         ;     ;;;;;     ;       ;       ;    ;;;;;; 
-;        ;  ;        ;         ;    ;    ;     ;       ;      ;     ;      
-;   ;;   ;  ;        ;         ;    ;   ;;     ;       ;     ;   ;  ;      
-;   ; ;;;    ;;;;;  ;;;;;    ;;;;;   ;;; ;;  ;;;;;   ;;;;;   ;;;;;   ;;;;; 
-;                                                                          
-;                                                                          
-;                                                                          
-;                                                                          
-
-;; PlayUniverse -> [Bundle PlayUniverse [Listof [Mail StateMessage]]]
-;; bundle this universe, serialize it, broadcast it, and drop noone
-(define (broadcast-universe p)
-  (define mails (broadcast-for (get-ips p) p))
-  (make-bundle p mails empty))
-
-;; [Listof IWorlds] Message -> [Listof Mail]
-;; sends mail to all clients
-(define (broadcast iws msgs)
-  (map (lambda (iw) (make-mail iw msgs)) iws))
-
-;; PlayUniverse -> (list s [Listof SerializedPlayer] [Listof SerializedFood])
-;; prepairs a message for an update world/ServerState state
-(define (serialize-universe p)
-  (define serialized-players (map ip-player (play-players p)))
-  (list SERIALIZE serialized-players (play-food p)))
-
-;; [Listof IPs] PlayUniverse -> [Listof Mail]
-;; generates mails for all clients
-(define (broadcast-for ips p)
-  (define (mk-mail-for pl)
-    (make-mail (ip-iw pl) (serialize-universe-for pl p)))
-  (foldl (lambda (pl mails) (cons (mk-mail-for pl) mails)) '() ips))
-
-;; IP PlayUniverse -> (list s [Listof SerializedPlayer] [ListOf SerializedFood])
-;; prepares message for an update world/ServerState state for a player
-(define (serialize-universe-for pl p)
-  (list SERIALIZE
-        (serialize-players-for pl (play-players p))
-        (play-food p)))
-
-;; IP IPs -> [ListOf SerializedPlayer]
-;; prepares serialized list of players for the SERIALIZE message for a
-;; player.
-(define (serialize-players-for pl pls)
-  (define (filter-out waypoints)
-    (if (empty? waypoints)
-        waypoints
-    (list (first waypoints))))
-  (define (mk-pl plyr)
-    (cond [(id=? (ip-id plyr) (ip-id pl)) (ip-player plyr)]
-          [else (player (ip-id plyr)
-                        (ip-body plyr)
-                        (filter-out (ip-waypoints plyr)))]))
-  (foldr (lambda (plyr srlzd-pls) (cons (mk-pl plyr) srlzd-pls)) '() pls))
-
-;                                                                                  
-;                                                                                  
-;                                                                                  
-;                                                                                  
-;   ;;;;       ;                                                                   
-;    ;  ;                                                                    ;     
-;    ;   ;   ;;;     ;;;;;   ;;; ;   ;;;;   ;; ;;   ;; ;;    ;;;;    ;;; ;  ;;;;;  
-;    ;   ;     ;    ;    ;  ;   ;;  ;    ;   ;;  ;   ;;  ;  ;    ;  ;   ;;   ;     
-;    ;   ;     ;     ;;;;   ;       ;    ;   ;   ;   ;   ;  ;;;;;;  ;        ;     
-;    ;   ;     ;         ;  ;       ;    ;   ;   ;   ;   ;  ;       ;        ;     
-;    ;  ;      ;    ;    ;  ;    ;  ;    ;   ;   ;   ;   ;  ;       ;    ;   ;   ; 
-;   ;;;;     ;;;;;  ;;;;;    ;;;;    ;;;;   ;;; ;;; ;;; ;;;  ;;;;;   ;;;;     ;;;  
-;                                                                                  
-;                                                                                  
-;                                                                                  
-;                                                                                  
-
-;; JoinUniverse IWorld -> Bundle
-;; remove that iworld from list of clients
-(define (drop-client j iw)
-  (empty-bundle (join-remove j iw)))
-
-;; PlayUniverse IWorld -> Bundle
-;; removes a player from the ServerState and tells the players
-(define (drop-player p iw)
-  (broadcast-universe (play-remove p iw)))
-
-;                          
-;                          
-;                          
-;                          
-;     ;;                   
-;      ;                   
-;     ; ;   ;;  ;;  ;;  ;; 
-;     ; ;    ;   ;   ;  ;  
-;     ; ;    ;   ;    ;;   
-;     ;;;    ;   ;    ;;   
-;    ;   ;   ;  ;;   ;  ;  
-;   ;;; ;;;   ;; ;; ;;  ;; 
-;                          
-;                          
-;                          
-;                          
-
-;; Number -> Body
-;; creates a random body, that does not touch the edge
-(define (create-a-body size)
-  (define x (+ size (random (- WIDTH size))))
-  (define y (+ size (random (- HEIGHT size))))
-  (body size (make-rectangular x y)))
-
-;; PlayUniverse -> [Listof IWorlds]
-;; gets the iworlds of all players
-(define (get-iws p)
-  (map ip-iw (append (play-players p) (play-spectators p))))
-
-;; PlayUnivers -> [Listof IP]
-(define (get-ips p)
-  (append (play-players p) (play-spectators p)))
-
-;; ServerState -> Bundle
-;; makes a bundle that sends no messages and disconnects noone
-(define (empty-bundle s)
-  (make-bundle s empty empty))  
-
-;; IWorld Id -> IP
-;; creates a player with that idnumber
-(define (create-player iw n)
-  (ip iw n (create-a-body PLAYER-SIZE) empty))
-
-;                                          
-;                                          
-;                                          
-;                                          
-;   ;;;;;;;                                
-;   ;  ;  ;                  ;             
-;      ;     ;;;;    ;;;;;  ;;;;;    ;;;;; 
-;      ;    ;    ;  ;    ;   ;      ;    ; 
-;      ;    ;;;;;;   ;;;;    ;       ;;;;  
-;      ;    ;            ;   ;           ; 
-;      ;    ;       ;    ;   ;   ;  ;    ; 
-;     ;;;    ;;;;;  ;;;;;     ;;;   ;;;;;  
-;                                          
-;                                          
-;                                          
-;           
-
-(module+ test 
-  (require rackunit rackunit/text-ui)
-  
-  (define PROP-NUM 500)
-  (define do-prop (make-parameter #t))
-  (do-prop #f)
-  
-  ;; thunk -> void
-  ;; runs the thunk PROP-NUM times
-  (define (check-property t)
-    (when (do-prop) (test-begin (doo PROP-NUM t))))
-  
-  ;; doo : number thunk ->
-  ;; does the thunk n times
-  (define (doo n l)
-    (l)
-    (unless (zero? n)
-      (doo (sub1 n) l)))
-  
-  ;; testing main server
-  
-  ;; new-connection
-  
-  ;; drop-client
-  (check-equal? (drop-client (join (list (ip iworld1 "player1" (body 10 1+10i) empty)
-                                         (ip iworld2 "player2" (body 10 1+10i) empty)
-                                         (ip iworld3 "player3" (body 10 1+10i) empty)) 100)
-                             iworld1)
-                (empty-bundle (join (list (ip iworld2 "player2" (body 10 1+10i) empty)
-                                          (ip iworld3 "player3" (body 10 1+10i) empty))
-                                    100)))
-  (check-equal? (drop-client (join (list (ip iworld1 "player1" (body 10 1+10i) empty)
-                                         (ip iworld2 "player2" (body 10 1+10i) empty)
-                                         (ip iworld3 "player3" (body 10 1+10i) empty)) 100)
-                             iworld2)
-                (empty-bundle (join (list (ip iworld1 "player1" (body 10 1+10i) empty)
-                                          (ip iworld3 "player3" (body 10 1+10i) empty)) 100)))
-  (check-equal? (drop-client (join (list (ip iworld1 "player1" (body 10 1+10i) empty)
-                                         (ip iworld2 "player2" (body 10 1+10i) empty)
-                                         (ip iworld3 "player3" (body 10 1+10i) empty)) 100)
-                             iworld3)
-                (empty-bundle (join (list (ip iworld1 "player1" (body 10 1+10i) empty)
-                                          (ip iworld2 "player2" (body 10 1+10i) empty)) 100)))
-  
-  ;; remove-player
-  (check-equal? (drop-player
-                 (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
-                             (ip iworld2 "player345" (body 56 3+45i) empty))
-                       (list (body 87 67+23i)
-                             (body 5 3+4i))
-                       empty)
-                 iworld1)
-                (let ([remd (play-remove 
-                             (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
-                                         (ip iworld2 "player345" (body 56 3+45i) empty))
-                                   (list (body 87 67+23i)
-                                         (body 5 3+4i))
-                                   empty)
-                             iworld1)])
-                  (broadcast-universe remd)
-                  #;
-                  (make-bundle remd (serial/broadcast-univ remd) empty)))
-  
-  (check-equal? (drop-player 
-                 (play (list (ip iworld2 "player345" (body 56 3+45i) empty))
-                       (list (body 87 67+23i)
-                             (body 5 3+4i))
-                       (list (ip iworld1 "player10" (body 10 1+10i) empty)))
-                 iworld1)
-                (let ([remd (play-remove
-                             (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
-                                         (ip iworld2 "player345" (body 56 3+45i) empty))
-                                   (list (body 87 67+23i)
-                                         (body 5 3+4i))
-                                   empty)
-                             iworld1)])
-                  (broadcast-universe remd)
-                  #;
-                  (make-bundle remd (serial/broadcast-univ remd) empty)))
-  
-  ;; ready-to-go
-  (check-false (keep-waiting? (join (list (create-player iworld1 "player")
-                                          (create-player iworld2 "player"))
-                                    250)))
-  (check-false (keep-waiting? (join (list (create-player iworld1 "player")
-                                          (create-player iworld1 "player")
-                                          (create-player iworld2 "player"))
-                                    456345132135213))) 
-  (check-true  (keep-waiting? (join (list (create-player iworld2 "player")) -234)))
-  (check-true  (keep-waiting? (join (list  (create-player iworld2 "player")) 10)))
-  
-  
-  
-  ;; handle-join
-  ;; name
-  ;; update-player
-  
-  ;; remove-player-by-iworld
-  (check-equal? (play-remove
-                 (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
-                             (ip iworld2 "player324" (body 56 3+45i) empty))
-                       (list (body 87 67+23i)
-                             (body 5 3+4i))
-                       empty)
-                 iworld1)
-                (play (list (ip iworld2 "player324" (body 56 3+45i) empty))
-                      (list (body 87 67+23i)
-                            (body 5 3+4i))
-                      empty)
-                empty)
-  (check-equal? (play-remove
-                 (play (list (ip iworld2 "player324" (body 56 3+45i) empty))
-                       (list (body 87 67+23i)
-                             (body 5 3+4i))
-                       empty)
-                 iworld2)
-                (play (list)
-                      (list (body 87 67+23i)
-                            (body 5 3+4i))
-                      empty))
-  
-  ;; testing messaging
-  
-  ;; goto?
-  
-  (check-true (goto? '(goto 3 2)))
-  (check-true (goto? '(goto 3 2)))
-  (check-true (goto? '(goto 0 2)))
-  (check-true (goto? '(goto 6 2)))
-  (check-false (goto? `(goto ,(add1 WIDTH) 0)))
-  (check-false (goto? `(goto 0 ,(add1 HEIGHT))))
-  (check-false (goto? '(goto -1 0)))
-  (check-false (goto? '(goto 0 -1)))
-  (check-false (goto? '(goto 1)))
-  (check-false (goto? '(drag 6+2i)))
-  (check-false (goto? '(drag 1)))
-  (check-false (goto? '(6+1i)))
-  (check-false (goto? '(1 2)))
-  (check-false (goto? '(goto 6+2i)))
-  (check-false (goto? '(drag 1 2)))
-  (check-false (goto? 'click))
-  (check-false (goto? "click"))
-  (check-false (goto? #t))
-  
-  ;;add-waypoint
-  
-  (check-equal? (add-waypoint `(,(ip iworld1 "player10" (body 10 1+10i) empty)) 8+9i iworld1)
-                (list (ip iworld1 "player10" (body 10 1+10i) '(8+9i))))
-  (check-equal? (add-waypoint `(,(ip iworld1 "player10" (body 10 1+10i) '(23+45i))) 8+9i iworld1)
-                (list (ip iworld1 "player10" (body 10 1+10i) '(23+45i 8+9i))))
-  
-  ;; goto
-  
-  (check-equal? (goto (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
-                                  (ip iworld2 "player345" (body 56 3+45i) empty))
-                            (list (body 87 67+23i)
-                                  (body 5 3+4i))
-                            empty)
-                      iworld1 '(goto 1 1))
-                (let ([state (play (list (ip iworld1 "player10" (body 10 1+10i)'(1+1i))
-                                         (ip iworld2 "player345" (body 56 3+45i) empty))
-                                   (list (body 87 67+23i)
-                                         (body 5 3+4i))
-                                   empty)])
-                  (broadcast-universe state)
-                  #;
-                  (make-bundle state (serial/broadcast-univ state) empty)))
-  
-  (check-equal? (goto (play (list (ip iworld1 "player10" (body 10 1+10i) '(1+4i))
-                                  (ip iworld2 "player345" (body 56 3+45i) empty))
-                            (list (body 87 67+23i)
-                                  (body 5 3+4i))
-                            empty)
-                      iworld1 '(goto 1 1))
-                (let ([state (play (list (ip iworld1 "player10" (body 10 1+10i) '(1+4i 1+1i))
-                                         (ip iworld2 "player345" (body 56 3+45i) empty))
-                                   (list (body 87 67+23i)
-                                         (body 5 3+4i))
-                                   empty)])
-                  (broadcast-universe state)
-                  #;
-                  (make-bundle state (serial/broadcast-univ state) empty)))
-  
-  ;; eat-all-the-things
-  (check-pred >= (length (eat-all-the-things  (ip iworld1 "player10" (body 11 0) '(1+10i)) (list (body 10 0))))
-                1)
-  (check-equal? (eat-all-the-things  (ip iworld1 "player10" (body 10 0) '(1+10i)) (list (body 10 40+5i)))
-                (list (body 10 40+5i)))
-  
-  ;; testing initialization
-  
-  ;; property of no motion to same point in move-body
-  ;; also checks for divide by zero error in move-player*
-  (define (property:no-same-point)
-    (define (random-near n)
-      (define ε 1/1000000)
-      (+ n (* (random 10) ε (sub1 (* 2 (random 2))))))
-    
-    (define test-body (create-a-body 1))
-    
-    (define waypoints
-      (for/list ([r (in-range (add1 (random 100)))])
-        (define x (real-part (body-loc test-body)))
-        (define y (imag-part (body-loc test-body)))
-        (make-rectangular (random-near x) (random-near y))))
-    
-    (define random-p (ip iworld1 "nope" test-body waypoints))
-    
-    (define (test p)
-      (cond [(empty? (ip-waypoints p))
-             #t]
-            [(= (first (ip-waypoints p)) 
-                (body-loc (ip-body p)))
-             #f]
-            [else (test (move-player* (list p)))]))
-    
-    (check-true (test random-p)))
-  
-  ;; does spawn food create the nessecary amount of food?
-  (define (property:player/food-number-correct)
-    (define players (random 50))
-    (check-equal? (length (bake-cupcakes players))
-                  (* FOOD*PLAYERS players)))
-  
-  ;; is random-body on the board?
-  (define (test-body-in-bounds)
-    (define size 10)
-    (define body (create-a-body size))
-    (check-true (and (< size (real-part (body-loc body)) (- WIDTH size))
-                     (< size (imag-part (body-loc body)) (- HEIGHT size)))
-                "body out of bounds"))
-  
-  
-  
-  
-  ;;create-name
-  ;; (check-equal? (create-name empty "john") "john")
-  ;; (check-equal? (create-name (list (ip iworld1 "player10" (body 10 0) '(1+10i))) "player10") "player10*")
-  #;
-  (check-equal? (create-name (list (ip iworld1 "player10" (body 10 0) '(1+10i))
-                                   (ip iworld1 "player10*" (body 10 0) '(1+10i)))
-                             "player10")
-                "player10**")
-  #;
-  (check-property property:unique-name)
-  
-  ;; spawn-food
-  (check-property property:player/food-number-correct)
-  
-  ;; random-body
-  (check-property test-body-in-bounds)
-  
-  ;; testing clock tick handling
-  
-  (define tbody1 (body 100 1+3i))
-  (define tbody2 (body 100 1))
-  (define tbody3 (body 100 0+3i))
-  (define tbody4 (body 100 101))
-  
-  (define waypoints1 '(1+3i 1 0+3i 10+10i))
-  (define waypoints2 '(100))
-  
-  ;; move-player*
-  (check-equal? (move-player*
-                 (list (ip iworld1 "player10" (body 10 1+10i) '(1+10.01i))))
-                (list (ip iworld1 "player10" (body 10 1+10.01i) empty)))
-  (check-property property:no-same-point)
-  ;; move-twards-waypoint
-  
-  
-  (test-begin
-   (check-equal? (move-toward-waypoint tbody1 waypoints1)
-                 (rest waypoints1)
-                 "waypoint removal failed")
-   (check-equal? tbody1 (body 100 1+3i) "movement failed")
-   (set! tbody1 (body 100 1+3i)))
-  
-  (test-begin
-   ;; test dependent on (< BASE-SPEED 100)
-   (check-equal? (move-toward-waypoint tbody2 waypoints2)
-                 waypoints2
-                 "waypoint removal failed")
-   (check-equal? tbody2 (body 100 (+ 1 (make-rectangular (/ BASE-SPEED 100) 0)))
-                 "movement failed")
-   (set! tbody2 (body 100 1)))
-  
-  (test-begin
-   (check-equal? (move-toward-waypoint tbody4 waypoints2)
-                 '())
-   (check-equal? tbody4 (body 100 100))
-   (set! tbody4 (body 100 101)))
-  
-  ;; countdown
-  (check-equal? (wait-or-play (join (list (ip iworld1 "player10" (body 10 1+10i) empty))  0))
-                (make-bundle
-                 (join (list (ip iworld1 "player10" (body 10 1+10i) empty)) 1)
-                 (broadcast (list iworld1) (/ 1 WAIT-TIME))
-                 empty))
-  (check-equal? (wait-or-play (join empty  0))
-                (empty-bundle (join empty 1)))
-  
-  ;;countdown
-  (check-equal? (wait-or-play (join (list (ip iworld1 "player10" (body 10 1+10i) empty)
-                                          (ip iworld1 "player345" (body 56 3+45i) empty))
-                                    100))
-                (make-bundle (join (list (ip iworld1 "player10" (body 10 1+10i) empty)
-                                         (ip iworld1 "player345" (body 56 3+45i) empty))
-                                   101)
-                             (broadcast (list iworld1 iworld1) (/ 101 WAIT-TIME))
-                             empty))
-  (check-equal? (wait-or-play (join (list (ip iworld1 "player10" (body 10 1+10i) empty)
-                                          (ip iworld1 "player345" (body 56 3+45i) empty))
-                                    1))
-                (make-bundle (join (list (ip iworld1 "player10" (body 10 1+10i) empty)
-                                         (ip iworld1 "player345" (body 56 3+45i) empty))
-                                   2)
-                             (broadcast (list iworld1 iworld1) (/ 2 WAIT-TIME))
-                             empty))
-  ;; progress
-  (check-equal? (progress 
-                 (list (ip iworld1 "player10" (body 10 1+10i) empty)
-                       (ip iworld1 "player345" (body 56 3+45i) empty))
-                 (list (body 87 67+23i)
-                       (body 5 3+4i))
-                 empty)
-                (broadcast-universe 
-                 (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
-                             (ip iworld1 "player345" (body 56 3+45i) empty))
-                       (list (body 87 67+23i)
-                             (body 5 3+4i))
-                       empty))
-                #;
-                (make-bundle
-                 (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
-                             (ip iworld1 "player345" (body 56 3+45i) empty))
-                       (list (body 87 67+23i)
-                             (body 5 3+4i))
-                       empty)
-                 (serial/broadcast-univ (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
-                                                    (ip iworld1 "player345" (body 56 3+45i) empty))
-                                              (list (body 87 67+23i)
-                                                    (body 5 3+4i))
-                                              empty))
-                 empty))
-  
-  ;; body-collide?
-  (check-true (body-collide? (body 10 10+10i) (body 10 10+10i)))
-  (check-true (body-collide? (body 10 10+10i) (body 10 0+10i)))
-  (check-true (body-collide? (body 10 10+10i) (body 10 10)))
-  (check-true (body-collide? (body 10 10+10i) (body 10 20)))
-  (check-true (body-collide? (body 10 10+10i) (body 10 0+20i)))
-  
-  (check-false (body-collide? (body 1 10+10i) (body 1 10+13i)))
-  (check-false (body-collide? (body 1 10+10i) (body 1 0+10i)))
-  (check-false (body-collide? (body 1 10+10i) (body 1 10)))
-  (check-false (body-collide? (body 1 10+10i) (body 1 20)))
-  (check-false (body-collide? (body 1 10+10i) (body 1 0+20i)))
-  
-  ;; serial/broadcast-univ
-  #;
-  (check-equal? (serial/broadcast-univ 
-                 (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
-                             (ip iworld2 "player345" (body 56 3+45i) empty))
-                       (list (body 87 67+23i)
-                             (body 5 3+4i))
-                       empty))
-                (let ([serialized (serialize-universe (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
-                                                                  (ip iworld2 "player345" (body 56 3+45i) empty))
-                                                            (list (body 87 67+23i)
-                                                                  (body 5 3+4i))
-                                                            empty))])
-                  (list (make-mail iworld1 serialized)
-                        (make-mail iworld2 serialized))))
-  
-  ;; time-broadcast
-  (let ([j (join '() 100)])
-    (check-equal? (time-broadcast j)
-                  (make-bundle j '() '())))
-  (let ([j (join `(,(ip iworld1 "sallyjoe" (body 0 0+0i) '())) 100)])
-    (check-equal? (time-broadcast j)
-                  (make-bundle j `(,(make-mail iworld1 (/ 100 WAIT-TIME))) '())))
-  
-  ;; testing auxiliary functions 
-  (check-equal? (score `(,(ip iworld1 "foo" (body 1000 +inf.0) '())
-                         ,(ip iworld1 "bar" (body 0 +inf.0) '())))
-                `(("foo" ,(get-score 1000))
-                  ("bar" ,(get-score 0))))
-  ;; get-iws
-  ;; empty-bundle
-  (check-equal? (empty-bundle (join (list (ip iworld1 "player10" (body 10 1+10i) empty) 
-                                          (ip iworld2 "player345" (body 56 3+45i) empty)) 132))
-                (make-bundle (join (list (ip iworld1 "player10" (body 10 1+10i) empty) 
-                                         (ip iworld2 "player345" (body 56 3+45i) empty)) 132) empty empty))
-  (check-equal? (empty-bundle (join (list (ip iworld1 "player10" (body 10 1+10i) empty) 
-                                          (ip iworld2 "player345" (body 56 3+45i) empty)) 345))
-                (make-bundle (join (list (ip iworld1 "player10" (body 10 1+10i) empty) 
-                                         (ip iworld2 "player345" (body 56 3+45i) empty)) 345) empty empty))
-  (check-equal? (empty-bundle (play (list (ip iworld1 "player1" (body 87 67+23i) empty))
-                                    (list (body 87 67+23i)
-                                          (body 89 32+345i))
-                                    empty))
-                (make-bundle
-                 (play (list (ip iworld1 "player1" (body 87 67+23i) empty))
-                       (list (body 87 67+23i)
-                             (body 89 32+345i))
-                       empty)
-                 empty
-                 empty))
-  
-  ;; get-iws
-  (check-equal? (get-iws (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
-                                     (ip iworld2 "player345" (body 56 3+45i) empty))
-                               (list (body 87 67+23i)
-                                     (body 5 3+4i))
-                               empty))
-                (list iworld1 iworld2))
-  (check-equal? (get-iws (play (list (ip iworld1 "player10" (body 10 1+10i) empty))
-                               empty
-                               empty))
-                (list iworld1))
-
-  ;; get-ips
-  (let ([players (list (ip iworld1 "player10" (body 10 1+10i) empty)
-                       (ip iworld2 "player345" (body 56 3+45i) empty))]
-        [spectators (list (ip iworld1 "player10" (body 15 2+65i) empty))])
-    (check-equal? (get-ips (play players
-                                 (list (body 87 67+23i)
-                                       (body 5 3+4i))
-                                 spectators))
-                  (append players spectators))
-    (check-equal? (get-ips (play (list (first players))
-                                 (list (body 87 67+23i)
-                                       (body 5 3+4i))
-                                 empty))
-                  (append (list (first players)) empty)))
-
-  ;; broadcast
-  (check-equal? (broadcast (list iworld1 iworld3 iworld2)
-                           '(testing testing 1 2 3))
-                (let ([message '(testing testing 1 2 3)])
-                  (list (make-mail iworld1
-                                   message)
-                        (make-mail iworld3
-                                   message)
-                        (make-mail iworld2
-                                   message))))
-  (check-equal? (broadcast (list iworld1)
-                           '(testing testing 1 2 3))
-                (let ([message '(testing testing 1 2 3)])
-                  (list (make-mail iworld1
-                                   message))))
-  (check-equal? (broadcast (list iworld1 iworld3)
-                           9)
-                (let ([message 9])
-                  (list (make-mail iworld1
-                                   message)
-                        (make-mail iworld3
-                                   message))))
-  
-  ;; broadcast-state
-  (let ([state (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
-                           (ip iworld2 "player345" (body 56 3+45i) empty))
-                     (list (body 87 67+23i)
-                           (body 5 3+4i))
-                     empty)])
-    (check-equal? (broadcast-universe state)
-                  (broadcast-universe state)))
-  
-  ;; serialize-players-for
-  (let* ([waypoints1 (list (make-rectangular 383 212)
-                           (make-rectangular 282 192))]
-         [waypoints2 (list (make-rectangular 918 319)
-                           (make-rectangular 481 119)
-                           (make-rectangular 129 321))]
-        [pls (list (ip iworld1 "player10" (body 10 1+10i) waypoints1)
-                       (ip iworld2 "player345" (body 56 3+45i) waypoints2))]
-        [pl (first pls)])
-    (check-equal? (player-waypoints (first (serialize-players-for pl pls)))
-                  waypoints1)
-    (check-equal? (player-waypoints (second (serialize-players-for pl pls)))
-                  (list (make-rectangular 918 319))))
-
-  "server: all tests run")