;; Scheme Recursive Art Contest Entry
;;
;; Please do not include your name or personal info in this file.
;;
;; Title: fiat lux 
;;
;; Description:
;;    Light rays aimlessly 
;;    bouncing everywhere just like  
;;    61A kids 


; RANDOM NUMBER GENERATOR IMPLEMENTATION
; --------------------------------------

(define (random-generator seed)
  (define (rng)
    (set! seed (modulo (+ (* 16807 seed) 0) 2147483647))
    (/ seed 2147483647)
  )
  rng
)

(define random
  (random-generator 61616161) ; Seed the random number generator
)

; --------------------------------------

; VECTOR ABSTRACTION
; --------------------------------------


(define (vec3 x y z)
  (list x y z)
)

(define (vec-x v)
  (car v)
)

(define (vec-y v)
  (car (cdr v))
)

(define (vec-z v)
  (car (cdr (cdr v)))
)

(define (vec-oper v1 v2 op)
 (cond
    ((list? v2) (vec3 
                  (op (vec-x v1) (vec-x v2)) 
                  (op (vec-y v1) (vec-y v2)) 
                  (op (vec-z v1) (vec-z v2))
                ))
    ; v2 is a number, not a vector
    (else (vec3 (op (vec-x v1) v2) (op (vec-y v1) v2) (op (vec-z v1) v2)))
  )
)

; vec-add first operand must be a vector

(define (vec-add v1 v2)
  (vec-oper v1 v2 +)
)

; vec-sub first operand must be a vector

(define (vec-sub v1 v2)
  (vec-oper v1 v2 -)
)

; vec-mul first operand must be a vector

(define (vec-mul v1 v2)
  (vec-oper v1 v2 *)
)

(define (sum-list l total)
  (cond
    ((null? l) total)
    (else (sum-list (cdr l) (+ total (car l))))
  )
)

(define (vec-dot v1 v2)
  (sum-list (vec-mul v1 v2) 0)
)

(define (vec-len v)
  (expt (+ (expt (vec-x v) 2) (expt (vec-y v) 2) (expt (vec-z v) 2)) 0.5)
)

; unit vector

(define (vec-u v)
  (define l (vec-len v))
  (vec3 (/ (vec-x v) l) (/ (vec-y v) l) (/ (vec-z v) l))
)

; --------------------------------------

; RAY ABSTRACTION
; --------------------------------------


(define (ray o d)
  (list o d)
)

(define (ray-o r)
  (car r)
)

(define (ray-d r)
  (car (cdr r))
)

; --------------------------------------

; SPHERE ABSTRACTION
; --------------------------------------

(define (sphere center radius color type)
  (list center radius color type)
)

(define (sph-center s)
  (car s)
)

(define (sph-radius s)
  (car (cdr s))
)

(define (sph-color s)
  (car (cdr (cdr s)))
)

(define (sph-type s)
  (car (cdr (cdr (cdr s))))
)

; Computes ray sphere intersection
; Returns distance to intersection point or -1 if no intersection

(define (intersect s r)
  (define otos (vec-sub (sph-center s) (ray-o r)))
  (define rT (vec-dot otos (ray-d r)))
  (define l (- (expt (sph-radius s) 2) (- (vec-dot otos otos) (* rT rT))))
  (if (< l 0)
    -1
    (begin
     (define res (- rT (expt l 0.5)))
     (if (< res 0)
       (+ rT (expt l 0.5))
       res
     ))))

; Returns a pair of the closest object and the distance to it

(define (intersect-list objects r)
  (if (null? objects)
    (list -1 (expt 2 32)) ; Return -1 object and max distance
    
    ; Compute closest in rest of list
    (begin
     (define closest (intersect-list (cdr objects) r))
     ; Get distance to first object
     (define dist (intersect (car objects) r))
     
     ; If we are closer
     (if (> (car (cdr closest)) dist)
       ; If we get no intersection or too close
       (if (< dist 0.00001)
         closest ; Return closest of rest of list
         (list (car objects) dist) ; Otherwise new closest
       )
       closest
     ))))

; --------------------------------------


; MAIN RAYTRACING LOGIC
; --------------------------------------


(define (schlick cosine ref_idx)
  (define r0 (/ (- 1 ref_idx) (+ 1 ref_idx)))
  (define r0 (* r0 r0))
  (+ (* (- 1 r0) (expt (- 1 cosine) 5))))

; Shoots ray r into the scene of objects

