From d6541dc938905732cb4988d6dafff8ea2ab9f004 Mon Sep 17 00:00:00 2001 From: rsiddharth Date: Mon, 29 Jun 2020 19:15:52 -0400 Subject: Addd net/ricketyspace/ror/fourteen/ --- net/ricketyspace/ror/fourteen/client.rkt | 611 +++++++++++++ net/ricketyspace/ror/fourteen/graphics/cupcake.gif | Bin 0 -> 1796 bytes .../ror/fourteen/graphics/hungry-henry.gif | Bin 0 -> 1132 bytes net/ricketyspace/ror/fourteen/readme.txt | 29 + net/ricketyspace/ror/fourteen/run.rkt | 59 ++ net/ricketyspace/ror/fourteen/server.rkt | 990 +++++++++++++++++++++ net/ricketyspace/ror/fourteen/shared.rkt | 156 ++++ 7 files changed, 1845 insertions(+) create mode 100644 net/ricketyspace/ror/fourteen/client.rkt create mode 100644 net/ricketyspace/ror/fourteen/graphics/cupcake.gif create mode 100644 net/ricketyspace/ror/fourteen/graphics/hungry-henry.gif create mode 100644 net/ricketyspace/ror/fourteen/readme.txt create mode 100644 net/ricketyspace/ror/fourteen/run.rkt create mode 100644 net/ricketyspace/ror/fourteen/server.rkt create mode 100644 net/ricketyspace/ror/fourteen/shared.rkt 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 Binary files /dev/null and b/net/ricketyspace/ror/fourteen/graphics/cupcake.gif 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 Binary files /dev/null and b/net/ricketyspace/ror/fourteen/graphics/hungry-henry.gif 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)) + -- cgit v1.2.3