;; 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))