example.ss
#lang scheme/base
(require 2htdp/universe
         htdp/image
         scheme/match
         "sps.ss")

(define ship-rad 1.0)
(define speed 5.0)
(define bullet-rad (/ ship-rad 4.0))
(define screen-scale 5.0)
(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 the-ship
  (make-body 'ship (vector 5.0 5.0) ship-rad (vector 0.0 0.0)))

(define the-simulation
  (create-simulation))

(simulation-add-body! the-simulation the-ship)

(define bullet-density 4.0)
(define (add-fresh-bullets!)
  (printf "Adding bullets!~n")
  (for ([i (in-range 0.0 (/ screen-width bullet-density))])
    (simulation-add-body! 
     the-simulation
     (make-body 'bullet (vector (* bullet-density i) screen-height) bullet-rad (vector 0.0 (* -1 speed))))))

(define dead? #f)
(define (collide! b1 b2)
  (printf "Collide! ~S ~S~n" b1 b2)
  (set! dead? #t))

(define tick-rate (exact->inexact 1/30))

(define-struct screen (time))
(define initial-screen (make-screen 0))

(define frames 0)
(define start-time (current-seconds))
(define (current-fps)
  (define time-since (- (current-seconds) start-time))
  (cond
    [(zero? time-since)
     tick-rate]
    [(zero? frames)
     tick-rate]
    [else
     (/ time-since frames)]))

(define step-simulation
  (match-lambda
    [(struct screen (time))
     (define time-step tick-rate)
     (set! frames (add1 frames))
     (simulate! collide! the-simulation time-step)
     (when (= (modulo frames 100) 0)
       (add-fresh-bullets!))
     (make-screen (+ time time-step))]))

(define (ship-steer s key)
  (match s
    [(struct screen (time))
     (define speed-adj (* speed 2 tick-rate))
     (define adjustment
       (match key
         ["up" (vector 0.0 speed-adj)]
         ["down" (vector 0.0 (* -1 speed-adj))]
         ["right" (vector speed-adj 0.0)]
         ["left" (vector (* -1 speed-adj) 0.0)]
         [_ (vector 0.0 0.0)]))
     (body-posn-adjust! the-ship adjustment)
     (make-screen time)]))

(define draw-screen
  (match-lambda
    [(struct screen (time))
     (for/fold ([s (place-image (text (format "FPS: ~a" (floor (/ 1 (current-fps))))
                                      14 "red")
                                0 0
                                (empty-scene (* scale screen-width) (* scale screen-height)))])
       ([b (in-list (simulation-bodies the-simulation))])
       (match b
         [(struct body (layer (vector x y) radius vel))
          (place-image (case layer
                         [(ship) ship]
                         [(bullet) bullet])
                       (* scale x)
                       (* scale (- screen-height y))
                       s)]))]))

(big-bang initial-screen
          (on-tick
           step-simulation
           tick-rate)
          (on-key
           ship-steer)
          (on-draw
           draw-screen)
          (stop-when
           (match-lambda
             [(struct screen (time))
              dead?])))