#lang scheme/base
(require htdp/world
lang/prim)
(provide (except-out (all-from-out htdp/world) on-key-event on-mouse-event))
(provide start)
(define-higher-order-primitive start animate/proc (_ _ update-target-x update-target-y update-player
update-object
_ _ _
target-offscreen?))
(define-struct target [x y])
(define-struct object [x y])
(define-struct world [target player object score timer])
(define target1 (make-target 5 235))
(define object1 (make-object 380 -400))
(define player1 320)
(define world1 (make-world target1 player1 object1 0 1))
(define (animate/proc TITLE bg
update-target-x update-target-y update-player update-object
target player object target-offscreen?)
(let* ((draw-world* (lambda (w) (draw-world TITLE bg w object target player)))
(keypress* (lambda (w k) (keypress w k update-player)))
(collide?* (lambda (w) (struct-collide? (world-target w) (world-object w) collide?)))
(update-t* (lambda (w)
(make-target (update-target-x (target-x (world-target w)))
(update-target-y (target-y (world-target w))))))
(update-m* (lambda (m)
(if (< (object-y m) -1000) object1 (make-object (object-x m) (update-object (object-y m))))))
(update-world (lambda (w)
(cond
[(target-offscreen? (target-x (world-target w)) (target-y (world-target w)))
(make-world target1 (world-player w) (update-m* (world-object w)) (world-score w) 0)]
[(collide?* w)
(make-world target1 (world-player w) (update-m* (world-object w)) (+ 100 (world-score w)) 151)]
[(> (world-timer w) 1)
(make-world (world-target w) (world-player w) (update-m* (world-object w))
(world-score w) (- (world-timer w) 15))]
[else (make-world (update-t* w) (world-player w) (update-m* (world-object w))
(world-score w) (world-timer w))]))))
(big-bang 320 480 .1 world1 (> 3 2))
(on-tick-event update-world)
(on-redraw draw-world*)
(on-key-event keypress*)))
(define (draw-world TITLE bg w object target player)
(let* ((explosion (circle (+ (world-timer w) 1) "solid" (if (even? (world-timer w)) "red" "orange")))
(score-text (string-append TITLE " score: " (number->string (world-score w))))
(add-target (cond
[(> (world-timer w) 1) (place-image explosion (object-x (world-object w))
(object-y (world-object w)) (put-pinhole bg 0 0))]
[else (place-image target (target-x (world-target w))
(target-y (world-target w)) (put-pinhole bg 0 0))]))
(add-object (place-image object (object-x (world-object w)) (object-y (world-object w)) add-target))
(add-player (place-image player (world-player w) 410 add-object)))
(place-image (text score-text 10 'black) 10 0 add-player)))
(define (keypress w key update-player)
(cond
[(symbol? key) (keypress w (symbol->string key) update-player)]
[(char? key) w]
[(string=? key "left") (make-world (world-target w) (update-player (world-player w) key)
(world-object w) (world-score w) (world-timer w))]
[(string=? key "right") (make-world (world-target w) (update-player (world-player w) key)
(world-object w) (world-score w) (world-timer w))]
[(string=? key "up") (make-world (world-target w) (world-player w) (fire-object w) (world-score w) 0)]
[else w]))
(define (struct-collide? t m collide?)
(collide? (target-x t) (target-y t) (object-x m) (object-y m)))
(define (distance x1 y1 x2 y2)
(sqrt (+ (sqr (- x2 x1)) (sqr (- y2 y1)))))
(define (collide? x1 y1 x2 y2)
(< (distance x1 y1 x2 y2) 30))
(define (fire-object w)
(if (< (object-y (world-object w)) 100)
(make-object (world-player w) 400)
(make-object (object-x (world-object w)) (object-y (world-object w)))))
(define (sqr x)
(* x x))