#lang s-exp "../moby-lang.ss"
(define-struct world
(posn r vel target-posn score))
(define WIDTH 320)
(define HEIGHT 480)
(define TARGET-RADIUS 30)
(define-struct vel (x y))
(define initial-world
(make-world (make-posn (quotient WIDTH 2)
(quotient HEIGHT 2))
30
(make-vel 0 0)
(make-posn 0 0)
0))
(define (tick w)
(cond
[(collide? w)
(make-world (posn+vel (world-posn w)
(world-vel w))
30
(world-vel w)
(make-random-posn)
(add1 (world-score w)))]
[else
(make-world (posn+vel (world-posn w)
(world-vel w))
(- (world-r w) 1/3)
(world-vel w)
(world-target-posn w)
(world-score w))]))
(define (tilt w azimuth pitch roll)
(make-world (world-posn w)
(world-r w)
(make-vel roll (- pitch))
(world-target-posn w)
(world-score w)))
(define (render w)
(maybe-add-game-over
w
(place-image/posn
(text (format "Score: ~a" (world-score w))
20 "black")
(make-posn 20 20)
(place-image/posn
(circle TARGET-RADIUS "solid" "red")
(world-target-posn w)
(place-image/posn
(circle (world-r w) "solid" "blue")
(world-posn w)
(empty-scene WIDTH HEIGHT))))))
(define (maybe-add-game-over w a-scene)
(cond
[(game-ends? w)
(place-image/posn
(text "GAME OVER" 30 "red")
(make-posn 20 100)
a-scene)]
[else
a-scene]))
(define (collide? w)
(< (distance (world-posn w)
(world-target-posn w))
(+ TARGET-RADIUS (world-r w))))
(define (game-ends? w)
(<= (world-r w) 1))
(define (make-random-posn)
(make-posn (random WIDTH)
(random HEIGHT)))
(define (key w a-key)
(make-world (world-posn w)
(world-r w)
(update-vel-with-key
(world-vel w) a-key)
(world-target-posn w)
(world-score w)))
(define (update-vel-with-key v a-key)
(cond [(key=? a-key "left")
(make-vel (- (vel-x v) 3)
(vel-y v))]
[(key=? a-key "right")
(make-vel (+ (vel-x v) 3)
(vel-y v))]
[(key=? a-key "up")
(make-vel (vel-x v)
(- (vel-y v) 3))]
[(key=? a-key "down")
(make-vel (vel-x v)
(+ (vel-y v) 3))]
[else
v]))
(define (posn+vel a-posn a-vel)
(make-posn (clamp (+ (posn-x a-posn)
(vel-x a-vel))
0 WIDTH)
(clamp (+ (posn-y a-posn)
(vel-y a-vel))
0 HEIGHT)))
(define (clamp x a b)
(cond [(> x b) b]
[(< x a) a]
[else x]))
(define (distance posn-1 posn-2)
(sqrt
(+ (sqr (- (posn-x posn-1)
(posn-x posn-2)))
(sqr (- (posn-y posn-1)
(posn-y posn-2))))))
(define (place-image/posn img a-posn a-scene)
(place-image img
(posn-x a-posn)
(posn-y a-posn)
a-scene))
(js-big-bang initial-world
(on-tick 1/20 tick)
(on-tilt tilt)
(on-redraw render)
(on-key key)
(stop-when game-ends?))