summaryrefslogtreecommitdiffstats
path: root/net/ricketyspace/ror/fourteen/client.rkt
diff options
context:
space:
mode:
Diffstat (limited to 'net/ricketyspace/ror/fourteen/client.rkt')
-rw-r--r--net/ricketyspace/ror/fourteen/client.rkt611
1 files changed, 611 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")
+
siddharth ravikumar snafu