red-ball-game.rkt

#lang racket

(require 2htdp/universe)
(require 2htdp/image)
(require test-engine/racket-tests)

(define WIDTH 500)
(define HEIGHT 500)

(define BACKGROUND (rectangle WIDTH HEIGHT 'solid 'white))
(define CHAR-HEIGHT 60)
(define CHARACTER (circle (/ CHAR-HEIGHT 2) 'solid 'red))
(define BOTTOM (- HEIGHT CHAR-HEIGHT))
(define GRAVITY 1)
(define SPEED 10)

(struct world (x y))

(define (world=? w1 w2)
  (and (= (world-x w1) (world-x w2))
       (= (world-y w1) (world-y w2))))

(check-expect (world=? (world 10 20) (world 10 20))
              true)
(check-expect (world=? (world 10 20) (world 30 40))
              false)

(define (draw-world w)
  (underlay/xy BACKGROUND
               (world-x w)
               (world-y w)
               CHARACTER))

(check-expect (draw-world (world 10 20))
              (underlay/xy BACKGROUND 10 20 CHARACTER))

(define (tick-world w)
  (world (world-x w)
         (if (< (world-y w) BOTTOM)
             (+ (world-y w) GRAVITY)
             BOTTOM)))

(check-expect (world=? (tick-world (world 10 20))
                       (world 10 (+ 20 GRAVITY)))
              true)
(check-expect (world=? (tick-world (world 10 BOTTOM))
                       (world 10 BOTTOM))
              true)

(define (change-world w key)
  (cond
    [(key=? key "left") (world (- (world-x w) SPEED)
                               (world-y w))]
    [(key=? key "right") (world (+ (world-x w) SPEED)
                                (world-y w))]
    [(key=? key "up") (world (world-x w)
                             (- (world-y w) SPEED))]
    [else w]))

(define (run-game)
  (big-bang (world 50 50)
            (to-draw draw-world)
            (on-tick tick-world)
            (on-key change-world)))

(test)