#lang scheme
(require 2htdp/universe
         htdp/image
         "pfp.ss")

(define ship-rad 1)
(define speed 5)
(define bullet-rad (/ ship-rad 4))
(define screen-scale 5)
(define screen-width (* screen-scale 16))
(define screen-height (* screen-scale 9))

(define scale 10)
(define ship (circle (* ship-rad scale) 'solid "red"))
(define bullet (circle (* bullet-rad scale) 'solid "black"))

(define initial-bodies
  (list (make-body 'ship (vector 5 5) ship-rad (vector 0 0) #f)))

(define bullet-density 4)
(define fresh-bullets
  (for/list ([i (in-range (/ screen-width bullet-density))])
    (make-body 'bullet (vector (* bullet-density i) screen-height) bullet-rad (vector 0 (* -1 speed)) #f)))

(define (collide b1 b2)
  #t)

(define tick-rate 1/30)

(define-struct screen (time bodies))
(define initial-screen (make-screen 0 initial-bodies))
(define es (empty-scene (* scale screen-width) (* scale screen-height)))

(big-bang initial-screen
          (on-tick
           (match-lambda
             [(struct screen (time (? list? bodies)))
              (define-values (new-bodies collisions) (simulate collide bodies tick-rate))
              (make-screen (+ time tick-rate)
                           (if (ormap (lambda (x) x) collisions)
                               #f
                               (if (= time (round time))
                                   (append new-bodies fresh-bullets)
                                   new-bodies)))]
             [x x])
           tick-rate)
          (on-key
           (lambda (s key)
             (printf "~S~n" key)
             (match s
               [(struct screen (time (? list? bodies)))
                (match bodies
                  [(list-rest ship-b other-bodies)
                   (define new-vel
                     (match key
                       ["up" (vector 0 speed)]
                       ["down" (vector 0 (* -1 speed))]
                       ["right" (vector speed 0)]
                       ["left" (vector (* -1 speed) 0)]
                       [_ (body-vel ship-b)]))
                   (make-screen time
                                (list* (struct-copy body ship-b
                                                    [vel new-vel])
                                       other-bodies))])]
               [x x])))
          (on-draw
           (match-lambda
             [(struct screen (time (? list? bodies)))
              (for/fold ([s es])
                ([b (in-list bodies)])
                (match b
                  [(struct body (layer (vector x y) radius vel data))
                   (place-image (case layer
                                  [(ship) ship]
                                  [(bullet) bullet])
                                (* scale x)
                                (* scale (- screen-height y))
                                s)]))]
             [x es]))
          (stop-when
           (match-lambda
             [(struct screen (time bodies))
              (not bodies)])))