;; 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 21.6.1) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) (require picturing-programs) ; Worked exercise 21.6.1 ; The model for this animation is a moving-x, which consists of x (a number) and dir (a string, either "left" or "right"). ; x indicates the x coordinate of the picture, while ; dir indicates whether the picture is currently moving left or right. (define WIDTH 500) (define HEIGHT 100) (define BACKGROUND (rectangle WIDTH HEIGHT "solid" "white")) (define-struct moving-x (x dir)) ; make-moving-x : number string -> moving-x ; moving-x-x : moving-x -> number ; moving-x-dir : moving-x -> string ; moving-x? : anything -> boolean (define state1 (make-moving-x 10 "right")) (define state2 (make-moving-x 29 "left")) (check-expect (moving-x-x state1) 10) (check-expect (moving-x-dir state2) "left") #| ; function-on-moving-x : a template for functions that take in a moving-x (check-expect (function-on-moving-x state1) ...) (check-expect (function-on-moving-x (make-moving-x 53 "fnord")) ...) (define (function-on-moving-x current) ; current a moving-x ; (moving-x-x current) a number ; (moving-x-dir current) a string ... ) ; function-returning-moving-x : a template for functions that return a moving-x (check-expect (function-returning-moving-x ...) state1) (check-expect (function-returning-moving-x ...) (make-moving-x 26 "left")) (define (function-returning-moving-x ...) (make-moving-x ... ...) ; x and direction, respectively ) |# ; EVENT HANDLERS ; handle-draw : moving-x -> image ; handle-tick : moving-x -> moving-x ; handle-key : moving-x key -> moving-x ; THE DRAW HANDLER ; handle-draw : moving-x -> image ; Recycle calendar-at-x from chapter 8: ; calendar-at-x : number(x) -> image (check-expect (calendar-at-x 43) (place-image pic:calendar 43 50 BACKGROUND)) (check-expect (calendar-at-x 490) (place-image pic:calendar 490 50 BACKGROUND)) (define (calendar-at-x x) (place-image pic:calendar x (quotient HEIGHT 2) BACKGROUND)) ; Once we know that calendar-at-x works, we can use it in test cases ; and bodies for other functions (check-expect (handle-draw state1) (calendar-at-x 10)) (check-expect (handle-draw state2) (calendar-at-x 29)) (define (handle-draw current) ; current a moving-x (make-moving-x 10 "right") ; (moving-x-x current) a number 10 ; (moving-x-dir current) a string "right" ; right answer an image (calendar-at-x 10) (calendar-at-x (moving-x-x current)) ) ; THE TICK HANDLER ; handle-tick : moving-x -> moving-x (define SPEED 3) (check-expect (handle-tick state1) (make-moving-x 13 "right")) (check-expect (handle-tick state2) (make-moving-x 26 "left")) (check-error (handle-tick (make-moving-x 53 "fnord")) "handle-tick: Direction is neither left nor right!") (define (handle-tick current) ; current a moving-x ; (moving-x-x current) a number ; (moving-x-dir current) a string ; SPEED a fixed number ; "left", "right" fixed strings (cond [(string=? (moving-x-dir current) "left") ; current a moving-x (make-moving-x 29 "left") ; (moving-x-x current) a number 29 ; (moving-x-dir current) a string "left" ; right answer a moving-x (make-moving-x 26 "left") (make-moving-x (- (moving-x-x current) SPEED) "left") ] [(string=? (moving-x-dir current) "right") ; current a moving-x (make-moving-x 10 "right") ; (moving-x-x current) a number 10 ; (moving-x-dir current) a string "right" ; right answer a moving-x (make-moving-x 13 "right") (make-moving-x (+ (moving-x-x current) SPEED) "right") ] [else (error 'handle-tick "Direction is neither left nor right!")] ) ) ; THE KEY HANDLER ; handle-key : moving-x key -> moving-x (check-expect (handle-key state1 "up") state1) ; no change (check-expect (handle-key state1 "right") state1) ; since state1 is already going right (check-expect (handle-key state1 "left") (make-moving-x 10 "left")) (check-expect (handle-key state2 "right") (make-moving-x 29 "right")) (define (handle-key current key) ; current a moving-x ; (moving-x-x current) a number ; (moving-x-dir current) a string ; key a string ; "left", "right" fixed strings (cond [(or (key=? key "left") (key=? key "right")) ; current a moving-x (make-moving-x 10 "right") ; (moving-x-x current) a number 10 ; (moving-x-dir current) a string "right" ; key a string "left" ; right answer a moving-x (make-moving-x 10 "left") (make-moving-x (moving-x-x current) key)] [else current] ) ) (big-bang (make-moving-x (quotient WIDTH 2) "right") (check-with moving-x?) (on-draw handle-draw) (on-tick handle-tick 1) (on-key handle-key))