From 0f072be231d0bd875d1c87ff127834e60979263a Mon Sep 17 00:00:00 2001 From: rsiddharth Date: Fri, 3 Jul 2020 15:47:02 -0400 Subject: net/ricketyspace/ror -> ./ --- fourteen/client.rkt | 611 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 611 insertions(+) create mode 100644 fourteen/client.rkt (limited to 'fourteen/client.rkt') diff --git a/fourteen/client.rkt b/fourteen/client.rkt new file mode 100644 index 0000000..52305a1 --- /dev/null +++ b/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") + -- cgit v1.2.3