;; A ball is a structure:
(define-struct ball (x y delta-x delta-y color radius))
(define WIDTH 400)
(define HEIGHT 400)
(define DELAY .01)
;; move-ball : ball -> ball
;; to create a new ball, modeling a move by a-ball
;; structural design, physics knowledge
(define (move-ball a-ball)
(make-ball (+ (ball-x a-ball) (ball-delta-x a-ball))
(+ (ball-y a-ball) (ball-delta-y a-ball))
(ball-delta-x a-ball)
(ball-delta-y a-ball)
(ball-color a-ball)
(ball-radius a-ball)))
;;
;; move-ball-bounce: ball -> ball
;;
;; includes check for bouncing the ball off edge of window
;;
(define (move-ball-bounce a-ball)
(cond
[(out-of-bounds-x? a-ball)
(move-ball (make-ball
(ball-x a-ball)
(ball-y a-ball)
(- 0 (ball-delta-x a-ball))
(ball-delta-y a-ball)
(ball-color a-ball)
(ball-radius a-ball)))]
[(out-of-bounds-y? a-ball)
(move-ball (make-ball
(ball-x a-ball)
(ball-y a-ball)
(ball-delta-x a-ball)
(- 0 (ball-delta-y a-ball))
(ball-color a-ball)
(ball-radius a-ball)))]
[else
(move-ball a-ball)]))
;;
;; out-of-bounds-x? ball -> boolean
;; determine whether a ball has hit either vertical wall
;;
(define (out-of-bounds-x? a-ball)
(not
(<= 0 (ball-x a-ball) WIDTH)))
;;
;; out-of-bounds-y? ball -> boolean
;; determine whether a ball has hit either horizontal wall
;;
(define (out-of-bounds-y? a-ball)
(not
(<= 0 (ball-y a-ball) HEIGHT)))
(define (draw-ball a-ball)
(draw-solid-disk
(make-posn (ball-x a-ball) (ball-y a-ball))
(ball-radius a-ball)
(ball-color a-ball)))
(define (clear-ball a-ball)
(clear-solid-disk
(make-posn (ball-x a-ball) (ball-y a-ball))
(ball-radius a-ball)
(ball-color a-ball)))
(define (bounce-ball a-ball)
(and
(draw-ball a-ball)
(sleep-for-a-while DELAY)
(clear-ball a-ball)
(bounce-ball (move-ball-bounce a-ball))))
(start WIDTH HEIGHT)
(bounce-ball
(make-ball
(random WIDTH)
(random HEIGHT)
(random 5)
(random 5)
'red
20))