#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")
