summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--net/ricketyspace/ror/fourteen/client.rkt611
-rw-r--r--net/ricketyspace/ror/fourteen/graphics/cupcake.gifbin0 -> 1796 bytes
-rw-r--r--net/ricketyspace/ror/fourteen/graphics/hungry-henry.gifbin0 -> 1132 bytes
-rw-r--r--net/ricketyspace/ror/fourteen/readme.txt29
-rw-r--r--net/ricketyspace/ror/fourteen/run.rkt59
-rw-r--r--net/ricketyspace/ror/fourteen/server.rkt990
-rw-r--r--net/ricketyspace/ror/fourteen/shared.rkt156
7 files changed, 1845 insertions, 0 deletions
diff --git a/net/ricketyspace/ror/fourteen/client.rkt b/net/ricketyspace/ror/fourteen/client.rkt
new file mode 100644
index 0000000..52305a1
--- /dev/null
+++ b/net/ricketyspace/ror/fourteen/client.rkt
@@ -0,0 +1,611 @@
+#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/net/ricketyspace/ror/fourteen/graphics/cupcake.gif b/net/ricketyspace/ror/fourteen/graphics/cupcake.gif
new file mode 100644
index 0000000..20b1bef
--- /dev/null
+++ b/net/ricketyspace/ror/fourteen/graphics/cupcake.gif
Binary files differ
diff --git a/net/ricketyspace/ror/fourteen/graphics/hungry-henry.gif b/net/ricketyspace/ror/fourteen/graphics/hungry-henry.gif
new file mode 100644
index 0000000..cce6948
--- /dev/null
+++ b/net/ricketyspace/ror/fourteen/graphics/hungry-henry.gif
Binary files differ
diff --git a/net/ricketyspace/ror/fourteen/readme.txt b/net/ricketyspace/ror/fourteen/readme.txt
new file mode 100644
index 0000000..042b0f4
--- /dev/null
+++ b/net/ricketyspace/ror/fourteen/readme.txt
@@ -0,0 +1,29 @@
+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/net/ricketyspace/ror/fourteen/run.rkt b/net/ricketyspace/ror/fourteen/run.rkt
new file mode 100644
index 0000000..4a244b7
--- /dev/null
+++ b/net/ricketyspace/ror/fourteen/run.rkt
@@ -0,0 +1,59 @@
+#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/net/ricketyspace/ror/fourteen/server.rkt b/net/ricketyspace/ror/fourteen/server.rkt
new file mode 100644
index 0000000..c1d1e92
--- /dev/null
+++ b/net/ricketyspace/ror/fourteen/server.rkt
@@ -0,0 +1,990 @@
+#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))
+ (for/fold ([foods '()]) ([f foods])
+ (cond
+ [(body-collide? f b)
+ (set-body-size! b (+ PLAYER-FATTEN-DELTA (body-size b)))
+ foods]
+ [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))
+ (cond [(empty? foods) (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 (get-iws p) (serialize-universe 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)))
+
+;
+;
+;
+;
+; ;;;; ;
+; ; ; ;
+; ; ; ;;; ;;;;; ;;; ; ;;;; ;; ;; ;; ;; ;;;; ;;; ; ;;;;;
+; ; ; ; ; ; ; ;; ; ; ;; ; ;; ; ; ; ; ;; ;
+; ; ; ; ;;;; ; ; ; ; ; ; ; ;;;;;; ; ;
+; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
+; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
+; ;;;; ;;;;; ;;;;; ;;;; ;;;; ;;; ;;; ;;; ;;; ;;;;; ;;;; ;;;
+;
+;
+;
+;
+
+;; 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))))
+
+;; 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-equal? (eat-all-the-things (ip iworld1 "player10" (body 11 0) '(1+10i)) (list (body 10 0)))
+ empty)
+ (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))
+ ;; 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)))
+
+ "server: all tests run")
diff --git a/net/ricketyspace/ror/fourteen/shared.rkt b/net/ricketyspace/ror/fourteen/shared.rkt
new file mode 100644
index 0000000..7f3a549
--- /dev/null
+++ b/net/ricketyspace/ror/fourteen/shared.rkt
@@ -0,0 +1,156 @@
+#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