(define (shoot r objects depth color)
  (if (= depth 7) ; if we reach maximum allowed recusion depth
    (vec3 0 0 0)  ; return no light
    (begin
     (define closest (intersect-list objects r))
     (if (equal? (car closest) -1)
       (vec3 0 0 0) ; If no hit return black (background color)
       (begin
        (define impact (vec-add (vec-mul (ray-d r) (car (cdr closest))) (ray-o r)))
        (define normal (vec-u (vec-sub impact (sph-center (car closest)))))
        (define refRay (ray impact (vec-sub (ray-d r) 
                                            (vec-mul normal (* 2 (vec-dot (ray-d r) normal))))))
        (cond
          ((equal? (sph-type (car closest)) 'DIFFUSE)
           (define target (vec-add normal (random-in-unit-sphere)))
           (shoot (ray impact (vec-u target))
                  objects
                  (+ depth 1)
                  (vec-mul color (sph-color (car closest)))))
          ((equal? (sph-type (car closest)) 'MIRROR)
           (shoot refRay objects (+ depth 1) (vec-mul color (sph-color (car closest)))))
          ((equal? (sph-type (car closest)) 'EMITTER)
           (vec-mul color (sph-color (car closest))))
          (else 
            (define ref_idx 1.5)
            (if (> (vec-dot (ray-d r) normal) 0)
              (begin
                (define outward_normal (vec-mul normal -1))
                (define nint ref_idx)
                (define cosine (vec-dot (ray-d r) normal))
                (define cosine (expt (- 1 (* ref_idx ref_idx (- 1 (* cosine cosine)))) 0.5))
               )
              (begin
                (define outward_normal normal)
                (define nint (/ 1 ref_idx))
                (define cosine (* -1 (vec-dot (ray-d r) normal)))
               )
              )
            (define dt (vec-dot (ray-d r) outward_normal))
            (define discr (- 1 (* nint nint (- 1 (* dt dt)))))
            (if (> discr 0)
              (begin
                (define refracted (vec-sub (vec-mul (vec-sub (ray-d r) (vec-mul outward_normal dt))
                                                    nint)
                                           (vec-mul outward_normal (expt discr 0.5))))
                (define reflect_prob (schlick cosine ref_idx)))
              (define reflect_prob 1))
            (if (< (random) reflect_prob)
              (shoot refRay objects (+ 1 depth) (vec-mul color (sph-color (car closest))))
              (shoot (ray impact refracted) objects (+ 1 depth) (vec-mul color (sph-color (car closest)))))
            )
         ))))))

; Generates a random vector in the unit sphere recursively

(define (random-in-unit-sphere)
  (define v (vec-sub (vec-mul (vec3 (random) (random) (random)) 2) 1))
  (if (< (vec-len v) 1.0)
    v
    (random-in-unit-sphere)
  )
)

(define (min a b)
  (if (< a b) a b)
)

(define (color-adj color) ; Color gamma correction and coercion into turtle rgb
  (rgb (expt (min (vec-x color) 1) 0.5) ; Browser takes in from 0 - 255
       (expt (min (vec-y color) 1) 0.5) ; Python interpreter takes 0 - 1
       (expt (min (vec-z color) 1) 0.5)
  )
)

(define (draw)
  (ht) ; Hide turtle if not running in browser
  (seth 180) ; Draw from top down
  (define width 500) ; Output resolution
  (define height 500)

  ; Do sphere initialization here
  (define spheres ())
  (define spheres (cons (sphere (vec3 0 0 10000) 9900 (vec3 0.9 0.9 0.9) 'diffuse) spheres))
  (define spheres (cons (sphere (vec3 0 10000 0) 9900 (vec3 0.9 0.9 0.9) 'diffuse) spheres))
  (define spheres (cons (sphere (vec3 0 -10000 0) 9900 (vec3 0.9 0.9 0.9) 'diffuse) spheres))
  (define spheres (cons (sphere (vec3 10000 0 0) 9885 (vec3 0.984 0.504 0.007) 'diffuse) spheres))
  (define spheres (cons (sphere (vec3 -10000 0 0) 9885 (vec3 0 0.02 0.147) 'diffuse) spheres))
  (define spheres (cons (sphere (vec3 -45 -50 20) 50 (vec3 1 1 1) 'mirror) spheres))
  (define spheres (cons (sphere (vec3 50 -50 -20) 40 (vec3 1 1 1) 'glass) spheres))
  (define spheres (cons (sphere (vec3 -15 -80 -60) 20 (vec3 0.053 0.244 0.398) 'diffuse) spheres))
  (define spheres (cons (sphere (vec3 0 1099.2 -20) 1000 (vec3 10 10 10) 'emitter) spheres))

  ; light position, camera position

  (define cam-pos (vec3 0 0 -440))
  (define fov 60) ; width angle
  (define fov (* fov (/ 3.14159265 180))) ; convert to rad
  (define ratio (/ height width))
  (define xtan 0.577350269) 
  (define ytan (* xtan ratio))

  (define num-samples 500) 
  (define max-pos (- (* width height) 1))

  ; xtan, ytan

  (define (draw-pixel pos) ; pos = total_height*w + h
    (define x (quotient pos height))
    (define y (modulo pos height))
    (define shot-ray (vec3 0 0 0))

    ; sample gives the result of several rays averaged
    (define (sample i vec)
      (cond
        ((= i num-samples) vec)
        (else (define vx (* (/ (+ x -0.5 (random) (* -0.5 width)) width) xtan))
              (define vy (* (/ (- (* 0.5 height) (+ y -0.5 (random))) height) ytan))

              (define v (vec3 vx vy 1))
              (define v (vec-u v))
              (define r (ray cam-pos v))

              (sample (+ i 1) (vec-add vec (shoot r spheres 0 (vec3 1 1 1)))) ; shoot ray
        )
      )
    )
    (define sampled (vec-mul (sample 0 (vec3 0 0 0)) (/ 1 num-samples)))
    (display sampled)

    (color (color-adj sampled)) ; Set pixel color
    (if (= y 0) ; Move turtle accordingly
      (begin
        (pu)
        (goto x 0)
        (pd)
      )
      ()
    )
    (fd 1)

    (if (> (+ 1 pos) max-pos)
        0
        (draw-pixel (+ 1 pos))
    )
  )

  (draw-pixel 0) ; Start drawing pixels from 0, 0
  (exitonclick)
)

; --------------------------------------


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