;; The first three lines of this file were inserted by DrRacket. They record metadata ;; about the language level of this file in a form that our tools can easily process. #reader(lib "htdp-beginner-reader.ss" "lang")((modname 04-ball-world) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) ;; A bouncing ball animation (require 2htdp/image) (require 2htdp/universe) ;; Constants (define BALL-RADIUS 5) (define BALL-COLOR "blue") (define WIDTH 600) (define HEIGHT 400) ;; Data definitions ; A Velocity is (make-vel Number Number) ; interp. (make-vel dx dy) then the thing moves by dx pixels horizontally ; and dy pixels vertically at each clock tick (define-struct vel (dx dy)) ;; Template for Velocity #; (define (process-velocity vel ...) ... (vel-dx vel) ... ... (vel-dy vel) ...) ; A Ball is (make-ball Posn Velocity) ; interp. the position and velocity of the ball (define-struct ball (posn vel)) ;; Template for Ball #; (define (process-ball ball ...) ... (ball-posn ball) ... ... (ball-vel ball) ...) ; A World is a Ball (define BALL0 (make-ball (make-posn 20 50) (make-vel 3 4))) ;; Functions ; step-ball : World -> World ; To update the ball at each time step ; ; Examples: ; ; - no bounce: at (20, 30) moving at <3, 6> => (23, 36) with <3, 6> ; - a bounce: at (2, 10) moving at <-5, 0> => (-3, 10) with <5, 0> ; ; Strategy: struct. decomp (define (step-ball ball) (make-ball (step-posn (ball-posn ball) (ball-vel ball)) (step-vel (ball-vel ball) (ball-posn ball)))) (check-expect (step-ball (make-ball (make-posn 20 30) (make-vel 3 6))) (make-ball (make-posn 23 36) (make-vel 3 6))) (check-expect (step-ball (make-ball (make-posn 20 30) (make-vel 0 -4))) (make-ball (make-posn 20 26) (make-vel 0 -4))) (check-expect (step-ball (make-ball (make-posn 2 10) (make-vel -5 0))) (make-ball (make-posn -3 10) (make-vel 5 0))) (check-expect (step-ball (make-ball (make-posn 3 4) (make-vel -10 -9))) (make-ball (make-posn -7 -5) (make-vel 10 9))) (check-expect (step-ball (make-ball (make-posn (- WIDTH 1) 20) (make-vel 10 8))) (make-ball (make-posn (+ WIDTH 9) 28) (make-vel -10 8))) (check-expect (step-ball (make-ball (make-posn 20 (- HEIGHT 1)) (make-vel 10 8))) (make-ball (make-posn 30 (+ HEIGHT 7)) (make-vel 10 -8))) ; step-posn : Posn Vel -> Posn ; To update the position at each tick ; ; Strategy: struct. decomp. (Posn and Velocity) (define (step-posn p v) (make-posn (+ (posn-x p) (vel-dx v)) (+ (posn-y p) (vel-dy v)))) (check-expect (step-posn (make-posn 20 30) (make-vel 3 6)) (make-posn 23 36)) (check-expect (step-posn (make-posn 20 30) (make-vel 0 -4)) (make-posn 20 26)) (check-expect (step-posn (make-posn 2 10) (make-vel -5 0)) (make-posn -3 10)) (check-expect (step-posn (make-posn 3 4) (make-vel -10 -9)) (make-posn -7 -5)) (check-expect (step-posn (make-posn (- WIDTH 1) 20) (make-vel 10 8)) (make-posn (+ WIDTH 9) 28)) (check-expect (step-posn (make-posn 20 (- HEIGHT 1)) (make-vel 10 8)) (make-posn 30 (+ HEIGHT 7))) ; step-vel : Vel Posn -> Vel ; To update the velocity at each tick ; ; Examples: ; ; - If velocity is <-5, 0> and position is (10, 30) then velocity ; remains unchanged ; - If velocity is <-5, 0> and position is (2, 30), then velocity ; changes to <5, 0> ; - If velocity is <5, 10> and position is (30, HEIGHT - 5), then ; velocity changes to <5, -10> ; ; Strategy: struct. decomp. (Velocity and Posn) (define (step-vel v p) (make-vel (maybe-bounce (vel-dx v) (posn-x p) WIDTH) (maybe-bounce (vel-dy v) (posn-y p) HEIGHT))) (check-expect (step-vel (make-vel 3 6) (make-posn 20 30)) (make-vel 3 6)) (check-expect (step-vel (make-vel 0 -4) (make-posn 20 30)) (make-vel 0 -4)) (check-expect (step-vel (make-vel -5 0) (make-posn 2 10)) (make-vel 5 0)) (check-expect (step-vel (make-vel -10 -9) (make-posn 3 4)) (make-vel 10 9)) (check-expect (step-vel (make-vel 10 8) (make-posn (- WIDTH 1) 20)) (make-vel -10 8)) (check-expect (step-vel (make-vel 10 8) (make-posn 20 (- HEIGHT 1))) (make-vel 10 -8)) ; maybe-bounce : Number Number Number -> Number ; To reverse the 1-D velocity if it would move the position past ; the edge. ; ; Examples: ; - (maybe-bounce 10 35 50) => 10 ; - (maybe-bounce 10 45 50) => -10 (bounce) ; - (maybe-bounce -10 20 50) => -10 ; - (maybe-bounce -10 5 50) => 10 (bounce) ; ; Strategy: domain knowledge (define (maybe-bounce dq q mq) (cond [(< 0 (+ q dq) mq) dq] [else (- dq)])) (check-expect (maybe-bounce 10 95 100) -10) (check-expect (maybe-bounce 3 95 100) 3) (check-expect (maybe-bounce -7 3 100) 7) (check-expect (maybe-bounce -7 10 100) -7) ; render-ball : World -> Scene ; To render the ball scene. ; ; Strategy: struct. decomp. (define (render-ball ball) (render-posn (ball-posn ball))) (check-expect (render-ball (make-ball (make-posn 20 30) (make-vel 0 0))) (place-image (circle BALL-RADIUS "solid" BALL-COLOR) 20 30 (empty-scene WIDTH HEIGHT))) ; render-posn : Posn -> Scene ; Renders a ball, knowing its position ; ; Strategy: struct. decomp. (define (render-posn p) (place-image (circle BALL-RADIUS "solid" BALL-COLOR) (posn-x p) (posn-y p) (empty-scene WIDTH HEIGHT))) (check-expect (render-posn (make-posn 20 30)) (place-image (circle BALL-RADIUS "solid" BALL-COLOR) 20 30 (empty-scene WIDTH HEIGHT))) ;; run : World -> World ;; Starts a ball animation (define (run ball) (big-bang ball (on-tick step-ball) (on-draw render-ball))) (run BALL0)