;;; Scheme Recursive Art Contest Entry
;;;
;;; Please do not include your name or personal info in this file.
;;;
;;; Title: <Your title here>
;;;
;;; Description:
;;;   <It's your masterpiece.
;;;    Use these three lines to describe
;;;    its inner meaning.>

(define (square x) (* x x))

(define (length-sq a)
  (if (null? a)
    0
    (+ (square (car a)) (length-sq (cdr a)))))

(define (length a) (sqrt (length-sq a)))

(define (vec+ l r)
  (if (null? l)
    nil
    (cons (+ (car l) (car r)) (vec+ (cdr l) (cdr r)))))

(define (vec- l r)
  (if (null? l)
    nil
    (cons (- (car l) (car r)) (vec- (cdr l) (cdr r)))))

(define (vec/ l r)
  (if (null? l)
    nil
    (cons (/ (car l) (car r)) (vec/ (cdr l) (cdr r)))))

(define (vec-dot l r)
  (if (null? l)
    0
    (+ (* (car l) (car r)) (vec-dot (cdr l) (cdr r)))))

(define (vec*scalar v s) (map (lambda (comp) (* comp s)) v))

(define (vec/scalar v s) (map (lambda (comp) (/ comp s)) v))

(define (vec-abs v) (map (lambda (n) (abs n)) v))

(define (vec-clamp-0 v) (map (lambda (n) (max n 0)) v))

(define (vec-clamp-0-1 v) (map (lambda (n) (min (max n 0) 1)) v))

(define (clamp-0-1 n) (min (max n 0) 1))

(define (vec-normalize v) (vec/scalar v (length v)))

(define (disp p x y z) (list (+ (car p) x) (+ (cadr p) y) (+ (caddr p) z)))

(define (sdTorus p t)
  (- (length (list (- (length (list (car p) (caddr p))) (car t)) (cadr p))) (cadr t)))

(define (sdBox p b)
  (define d (vec- (vec-abs p) b))
  (+ (min (max (car d) (max (cadr d) (caddr d))) 0.0) (length (vec-clamp-0 d))))

(define (sdCappedCylinder p h)
  (define d (vec- (vec-abs (list (length (list (car p) (caddr p))) (cadr p))) h))
  (+ (min (max (car d) (cadr d)) 0) (length (vec-clamp-0 d))))

(define (torusY p t ydisp) (sdTorus (list (- (car p) 15) (+ (cadr p) ydisp) (caddr p)) t))

(define (sceneSdf point)
  (min
    (torusY point '(6.0 1.0) -0.0)
    (torusY point '(5.0 1.0) -1.5)
    (torusY point '(4.0 1.0) -3.0)
    (torusY point '(3.0 1.0) -4.5)
    (sdTorus (disp point 15.0 0.0 0.0) '(2.0 1.0))
    (sdBox (disp point 0.0 2.0 0.0) '(25.0 1.0 10.0))
    (sdCappedCylinder (disp point 15.0 -5.0 0.0) '(1.0 8.0))
    (sdCappedCylinder (disp point 0.0 -5.0 0.0) '(1.0 8.0))
    (sdCappedCylinder (disp point -15.0 -5.0 0.0) '(1.0 8.0))))

(define (estimateNormal p)
  (vec-normalize (list
  (- (sceneSdf (list (+ (car p) 0.001) (cadr p) (caddr p))) (sceneSdf (list (- (car p) 0.001) (cadr p) (caddr p))))
  (- (sceneSdf (list (car p) (+ (cadr p) 0.001) (caddr p))) (sceneSdf (list (car p) (- (cadr p) 0.001) (caddr p))))
  (- (sceneSdf (list (car p) (cadr p) (+ (caddr p) 0.001))) (sceneSdf (list (car p) (cadr p) (- (caddr p) 0.001)))))))

(define (shadow ro rd t maxt k res)
  (define h (sceneSdf (vec+ ro (vec*scalar rd t))))
  (if (> t maxt)
    res
    (if (< h 0.001)
      0
      (shadow ro rd (+ t h) maxt k (min res (/ (* k h) t))))))

(define VPos (list 0.0 6.0 25.0))

(define (shader1 normal pos)
  (if (<= (cadr pos) -0.999)
    (begin (define specPower 2.0) (define diffuseColor '(0.90 0.91 0.98)))
    (begin (define specPower 50.0) (define diffuseColor '(0.51 0.322 0.004))))
  (define V (vec-normalize (vec- VPos pos)))
  (define L (vec-normalize (list 1 1 1)))
  (define H (vec-normalize (vec+ V L)))
  (define NoL (clamp-0-1 (vec-dot normal L)))
  (define NoH (clamp-0-1 (vec-dot normal H)))
  (define specIntensity (expt NoH specPower))
  (define LPos (vec*scalar L 100))
  (define fShdw (shadow pos (vec-normalize (vec- LPos pos)) 0.1 1000.0 3.333 1))
  (define color (vec+ (vec*scalar diffuseColor NoL) (vec*scalar (list 0.714 0.608 0.698) specIntensity)))
  (vec+ (vec*scalar (list 0.51 0.322 0.004) 0.3) (vec*scalar color fShdw)))

(define NUMBER_OF_STEPS 1000)
(define MAXIMUM_TRACE_DISTANCE 1000)

(define (rayMarch ro rd uv t step)
  (define pos (vec+ ro (vec*scalar rd t)))
  (define dist (sceneSdf pos))
  (if (< dist 0.001)
    (shader1 (estimateNormal pos) pos)
    (if (or (> dist MAXIMUM_TRACE_DISTANCE) (> step NUMBER_OF_STEPS))
      (vec*scalar (list 0.529411765 0.807843137 0.980392157) (+ (* (cadr uv) 0.8) 0.2))
      (rayMarch ro rd uv (+ t dist) (+ step 1)))))

(define (draw)
; YOUR CODE HERE
; Works cited:
; http://jamie-wong.com/2016/07/15/ray-marching-signed-distance-functions/
; http://www.michaelwalczyk.com/blog/2017/5/25/ray-marching/
; http://www.iquilezles.org/www/articles/rmshadows/rmshadows.htm/
  (define (next-pixel x y) (print (list x y))
    (define uv (vec/ (list x y) (list (screen_width) (screen_height))))
    (define rd (vec-normalize (list (* (aspect_ratio) (- (* (car uv) 2.0) 1.0)) (- (* (cadr uv) 2.0) 1.0) -1.0)))
    (define fragColor (vec-clamp-0-1 (rayMarch VPos rd uv 0.1 0)))
    (pixel (+ x 100) (+ y 100) (rgb (car fragColor) (cadr fragColor) (caddr fragColor)))
    (cond ((and (eq? y (screen_height)) (eq? x (screen_width))))
      ((eq? x (screen_width)) (next-pixel 0 (+ y 1)))
      (else (next-pixel (+ x 1) y))))
  (next-pixel 0 0)
  (exitonclick))

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