hungry henry game
This commit is contained in:
Matthias Felleisen
parent
b06f938fb8
commit
4111379982
611
collects/realm/chapter14/client.rkt
Normal file
611
collects/realm/chapter14/client.rkt
Normal file
|
|
@ -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")
|
||||
|
||||
29
collects/realm/chapter14/readme.txt
Normal file
29
collects/realm/chapter14/readme.txt
Normal file
|
|
@ -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.
|
||||
|
||||
|
||||
59
collects/realm/chapter14/run.rkt
Normal file
59
collects/realm/chapter14/run.rkt
Normal file
|
|
@ -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)))
|
||||
990
collects/realm/chapter14/server.rkt
Normal file
990
collects/realm/chapter14/server.rkt
Normal file
|
|
@ -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")
|
||||
156
collects/realm/chapter14/shared.rkt
Normal file
156
collects/realm/chapter14/shared.rkt
Normal file
|
|
@ -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))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user