(require-library "graphics.ss" "graphics")

(define pi 3.1415926)
(define fx 0.995)
(define gy 0.005)
(define radius 4)



















(define rocket
  (lambda (v color delta-t detonate?)
    (letrec ((r (lambda (x0 y0 vx0 vy0 ttl)
		  (let ((x1 (+ x0 vx0))
			(y1 (+ y0 vy0))
			(vy1 (+ gy vy0))
                        (vx1 (* vx0 fx))
                        (p (make-posn x0 y0))
                        (ttl1 (- ttl 1)))
                    ((draw-solid-ellipse v) p radius radius color)
                    (sleep delta-t)
                    ((draw-solid-ellipse v) p radius radius)
                    (cond
                      ((> ttl 0)
                       (r x1 y1 vx1 vy1 ttl1))
                      (detonate?
                       (detonate v color delta-t x1 y1 vx1 vy1)))))))
      (lambda xs (thread (lambda () (apply r xs)))))))





(define random-01
  (lambda () (/ (random 256) 256)))

(define detonate-min 20)
(define detonate-var 40)
(define detonate
  (lambda (v color delta-t x0 y0 vx0 vy0)
    (let loop ((n-rockets (+ detonate-min (random detonate-var))))
      (if (> n-rockets 0)
          (let ((phi (* pi (/ (random 360) 180)))
                (v0 (random-01)))
            ((rocket v 
                    (make-rgb (random-01) (random-01) (random-01))
                    delta-t
                    #f)
             x0
             y0
             (+ vx0 (* v0 (cos phi)))
             (+ vy0 (* v0 (sin phi)))
             (random (round (inexact->exact (/ 2 delta-t)))))
            (loop (- n-rockets 1)))))))


(define rockets
  (lambda (w h)
    (open-graphics)
    (let ((v (open-viewport "Rockets" w h)))
      ((draw-viewport v))
      (let loop ()
        ((rocket v (make-rgb 1 0 0) 0.01 #t)
         (+ (/ w 4) (random (quotient w 2))) h
         (- 0.5 (random-01)) (* -1 (+ 1 (* h 0.003 (random-01)))) 400)
        (sleep (+ 1 (/ (random 10) 2)))
        (if (not (ready-mouse-click v))
            (loop)))
      (close-viewport v)
      (close-graphics))))