;; 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 1-27-14) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) (require 2htdp/image) (require 2htdp/universe) #| Design a program that moves a colored ball back and forth across the canvas. It should not start until the "player" presses any ket and it should pause when the "player" presses a key again. |# (define RADIUS 150) (define SPEED (quotient RADIUS 5)) (define BALL (circle RADIUS "solid" "red")) (define WIDTH (* 8 RADIUS)) (define MID RADIUS) (define BACKGROUND (empty-scene WIDTH (* 2 RADIUS))) (define TXT (text "press any key" 33 "black")) (define-struct running (x dir)) (define-struct resting (x dir)) ;; SG is one of: ;; -- "press any key" ;; -- (make-resting Number Direction) ;; -- (make-running Number Direction) ;; interpretation: "press any key" means the game hasn't started, ;; (make-resting x d) means the ball is resting and will move in ;; direction d when restarted, and ;; (make-running x d) means the ball is at x moving in d ;; Direction is one of: ;; -- -1 ;; -- +1 ;; interpretation: -1 means right to left, +1 is left to right (define sg1 "press any key") (define sg2 (make-resting MID -1)) (define sg3 (make-running MID 1)) ;; Anything -> State (define (stop-and-go _) (big-bang "press any key" [to-draw render-ball] [on-tick next-ball] [on-key start-pause])) #;(define (sg-temp s) (cond [(string? s) ....] [(resting? s) ...(resting-x s) ...(resting-dir s)] [(running? s) ...(running-x s) ...(running-dir s)])) ;; SG -> Image ;; render the current stop-and-go state as an image (define (render-ball s) (cond [(string? s) (place-image TXT (image-width TXT) MID BACKGROUND)] [(resting? s) (place-image BALL (resting-x s) MID BACKGROUND)] [(running? s) (place-image BALL (running-x s) MID BACKGROUND)])) (check-expect (render-ball sg1) (place-image TXT (image-width TXT) MID BACKGROUND)) (check-expect (render-ball sg2) (place-image BALL MID MID BACKGROUND)) (check-expect (render-ball sg3) (place-image BALL MID MID BACKGROUND)) ;; SG KeyEvent -> SG ;; start or pause or re-start ball by pressing any key (define (start-pause s k) (cond [(string? s) (make-running 0 1)] [(resting? s) (make-running (resting-x s) (resting-dir s))] [(running? s) (make-resting (running-x s) (running-dir s))])) (check-expect (start-pause sg1 "k") (make-running 0 1)) (check-expect (start-pause sg2 " ") (make-running MID -1)) (check-expect (start-pause sg3 "s") (make-resting MID 1)) ;; SG -> SG ;; move a running ball in the appropriate direction or flip it, ;; leave others alone (define (next-ball s) (cond [(string? s) s] [(resting? s) s] [(running? s) (if (<= 0 (running-x s) WIDTH) (move-ball s) (flip-direction s))])) (check-expect (next-ball sg1) sg1) (check-expect (next-ball sg2) sg2) (check-expect (next-ball sg3) (make-running (+ MID SPEED) 1)) ;;move-ball: Running -> Running ;;move the ball right or left depending on the direction (define (move-ball s) (make-running (+ (* (running-dir s) SPEED) (running-x s)) (running-dir s))) (check-expect (move-ball sg3) (make-running (+ MID SPEED) 1)) ;;flip-direction:Running -> Running ;;change the direction of the ball when it hits a right or left boundary (define (flip-direction s) (cond [(<= (running-x s) 0) (make-running 0 +1)] [(>= (running-x s) WIDTH) (make-running WIDTH -1)])) ;;write tests for flip-direction!