Design of a game for controlling a ball on a scene.

ball.rkt

;; BSL program (not Racket)

(require 2htdp/image)
(require 2htdp/universe)

(define BALL-RADIUS 30)
(define WIDTH 500)
(define HEIGHT 500)
(define BACKGROUND (empty-scene WIDTH HEIGHT))
(define TOP BALL-RADIUS)
(define BOT (- HEIGHT BALL-RADIUS))
(define LEFT BALL-RADIUS)
(define RIGHT (- WIDTH BALL-RADIUS))

;; Ball control game:
;; Ball moves up, down, left or right with a vertical and horizontal
;; speed that are indepedent.
;; Arrow keys change direction and increase speed if already
;; going in direction of arrow.
;; Ball bounces off walls.
;; Space key cycles through ball colors.
;; 0-9 set the speed.
;; "." increases speed.
;; "," decreases speed.

;; Nat Nat -> Ball
;; Play game of ball control starting at given coordinates
(define (main x y)
  (big-bang (make-ball x y "red" "right" 1 1)
            [on-tick handle-tick]
            [on-key  handle-key]
            [to-draw draw-ball]))


;; A Ball is a (make-ball Nat Nat Color Dir Nat Nat)
(define-struct ball (x y color dir hspeed vspeed))
;; Interp: Colored ball at (x,y),
;; moving in direction 'dir'
;; with magnitude of horizontal speed 'hspeed'
;;  and magnitude of vertical speed 'vspeed'

;; A Dir is one of "up" "down" "left" "right"

;; Ball -> Ball
;; Move and bounce the ball
(define (handle-tick b)
  (bounce-ball (move-ball b)))

;; Ball Key -> Ball
;; Update ball based on key input
(define (handle-key b key)
  (cond [(arrow? key)    
         (if (string=? key (ball-dir b))
             (speed-up b)
             (change-dir b key))]
        [(key=? key ".") (speed-up b)]         
        [(key=? key ",") (slow-down b)]
        [(key=? key " ") (change-color b (next-color (ball-color b)))]
        [(numeric? key)  (change-speed b (string->number key))]
        [else            b]))

;; Ball -> Scene
;; Render ball on scene
(define (draw-ball b)
  (place-image (circle BALL-RADIUS "solid" (ball-color b))
               (ball-x b)
               (ball-y b)
               (empty-scene WIDTH HEIGHT)))

;; Ball -> Ball
;; Move ball in its direction
(define (move-ball b)
  (cond [(string=? (ball-dir b) "left")
         (change-x b (- (ball-x b) (ball-hspeed b)))]
        [(string=? (ball-dir b) "right")
         (change-x b (+ (ball-x b) (ball-hspeed b)))]
        [(string=? (ball-dir b) "down")
         (change-y b (+ (ball-y b) (ball-vspeed b)))]
        [(string=? (ball-dir b) "up")
         (change-y b (- (ball-y b) (ball-vspeed b)))]))

;; Ball -> Ball
;; Bounce ball at boundaries
(define (bounce-ball b)
  (cond [(and (string=? (ball-dir b) "left")
              (<= (ball-x b) LEFT))
         (change-x (change-dir b "right") LEFT)]
        [(and (string=? (ball-dir b) "right")
              (>= (ball-x b) RIGHT))
         (change-x (change-dir b "left") RIGHT)]
        [(and (string=? (ball-dir b) "up")
              (<= (ball-y b) TOP))
         (change-y (change-dir b "down") TOP)]
        [(and (string=? (ball-dir b) "down")
              (>= (ball-y b) BOT))
         (change-y (change-dir b "up") BOT)]
        [else b]))

;; Ball -> Boolean
;; Is ball moving horizontally?
(define (horiz? b)
  (or (string=? (ball-dir b) "left")
      (string=? (ball-dir b) "right")))

;; Ball -> Ball
;; Move ball faster
(define (speed-up b)
  (cond [(horiz? b) (change-hspeed b (add1 (ball-hspeed b)))]
        [else       (change-vspeed b (add1 (ball-vspeed b)))]))

;; Ball -> Ball
;; Move ball slower
(define (slow-down b)
  (cond [(horiz? b) (change-hspeed b (max 0 (sub1 (ball-hspeed b))))]
        [else       (change-vspeed b (max 0 (sub1 (ball-vspeed b))))]))

;; Ball Nat -> Ball
;; Set speed of ball
(define (change-speed b n)
  (cond [(horiz? b) (change-hspeed b n)]
        [else       (change-vspeed b n)]))

;; Color -> Color
;; Next color in cycle
(define (next-color c)
  (cond [(string=? c "red")    "green"]
        [(string=? c "green")  "yellow"]
        [(string=? c "yellow") "red"]))

;; Key -> Boolean
;; Is key an arrow key?
(define (arrow? key)
  (or (key=? key "left")
      (key=? key "right")
      (key=? key "up")
      (key=? key "down")))

;; String -> Boolean
;; Does string represent numeric value?
(define (numeric? s)
  (not (false? (string->number s))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Convenient updates of balls

(define (change-x b x)
  (make-ball x
             (ball-y b)
             (ball-color b)
             (ball-dir b)
             (ball-hspeed b)
             (ball-vspeed b)))

(define (change-y b y)
  (make-ball (ball-x b)
             y
             (ball-color b)
             (ball-dir b)
             (ball-hspeed b)
             (ball-vspeed b)))

(define (change-color b color)
  (make-ball (ball-x b)
             (ball-y b)
             color
             (ball-dir b)
             (ball-hspeed b)
             (ball-vspeed b)))

(define (change-dir b dir)
  (make-ball (ball-x b)
             (ball-y b)
             (ball-color b)
             dir
             (ball-hspeed b)
             (ball-vspeed b)))

(define (change-hspeed b hspeed)
  (make-ball (ball-x b)
             (ball-y b)
             (ball-color b)
             (ball-dir b)
             hspeed
             (ball-vspeed b)))

(define (change-vspeed b vspeed)
  (make-ball (ball-x b)
             (ball-y b)
             (ball-color b)
             (ball-dir b)
             (ball-hspeed b)
             vspeed))