#reader(lib "htdp-beginner-reader.ss" "lang")((modname sketch-2) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
(define WIDTH 320)
(define HEIGHT 480)
(define BLANK-COLOR "lightgray")
(define DRAW-COLOR "darkgray")
(define DOT-RADIUS 3)
(define TILT-THRESHOLD 10)
(define-struct world (posn scene direction))
(define (update-world-posn a-world posn)
(make-world posn
(world-scene a-world)
(world-direction a-world)))
(define (update-world-scene a-world a-scene)
(make-world (world-posn a-world)
a-scene
(world-direction a-world)))
(define (update-world-direction a-world a-direction)
(make-world (world-posn a-world)
(world-scene a-world)
a-direction))
(define (update-posn-x a-posn x)
(make-posn x (posn-y a-posn)))
(define (update-posn-y a-posn y)
(make-posn (posn-x a-posn) y))
(define initial-world
(make-world (make-posn (/ WIDTH 2)
(/ HEIGHT 2))
(place-image (nw:rectangle WIDTH HEIGHT "solid" BLANK-COLOR)
0
0
(empty-scene WIDTH HEIGHT))
"stable"))
(define (world-reset a-world)
initial-world)
(define (draw-world-posn a-posn a-scene)
(place-image (nw:rectangle 1 3 "solid" "black")
(posn-x a-posn)
(posn-y a-posn)
a-scene))
(define (draw-dot a-posn a-scene)
(place-image (circle DOT-RADIUS "solid" DRAW-COLOR)
(posn-x a-posn)
(posn-y a-posn)
a-scene))
(define (world-add-posn-to-scene a-world)
(update-world-scene a-world
(draw-dot (world-posn a-world)
(world-scene a-world))))
(define (move-left a-world)
(world-add-posn-to-scene
(update-world-posn a-world
(update-posn-x (world-posn a-world)
(max 0
(- (posn-x (world-posn a-world)) DOT-RADIUS))))))
(define (move-right a-world)
(world-add-posn-to-scene
(update-world-posn a-world
(update-posn-x (world-posn a-world)
(min (sub1 WIDTH)
(+ (posn-x (world-posn a-world)) DOT-RADIUS))))))
(define (move-up a-world)
(world-add-posn-to-scene
(update-world-posn a-world
(update-posn-y (world-posn a-world)
(max 0
(- (posn-y (world-posn a-world)) DOT-RADIUS))))))
(define (move-down a-world)
(world-add-posn-to-scene
(update-world-posn a-world
(update-posn-y (world-posn a-world)
(min (sub1 HEIGHT)
(+ (posn-y (world-posn a-world)) DOT-RADIUS))))))
(define (move-by-drifting a-world)
(cond
[(string=? (world-direction a-world) "stable")
a-world]
[(string=? (world-direction a-world) "left")
(move-left a-world)]
[(string=? (world-direction a-world) "right")
(move-right a-world)]
[(string=? (world-direction a-world) "up")
(move-up a-world)]
[(string=? (world-direction a-world) "down")
(move-down a-world)]))
(define (render-etch-a-sketch a-world)
(draw-world-posn (world-posn a-world)
(world-scene a-world)))
(define (handle-orientation-change a-world azimuth pitch roll)
(cond
[(upside-down? pitch roll)
(world-reset a-world)]
[else
(update-world-direction a-world (get-orientation-direction pitch roll))]))
(define (get-orientation-direction pitch roll)
(cond
[(< 0 TILT-THRESHOLD pitch)
"up"]
[(< pitch (- TILT-THRESHOLD) 0)
"down"]
[(< 0 TILT-THRESHOLD roll)
"right"]
[(< roll (- TILT-THRESHOLD) 0)
"left"]
[else
"stable"]))
(define (upside-down? pitch roll)
(or (> (abs pitch) 120)
(> (abs roll) 120)))
(big-bang WIDTH HEIGHT initial-world
(on-redraw render-etch-a-sketch)
(on-tick 1/20 move-by-drifting)
(on-tilt handle-orientation-change))