;;; Scheme Recursive Art Contest Entry
;;;
;;; Please do not include your name or personal info in this file.
;;;
;;; Title: <Jump to Hyperspace>
;;;
;;; Description:
;;;   <Accelerating
;;;    Through light-years of nothingness,
;;;    Or an acid trip.>

; Utility functions
(define (get lst i)
  (if (zero? i)
    (car lst)
    (get (cdr lst) (- i 1))
  )
)

(define (x_ x)
  (+ x (car xcen))
)

(define (y_ y)
  (+ y (car ycen))
)

(define (lerp-color c0 c1 t)
  (define gb0 (cdr c0))
  (define gb1 (cdr c1))
  (define s (- 1 t))
  (list
    (+ (* s (car c0)) (* t (car c1)))
    (+ (* s (car gb0)) (* t (car gb1)))
    (+ (* s (car (cdr gb0))) (* t (car (cdr gb1))))
  )
)

(define (to-color num)
  (define cid (quotient num 1))
  (define lst (lerp-color (get COLORS cid) (get COLORS (+ cid 1))
    (modulo num 1)))
  (rgb (get lst 0) (get lst 1) (get lst 2))
)

(define (squares len n clr)
  (if (zero? n)
    nil
    (begin
      (color (to-color clr))
      (forward len)
      (right 90)
      (forward len)
      (right 90)
      (squares (* len SPACING) (- n 1) (modulo (+ clr (car dcolor)) 6))
    )
  )
)

(define (bubbles x y n)
  (if (> n 0)
    (begin
      (goto (x_ x) (y_ y))
      (dot 30)
      (define space (* SPACING SPACING SPACING))
      (bubbles (* x space) (* y space) (- n 1))
    )
  )
)

(define WIDTH (screen_width))
(define HEIGHT (screen_height))

(define SIZE 900)
(define SPACING 0.8)

(define COLORS '(
  (1 0 0)
  (0 0 1)
  (1 1 0)
  (0 1 1)
  (1 0 1)
  (0 1 0)
  (1 0 0)
))

(define pcolor '(0))
(define mult '(1.0))
(define angle '(0))
(define rangle '(0))
(define dcolor '(0.05))

(define dmult '(0.005))
(define ddmult '(0.001))

(define xcen '(0))
(define ycen '(0))

(define running '(#t)) ; Flag to tell timer to stop

; Initialize
(define (setup)
  (ht)
  (speed 0)
  (tracer 0 0)
  (bgcolor (rgb 0 0 0))
  (pu)
  0
)

; Draw functions
(define (draw-squares)
  (define dist (/ (* SIZE (car mult)) (+ 1 SPACING)))
  (define startx (* (sin (car angle)) dist (sqrt 2)))
  (define starty (* (cos (car angle)) dist (sqrt 2)))
  (goto (x_ startx) (y_ starty))
  (seth (+ (* (car angle) 57.29577951308232) 135))
  (pensize 4)
  (pd)
  (squares (* SIZE (car mult)) 24 (car pcolor))
  (pu)
  0
)

(define (draw-rays)
  (gen-rays (car rangle) 0.44879895051 14 (expt (car mult) 3))
  0
)

(define (gen-rays angle da n mult)
  (if (zero? n)
    nil
    (begin
      (define endx (* (sin angle) SIZE mult 0.72))
      (define endy (* (cos angle) SIZE mult 0.72))
      (pensize 6)
      (define alpha (/ (- (car dmult) 0.005) 0.1951))
      (if (even? n) (define alpha (* 0.99 (expt alpha 2.7))))
      (color (rgb alpha alpha alpha))
      (goto (x_ 0) (y_ 0))
      (pd)
      (goto (x_ endx) (y_ endy))
      (pu)
      (color (rgb 0 0 0))
      (bubbles endx endy 8)
      (gen-rays (+ angle da) da (- n 1) mult)
    )
  )
)

(define (loop-end)
  ; JUMP !!!
  (define mchange (car dmult))
  (if (> mchange 0.185) (define mchange 3.24))
  (set-car! mult (+ (car mult) mchange))
  ; Reset mult
  (define (check-mult)
    (if (> (car mult) (/ 1 SPACING))
      (begin
        (set-car! pcolor (modulo (+ (car pcolor) (car dcolor)) 6))
        (set-car! mult (* (car mult) SPACING))
        (set-car! angle (+ (car angle) 3.14159265))
        (check-mult)
      )
    )
  )
  (check-mult)
  ; Reset angles
  (set-car! angle (+ (car angle) (* (expt (car dmult) 0.2) 0.0519372)))
  (if (> (car angle) 6.3) (set-car! angle (- (car angle) 6.28318531)))
  (set-car! rangle (- (car rangle) 0.01))
  (if (< (car rangle) 0)
    (set-car! rangle (+ (car rangle) 6.28318531))
  )
  (set-car! dmult (+ (car dmult) (car ddmult)))
  (set-car! dcolor (+ (car dcolor) (* (car ddmult) 0.11)))
  (cond
    ((> (car dmult) 0.2)
      (set-car! dmult 0.2)
      (set-car! ddmult -0.003)
      (set-car! dcolor 0.07145)
    )
    ((< (car dmult) 0.005)
      (set-car! dmult 0.005)
      (set-car! ddmult 0.001)
      (set-car! dcolor 0.05)
    )
  )
  (if (or (< (car dmult) 0.05))
    (begin
      (set-car! xcen 0)
      (set-car! ycen 0)
    )
    (begin
      (set-car! ycen 0)
      (if (< (random) (* (- (car dmult) 0.09) 1.4))
        (set-car! ycen (* (- (random) 0.5) (- (car dmult) 0.05) 150))
      )
      (set-car! xcen (* (- (random) 0.5) (- (car dmult) 0.03) 80))
    )
  )
  0
)

(define (draw)
  (setup)
  (define (loop)
    (clear)
    (draw-rays)
    (draw-squares)
    (loop-end)
    (update)
    (if (car running) (ontimer loop 1))
    0
  )
  (ontimer loop 8000)
  (clicktoexit running)
)

; Please leave this last line alone.  You may add additional procedures above
; this line.
; no u
(draw)