summaryrefslogtreecommitdiffstats
path: root/fourteen
diff options
context:
space:
mode:
Diffstat (limited to 'fourteen')
-rw-r--r--fourteen/client.rkt611
-rw-r--r--fourteen/graphics/cupcake.gifbin1796 -> 0 bytes
-rw-r--r--fourteen/graphics/hungry-henry.gifbin1132 -> 0 bytes
-rw-r--r--fourteen/readme.txt29
-rw-r--r--fourteen/run.rkt59
-rw-r--r--fourteen/server.rkt1065
-rw-r--r--fourteen/shared.rkt156
7 files changed, 0 insertions, 1920 deletions
diff --git a/fourteen/client.rkt b/fourteen/client.rkt
deleted file mode 100644
index 52305a1..0000000
--- a/fourteen/client.rkt
+++ /dev/null
@@ -1,611 +0,0 @@
-#lang racket
-
-;; This module implements the client for the Hungry Henry game
-
-(provide
- lets-eat ;; String String[IP Address] -> Meal
- ;; launch single client and register at specified host
- )
-
-(require "shared.rkt" 2htdp/universe 2htdp/image)
-
-;
-;
-;
-; ; ;
-; ; ;
-; ; ; ;;; ; ;; ; ;;; ; ;
-; ; ; ; ; ;; ; ;; ; ; ;
-; ;;;;; ; ; ; ; ; ; ;
-; ; ; ;;;;; ; ; ; ; ;
-; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ;
-; ; ; ;;;; ; ; ; ;
-; ;
-; ;;
-;
-
-
-;; Image Constants
-(define FOOD-IMG (bitmap "graphics/cupcake.gif"))
-(define PLAYER-IMG (bitmap "graphics/hungry-henry.gif"))
-(define BASE (empty-scene WIDTH HEIGHT))
-(define WAYPOINT-NODE (circle 3 'solid 'black))
-;; Color Constants
-(define PLAYER-COLOR "red")
-(define MY-COLOR "blue")
-(define WAYPOINT-COLOR "green")
-;; Text Constants
-(define LOADING... "Waiting For Server")
-(define TEXT-SIZE 20)
-(define SCORE-SIZE 20)
-(define TEXT-COLOR "black")
-(define END-OPEN-TEXT "your score was: ")
-(define END-CLOSE-TEXT ", the winner was player ")
-(define LOADING-OPEN-TEXT "\nYou are ")
-(define SEPERATOR ": ")
-;; PBAR constants
-(define PBAR-HEIGHT 35)
-(define PBAR-LOC (- HEIGHT PBAR-HEIGHT))
-(define PBAR-COLOR "red")
-(define PBAR-TEXT (text "loading..." 20 "black"))
-;; Message ID Constants
-(define UPDATE-LENGTH 3)
-(define SPLAYER-LENGTH 3)
-(define SBODY-LENGTH 2)
-(define END-LENGTH 2)
-(define SCORE-LIST-LENGTH 2)
-;; Init Constants
-(define ZERO% 0)
-(define LOADING (text LOADING... 20 "black"))
-
-;; -----------------------------------------------------------------------------
-;; State of Client
-
-(struct app (id img countdown) #:transparent)
-(struct entree (id players food) #:transparent)
-
-;; Meal is one of
-;; - Appetizer
-;; - Entree
-;; Appetizer = (app [or Id #f] Image Number∈[0,1])
-;; interpretation:
-;; -- the first field is this players id, #f if it hasnt been sent yet
-;; -- the second is the loading image
-;; -- the third is the %%% of loading time passed, represents the loading state
-;; Entree = (entree Id [Listof Feaster] [Listof Food])
-;; interpretation:
-;; -- the first field is this player's id
-;; -- the second field represents complete information about all players
-;; -- the third field specifies the location of the cupcakes
-
-(define INITIAL (app #f LOADING ZERO%))
-
-;
-;
-;
-; ;
-; ;
-; ;;; ;;;
-; ;; ;;
-; ; ; ; ; ;;;; ;;; ;; ;;;
-; ; ; ; ; ; ; ; ;; ;
-; ; ; ; ; ; ; ; ;
-; ; ;; ; ;;;;;; ; ; ;
-; ; ;; ; ; ; ; ; ;
-; ; ; ; ; ; ; ;
-; ; ; ; ;; ; ; ;
-; ;;; ;;; ;;;; ;; ;;;;;;; ;;; ;;;
-;
-;
-;
-;
-;
-
-(define (lets-eat label server)
- (big-bang INITIAL
- (to-draw render-the-meal)
- (on-mouse set-waypoint)
- (on-receive handle-server-messages)
- (register server)
- (name label)))
-
-;; Meal Message -> Meal
-;; handles incomming messages
-(define (handle-server-messages meal msg)
- (cond [(app? meal) (handle-appetizer-message meal msg)]
- [(entree? meal) (handle-entree-message meal msg)]))
-
-;; Meal Number Number MouseEvent -> Meal
-;; handles what happends on a click
-(define (set-waypoint meal x y event)
- (if (and (entree? meal) (string=? event "button-down"))
- (make-package meal (list GOTO x y))
- meal))
-
-;; Meal -> Image
-;; deals with draw some kind of meal
-(define (render-the-meal meal)
- (cond [(app? meal) (render-appetizer meal)]
- [(entree? meal) (render-entree meal)]))
-
-;
-;
-;
-; ;;;; ;
-; ; ;
-; ; ; ;;; ;;;; ;;; ;;; ; ; ;;;
-; ; ; ; ; ; ; ; ; ; ; ; ;
-; ;;;; ; ; ; ; ; ; ; ; ; ;
-; ; ; ;;;;; ; ;;;;; ; ;; ;; ;;;;;
-; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ;
-; ; ; ;;;; ;;;; ;;;; ; ; ;;;;
-;
-;
-;
-
-;; -----------------------------------------------------------------------------
-;; Appetizer
-
-;; Appetizer Message -> Meal
-;; starts the game if the message is valid
-(define (handle-appetizer-message s msg)
- (cond [(id? msg) (app msg (app-img s) (app-countdown s))]
- [(time? msg) (app (app-id s) (app-img s) msg)]
- [(state? msg) (switch-to-entree s msg)]
- ;; fault tolerant
- [else s]))
-
-;; Appetizer State -> Meal
-(define (switch-to-entree s m)
- (apply entree (app-id s) (rest m)))
-
-;; -----------------------------------------------------------------------------
-;; Appetizer
-
-;; Entree Message -> Meal
-;; either updates the world or ends the game
-(define (handle-entree-message s msg)
- (cond [(state? msg) (update-entree s msg)]
- [(score? msg) (restart s msg)]
- [else s]))
-
-;; Entree State -> Entree
-;; creates a new entree based on the update mesg
-(define (update-entree s state-msg)
- (apply entree (entree-id s) (rest state-msg)))
-
-;; Entree EndMessage -> Appetizer
-;; Tranistion to start state
-(define (restart s end-msg)
- (define score-image (render-scores end-msg))
- (app (entree-id s) (above LOADING score-image) ZERO%))
-
-;; -----------------------------------------------------------------------------
-;; predicates for recognizing network messages
-
-;; Message -> Boolean
-;; checks if message is a valid update message
-(define (state? msg)
- (and (list? msg)
- (= UPDATE-LENGTH (length msg))
- (symbol? (first msg))
- (list? (second msg))
- (list? (third msg))
- (symbol=? SERIALIZE (first msg))
- (andmap player? (second msg))
- (andmap body? (third msg))))
-
-;; Message -> Boolean
-;; checks if message is a valid time message
-(define (time? msg)
- (and (real? msg) (<= 0 msg 1)))
-
-;; Message -> Boolean
-;; checks if is end game message
-(define (score? msg)
- (and (list? msg)
- (= END-LENGTH (length msg))
- (symbol? (first msg))
- (list? (second msg))
- (symbol=? SCORE (first msg))
- (score-list? (second msg))))
-
-;; List -> Boolean
-;; is this a list binding names to scores?
-(define (score-list? l)
- (for/and ([s l])
- (and (list? s)
- (= SCORE-LIST-LENGTH (length s))
- (id? (first s))
- (number? (second s)))))
-
-;
-;
-;
-; ;
-; ;
-; ;;;;;;
-; ; ;
-; ; ; ;; ;; ;;;; ;;; ;; ;;; ;; ;;; ;;; ;;
-; ; ; ;;; ; ; ; ; ; ; ;; ; ; ;;
-; ; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ;;;;;; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ;; ; ; ; ; ; ; ; ; ;;
-; ;;;;;; ;;;;;; ;;;; ;; ; ; ;;;;;;; ;;; ;;; ;;; ;
-; ;
-; ;;
-; ;;;;
-;
-;
-
-;; -----------------------------------------------------------------------------
-;; Appetizer Drawing
-
-;; Appetizer -> Image
-;; tells the player that we're waiting for the server. shows id
-(define (render-appetizer app)
- (add-progress-bar (render-id+image app) (app-countdown app)))
-
-;; Image Number∈[0,1] -> Image
-;; draws the progress bar
-(define (add-progress-bar base count)
- (place-image (render-progress count) (/ WIDTH 2) PBAR-LOC base))
-
-;; Number∈[0,1] -> Image
-;; draw a progress bar that is count percent complete
-(define (render-progress count)
- (overlay PBAR-TEXT (rectangle (* count WIDTH) PBAR-HEIGHT "solid" PBAR-COLOR)))
-
-;; Appetizer -> Image
-;; gets the text to display on the loading screen
-(define (render-id+image app)
- (define id (app-id app))
- (define base-image (app-img app))
- (overlay
- (cond
- [(boolean? id) base-image]
- [else (define s (string-append LOADING-OPEN-TEXT id))
- (above base-image (text s TEXT-SIZE TEXT-COLOR))])
- BASE))
-
-;; -----------------------------------------------------------------------------
-;; Entree Drawing
-
-;; Entree -> Image
-;; draws a Entree
-(define (render-entree entree)
- (define id (entree-id entree))
- (define pl (entree-players entree))
- (define fd (entree-food entree))
- (add-path id pl (add-players id pl (add-food fd BASE))))
-
-;; [Listof Food] Image -> Image
-;; draws all the food
-(define (add-food foods base-scene)
- (for/fold ([scn base-scene]) ([f foods])
- (place-image FOOD-IMG (body-x f) (body-y f) scn)))
-
-;; Id [Listof Feaster] Image -> Image
-;; draws all players
-(define (add-players id lof base-scene)
- (for/fold ([scn base-scene]) ([feaster lof])
- (place-image (render-avatar id feaster)
- (feaster-x feaster) (feaster-y feaster)
- scn)))
-
-;; Id Feaster -> Image
-;; gets an image for the player
-(define (render-avatar id player)
- (define size (body-size (player-body player)))
- (define color
- (if (id=? id (player-id player)) MY-COLOR PLAYER-COLOR))
- (above
- (render-text (player-id player))
- (overlay (render-player-score player)
- PLAYER-IMG
- (circle size 'outline color))))
-
-;; Feaster -> Image
-;; Draw the players score
-(define (render-player-score player)
- (render-text (number->string (get-score (body-size (player-body player))))))
-
-;; Id [Listof Feaster] Image -> Image
-;; draws the path of the player whose id is passed in
-(define (add-path id players base-scene)
- (define player
- (findf (lambda (x) (id=? id (player-id x))) players))
- (if (boolean? player)
- base-scene
- (add-waypoint* player base-scene)))
-
-;; Feaster Image -> Image
-;; draws the list of way points to the scene
-(define (add-waypoint* player base-scene)
- (define loc (body-loc (player-body player)))
- (define ways (player-waypoints player))
- (define-values (resulting-scene _)
- (for/fold ([scn base-scene][from loc]) ([to ways])
- (values (add-waypoint from to scn) to)))
- resulting-scene)
-
-;; Complex Complex Image -> Image
-;; Add a waypoint to the scene at those coordinates
-(define (add-waypoint from to s)
- (define x-from (real-part from))
- (define y-from (imag-part from))
- (define x-to (real-part to))
- (define y-to (imag-part to))
- (define with-line (add-line s x-to y-to x-from y-from WAYPOINT-COLOR))
- (place-image WAYPOINT-NODE x-to y-to with-line))
-
-;; -----------------------------------------------------------------------------
-;; render the end
-
-;; Score -> Image
-;; draws the end of the game
-(define (render-scores msg)
- (define scores (sort (second msg) < #:key second))
- (for/fold ([img empty-image]) ([name-score scores])
- (define txt (get-text name-score))
- (above (render-text txt) img)))
-
-;; (list ID Natural) -> string
-;; builds a string for that winning pair
-(define (get-text name-score)
- (define-values (name score) (apply values name-score))
- (string-append name SEPERATOR (number->string score)))
-
-
-;
-;
-;
-;
-;
-; ;;;;;
-; ;;
-; ; ; ;; ;; ;;; ;;;
-; ; ; ; ; ; ;
-; ; ; ; ; ; ;
-; ; ; ; ; ;;
-; ;;;;;; ; ; ;;
-; ; ; ; ; ; ;
-; ; ; ; ;; ; ;
-; ;;; ;;; ;;; ;; ;;; ;;;
-;
-;
-;
-;
-;
-
-;; String -> Image
-;; draws the text
-(define (render-text txt)
- (text txt TEXT-SIZE TEXT-COLOR))
-
-;; player -> Number
-;; Gets the X coord of a entrees
-(define (feaster-x feaster)
- (body-x (player-body feaster)))
-
-;; player -> Number
-;; Gets the Y coord of a entrees
-(define (feaster-y feaster)
- (body-y (player-body feaster)))
-
-;; body -> Number
-;; gets the X coord of a body
-(define (body-x body)
- (real-part (body-loc body)))
-
-;; body -> Number
-;; gets the Y coord of a body
-(define (body-y body)
- (imag-part (body-loc body)))
-
-;
-;
-;
-;
-;
-; ;;;;;;;;; ;
-; ; ; ; ;
-; ; ; ; ;;;; ;;;; ; ;;;;;;; ;;;; ;
-; ; ; ; ; ; ; ;; ; ; ;;
-; ; ; ; ; ; ;
-; ; ;;;;;;;; ;;;;; ; ;;;;;
-; ; ; ; ; ;
-; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ;
-; ;;;;; ;;;;; ;;;;;; ;;;; ;;;;;;
-;
-;
-;
-;
-;
-
-(module+ test
-
- (require rackunit rackunit/text-ui)
-
- ;; testing main client
- (check-equal? (switch-to-entree (app "foo" 'blah 1) '(STATE () ()))
- (entree "foo" '()'()))
- (check-equal? (handle-server-messages (app #f 'ksajfhsdkjhfr 1) .5)
- (handle-appetizer-message (app #f 'ksajfhsdkjhfr 1) .5))
- ;;dispatch-mouse
- (check-equal? (set-waypoint (app 1 LOADING 0) 1 1 "button-down")
- (app 1 LOADING 0))
- (check-equal? (set-waypoint (app 1 LOADING 0) 1 1 "button-up")
- (app 1 LOADING 0))
- (check-equal? (set-waypoint (app #f LOADING 0) 1 1 "button-down")
- (app #f LOADING 0))
- (check-equal? (set-waypoint (app #f LOADING 0) 1 1 "button-up")
- (app #f LOADING 0))
- (check-equal? (set-waypoint (entree "player1" (list (player "player1" (body 1 1+1i) empty)) empty) 1 1 "button-up")
- (entree "player1" (list (player "player1" (body 1 1+1i) empty)) empty))
- (check-equal? (set-waypoint (entree "player1" (list (player "player1" (body 1 1+1i) empty)) empty)
- 1 1 "button-down")
- (make-package (entree "player1" (list (player "player1" (body 1 1+1i) empty)) empty)
- (list 'goto 1 1)))
- ;;render-the-meal
-
- ;; testing message receipt
- ;; app-may-start
- ;; entree-msg
- ;; update-msg?
-
- (check-true (state? `(,SERIALIZE (,(player "player1" (body 1+4i 234) `()) ,(player "player1" (body 3 3) `()))
- (,(body 1+i 2) ,(body 2 2)))))
- (check-true (state? `(,SERIALIZE (,(player "player1" (body 1+4i 234) `()))
- (,(body 1+i 2) ,(body 2 2)))))
- (check-true (state? `(,SERIALIZE ()
- (,(body 1+i 2) ,(body 2 2)))))
- (check-true (state? `(,SERIALIZE (,(player "player1" (body 1+4i 234) `()) ,(player "player1" (body 3 3) `()))
- ())))
-
- (check-false (state? `(,SERIALIZE (("player1" (1+4i 234) ()) ("player1" (3 3) ()))
- ((1+i 2) (2 2)))))
- (check-false (state? `(,SERIALIZE (("player1" (1+4i 234) ()))
- ((1+i 2) (2 2)))))
- (check-false (state? `(,SERIALIZE ()
- ((1+i 2) (2 2)))))
- (check-false (state? `(,SERIALIZE (("player1" (1+4i 234) ()) ("player1" (3 3) ()))
- ())))
- (check-true (state? `(,SERIALIZE ()
- ())))
- (check-false (state? `(,SERIALIZE (("player1" (1+4i 234) ()) ("player1" (3 3) ()))
- ((1+i 2) (2 2)))))
- (check-false (state? `(,SERIALIZE (("player1" (1+4i 234) ()))
- ((1+i 2) (2 2)))))
- (check-false (state? `(,SERIALIZE ()
- ((1+i 2) (2 2)))))
- (check-false (state? `(,SERIALIZE (("player1" (1+4i 234) ()) ("player1" (3 3) ()))
- ())))
-
- (check-false (state? '(u ((1 1+4i 234))
- ((1+i 2) (2 2)))))
- (check-false (state? '(((1 1+4i 234))
- ((1+i 2) (2 2)))))
- (check-false (state? '(u ((1 1+4i))
- ((1+i 2) (2 2)))))
- (check-false (state? '(u ((1 1+4i 234))
- ((1+i 2) (2 b)))))
- (check-false (state? '(u ((1 1+4i 234)))))
- (check-false (state? '(u ((1+i 2) (2 2)))))
- (check-false (state? '(((1+i 2) (2 2)))))
- (check-false (state? 4))
- (check-false (state? 'f))
- ;; score-list?
- (check-true (score-list? '(("s" 0) ("l" 0) ("sdf" 0))))
- (check-true (score-list? empty))
- (check-true (score-list? '(("s" 0) ("l" 0))))
- (check-false (score-list? '(('s 0) ('l 0) ('sdf 0))))
- (check-false (score-list? '((s 0) (l 0))))
- (check-false (score-list? '((s) (l))))
- (check-false (score-list? '((s 0) (l 0))))
- ;; update-entree
- (check-equal? (update-entree (entree "player10" '() '())
- `(s (,(player "player1" (body 10 10) `(3 4+9i))
- ,(player "player10" (body 103 10+4i) `(3 5+78i)))
- (,(body 5 10) ,(body 30 30))))
- (entree "player10" (list (player "player1" (body 10 10) (list 3 4+9i))
- (player "player10" (body 103 10+4i) (list 3 5+78i)))
- (list (body 5 10) (body 30 30))))
-
-
- ;; testing rendering the client
-
- ;; draw-app
- (check-equal? (render-appetizer (app #f LOADING 0))
- (add-progress-bar (overlay LOADING
- BASE)
- 0))
- ;; draw-entree
-
-
- ;; draw-players
-
- (check-equal? (add-players "player0"
- (list (player "player1" (body 40 23+34i) empty)
- (player "player0" (body 50 1+3i) empty))
- BASE)
- (place-image (render-avatar "player0" (player "player0" (body 50 1+3i) empty))
- 1 3
- (place-image (render-avatar "player0" (player "player1" (body 40 23+34i) empty))
- 23 34
- BASE)))
- (check-equal? (add-players "player0"
- (list (player "player1" (body 40 23+34i) empty))
- BASE)
- (place-image (render-avatar "player0" (player "player1" (body 40 23+34i) empty))
- 23 34
- BASE))
-
- ;; draw-player
-
- ;; get-player-image
- (check-equal? (render-avatar "player0" (player "player0" (body 30 1+3i) empty))
- (above (render-text "player0")
- (overlay (text (number->string (get-score 30)) 20 'black)
- PLAYER-IMG (circle 30 "outline" MY-COLOR))))
- (check-equal? (render-avatar "player0" (player "player1" (body 30 1+3i) empty))
- (above (render-text "player1")
- (overlay (text (number->string (get-score 30)) 20 'black)
- PLAYER-IMG (circle 30 "outline" PLAYER-COLOR))))
-
- ;; draw-food
- (check-equal? (add-food (list (body 34 54+3i)
- (body 9 45+23i))
- BASE)
- (place-image FOOD-IMG
- 45 23
- (place-image
- FOOD-IMG
- 54 3
- BASE)))
- (check-equal? (add-food (list (body 34 54+3i))
- BASE)
- (place-image
- FOOD-IMG
- 54 3
- BASE))
-
-
- ;; testing auxiliary functions
- ;; player-x
- (check-equal? (feaster-x (player 20 (body 3 1+3i) empty))
- 1)
- (check-equal? (feaster-x (player 20 (body 3 4+3i) empty))
- 4)
- (check-equal? (feaster-x (player 20 (body 3 4+67i) empty))
- 4)
- ;; player-y
- (check-equal? (feaster-y (player 20 (body 3 1+3i) empty))
- 3)
- (check-equal? (feaster-y (player 20 (body 3 4+3i) empty))
- 3)
- (check-equal? (feaster-y (player 20 (body 3 4+67i) empty))
- 67)
-
- ;; body-x
- (check-equal? (body-x (body 20 1+2i))
- 1)
- (check-equal? (body-x (body 20 4+2i))
- 4)
- (check-equal? (body-x (body 20 3+2i))
- 3)
- ;; body-y
- (check-equal? (body-y (body 20 4+1i))
- 1)
- (check-equal? (body-y (body 20 1+4i))
- 4)
- (check-equal? (body-y (body 20 3))
- 0)
-
- "client: all tests run")
-
diff --git a/fourteen/graphics/cupcake.gif b/fourteen/graphics/cupcake.gif
deleted file mode 100644
index 20b1bef..0000000
--- a/fourteen/graphics/cupcake.gif
+++ /dev/null
Binary files differ
diff --git a/fourteen/graphics/hungry-henry.gif b/fourteen/graphics/hungry-henry.gif
deleted file mode 100644
index cce6948..0000000
--- a/fourteen/graphics/hungry-henry.gif
+++ /dev/null
Binary files differ
diff --git a/fourteen/readme.txt b/fourteen/readme.txt
deleted file mode 100644
index 042b0f4..0000000
--- a/fourteen/readme.txt
+++ /dev/null
@@ -1,29 +0,0 @@
-This chapter implements a distributed game, dubbed "Hungry Henry."
-
-TO PLAY, open the file
-
- run.rkt
-
-in DrRacket. The instructions for playing are at the top of the file.
-
-TO EXPERIMENT, open the files
-
- -- run.rkt
- -- server.rkt
- -- client.rkt
- -- shared.rkt
-
-in four different tabs or windows in DrRacket. Switch to the 'run.rkt'
-tab and select
-
- View | Show Module browser
-
-to see how these files are related. To switch to one of these four files,
-you may click the boxes in the module browsers. Alternatively click the
-tab you wish to work on. It is also possible to select tabs via key
-strokes.
-
-Each file except for 'run.rkt' comes with test submodules at the bottom of
-the file.
-
-
diff --git a/fourteen/run.rkt b/fourteen/run.rkt
deleted file mode 100644
index 4a244b7..0000000
--- a/fourteen/run.rkt
+++ /dev/null
@@ -1,59 +0,0 @@
-#lang racket
-
-#|
- Hungry Henry, a multi-player, distributed game
- -----------------------------------------------
-
- This game is a multi-player competition for cupcakes. Each player owns an
- avatar, called a "Henry", and competes for a limited number of cupcakes,
- distributed over a rectangular space. A player launches her Henry via
- a series of mouse clicks, so-called waypoints. Her Henry moves from waypoint
- to waypoint. If it gets close enough to a cupcake, he eats the cupcake and
- fattens up. As a Henry fattens up, he slows down. When all cupcakes are
- consumed, the fattest Henry wins.
-
- Notes:
- 1. The cupcakes remain in place until they are eaten.
- 2. Once a waypoiny is recorded, it cannot be removed.
- 3. Waypoints are visited in a first-come, first-serve order.
-
- Play
- ----
-
- Click Run. Evaluate
-
- (serve-dinner)
-
- in the Interactions Panel. This will pop up three windows:
- -- Matthias, a game window
- -- David, another game window
- -- Universe, the game server's console
-
- Play. You can play the part of both participants. Alternatively, click
- the David or Matthias window (to obtain focus) and click again to choose
- a way point for David's or Matthias's "hungry henry". Watch the hungry
- henries go for the cup cake and eat them up. You can make either one of them
- win or you can force a tie.
-
- To run the game on two distinct computers:
-
- -- copy this folder to another computer, determine its IP number "12.345.67.98"
- -- open run.rkt
- -- evaluate
- (bon-appetit)
-
- -- on your own computer, open run.rkt and run
- -- evaluate
- (lets-eat SomeNameAsAString "12.345.67.98")
-|#
-
-(require (only-in "server.rkt" bon-appetit)
- (only-in "client.rkt" lets-eat)
- 2htdp/universe)
-
-;; launch server worlds for playtesting
-(define (serve-dinner)
- (launch-many-worlds
- (bon-appetit)
- (lets-eat "Matthias" LOCALHOST)
- (lets-eat "David" LOCALHOST)))
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")
diff --git a/fourteen/shared.rkt b/fourteen/shared.rkt
deleted file mode 100644
index 7f3a549..0000000
--- a/fourteen/shared.rkt
+++ /dev/null
@@ -1,156 +0,0 @@
-#lang racket
-
-;; This module describes the shared vocabulary and knowledge for the server
-;; and client modules of the Hungry Henry game.
-
-(provide ;; type Id
- id? ;; Any -> Boolean : Id
- id=? ;; Id Id -> Boolean
- ;; type GOTO
- ;; type SOTO = Time | Ackn | State | Score
- ;; type Food
- ;; type Feaster
- ;; type Body
- (struct-out player) ;;
- (struct-out body) ;;
- get-score ;; Nat -> Nat
- PLAYER-FATTEN-DELTA
- WIDTH HEIGHT CUPCAKE PLAYER-SIZE
- SCORE GOTO SERIALIZE
- GOTO-LENGTH)
-
-#| -----------------------------------------------------------------------------
-
-;; --- Tasks --------------------------------------------------------------------
-
-The game server keeps track of the entire game state [to avoid cheating by
-lients]. It collects waypoints, moves the avatars on behalf of the clients,
-detects collisions with cupcakes, has avatars eat and grow, and discovers the
-end of the game. As events occur, it informs all clients about all actions and,
-at the end of the game, tallies the scores.
-
-Each client displays the current state of the game as broadcast by the server.
-It also records and sends all mouse clicks to the server.
-
-;; --- Messages and Protocol ---------------------------------------------------
-
-The server and the client exchange messages to inform each other about
-the events in the game.
-
-Client To Server Message:
-------------------------
-
- GOTO = (list GOTO PositiveNumber PositiveNumber)
- represents the coordinates of player's latest waypoint,
- obtained via a mouse click.
- Constraint: in (list GOTO x y), (and (<= 0 x WIDTH) (<= 0 y HEIGHT))
-
-Server to Client Message:
--------------------------
-
- SOTO is one of:
- -- Number ∈ [0,1]
- called a Time message
- repreents the percentage of loading time left
- -- ID
- called an Ackn message
- represents the unique id that the server assigns to the client,
- based on the client's name
- -- (list SERIALIZE [Listof Feaster] [Listof Food])
- called a State message
- represents the complete current state of the game
- -- (list SCORE [Listof (list Id Natural)])
- called a Score message
- informs clients that the game is over and the sizes of each player.
-|#
-;; Shared Data Definitions for Messages
-
-(struct player (id body waypoints) #:prefab)
-(struct body (size loc) #:prefab #:mutable)
-;; Food = Body
-;; Feaster = (player Id Body [Listof Complex])
-;; interpretation:
-;; -- id is the player's id
-;; -- body is the player's size and location
-;; -- loc are the player's waypoints, ordered from first to last
-;; Body = (body PositiveNumber Complex)
-;; interpretation: any 'body' on the playing field, both players and cupcakes
-;; -- the postive number specifies the body's size
-;; -- the complex number represents the body's location
-;; PlayerId = String
-(define id? string?)
-(define id=? string=?)
-
-;; Message ID Constants
-(define SCORE 'score)
-(define SERIALIZE 'state)
-(define GOTO 'goto)
-(define GOTO-LENGTH 3)
-
-#| --- Protocol ----------------------------------------------------------------
-
- Client1 Client2 Server
- | | |
- | register(name1) | [universe protocol]
- |----------------------------->|
- | | |
- | | ID | an identifier message
- |<-----------------------------|
- | | t | percentage of wait time
- |<-----------------------------|
- |<-----------------------------|
- |<-----------------------------|
- | | |
- | | register(name2)
- | |------------->|
- | | |
- | | ID |
- | |<-------------|
- | | t | percentage of wait time
- |<-----------------------------|
- | |<-------------|
- |<-----------------------------|
- | |<-------------|
- | | | <==== end of wait time [clock, players]
- | state msg |
- |<-----------------------------| `(state (,feaster1 ,feaster2) ,foods)
- | |<-------------|
- | | |
- click | GOTO | | `(goto ,x ,y)
- ====> |----------------------------->| new state
- | | |
- | state msg |
- |<-----------------------------| `(state (,feaster1 ,feaster2) ,foods)
- | |<-------------|
- | | |
- | | | move, eat:
- |<-----------------------------| `(state (,feaster1 ,feaster2) ,foods)
- | |<-------------|
- | | |
- | click | GOTO | `(goto ,x ,y)
- | ====> |------------->|
- | | |
- | state msg |
- |<-----------------------------| `(state (,feaster1 ,feaster2) ,foods)
- | |<-------------|
- | | |
- | score msg | all food is eaten:
- |<-----------------------------| `(score ((,id ,score) ...))
- | |<-------------|
- | | |
- --- --- ---
-
-|#
-
-;; Shared Logical Constants
-(define WIDTH 1000)
-(define HEIGHT 700)
-(define CUPCAKE 15)
-(define PLAYER-SIZE (* 3 CUPCAKE))
-(define PLAYER-FATTEN-DELTA 5)
-
-;; Number -> Number ;; move to serer
-;; gets aplayers score given its fatness
-(define (get-score f)
- (/ (- f PLAYER-SIZE) PLAYER-FATTEN-DELTA))
-
siddharth ravikumar snafu