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. --- fourteen/server.rkt | 1065 --------------------------------------------------- 1 file changed, 1065 deletions(-) delete mode 100644 fourteen/server.rkt (limited to 'fourteen/server.rkt') 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") -- cgit v1.2.3