;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Scheme Recursive Art Contest Entry
;;;
;;; Please do not include your name or personal info in this file.
;;;
;;; Title: Recursive Rhapsody
;;;
;;; Description:
;;;   Ray traced artwork painted with recursions.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; PI
(define pi 3.141592653589793) ; From math.pi in Python

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Helper methods
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Max of two numbers
(define (max a b) (if (>= a b) a b))

; Min of two numbers
(define (min a b) (if (<= a b) a b))

; Function to get item I from a list S
(define (item s i)
  (cond
    ((null? s) nil)
    ((= i 0) (car s))
    (else (item (cdr s) (- i 1)))
  )
)

; Reverse a list S
(define (reverse s)
  (define (reverse-iter s r)
    (if (null? s)
      r
      (reverse-iter
        (cdr s)
        (cons (car s) r)
      )
    )
  )
  (reverse-iter s nil)
)

; Map each procedure FN on a list S
(define (map fn s)
  (define (map-reverse s m)
    (if (null? s)
      m
      (map-reverse
        (cdr s)
        (cons (fn (car s)) m)
      )
    )
  )
  (reverse (map-reverse s nil))
)

; Reduce S using the procedure FN and the START value
(define (reduce fn s start)
  (if (null? s)
    start
    (reduce
      fn
      (cdr s)
      (fn start (car s))
    )
  )
)

; Function to run the procedure FN of N times
(define (repeat start end fn)
  (define (repeat-iter i)
    (if (< i end)
      (begin
        (fn i)
        (repeat-iter (+ i 1))
      )
    )
  )
  (repeat-iter start)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Vector
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Vector abstraction
(define vector list)

; Apply FN element-wise on vectors V1 and V2
(define (vector-apply fn v1 v2)
  (define (apply-reverse s1 s2 m)
    (if (or (null? s1) (null? s2))
      m
      (apply-reverse
        (cdr s1)
        (cdr s2)
        (cons (fn (car s1) (car s2)) m)
      )
    )
  )
  (reverse (apply-reverse v1 v2 nil))
)

; Multiply a vector V by a constant C
(define (vector-multiply-constant v c) (map (lambda (x) (* x c)) v))

; Function to add 2 vectors V1 and V2 together
(define (vector-add v1 v2) (vector-apply + v1 v2))

; Function to subtract vector V2 from V1
(define (vector-subtract v1 v2) (vector-apply - v1 v2))

; Function to multiply two vectors V1 and V2 together element-wise
(define (vector-multiply v1 v2) (vector-apply * v1 v2))

; Function to calculate dot product of 2 vectors V1 and V2, each with unfixed dimensions
(define (vector-dot v1 v2) (reduce + (vector-apply * v1 v2) 0))

; Function to calculate cross product of 2 vectors V1 and V2, each with 3 dimensions
(define (vector-cross3 v1 v2)
  (list
    (- (* (item v1 1) (item v2 2)) (* (item v1 2) (item v2 1)))
    (- (* (item v1 2) (item v2 0)) (* (item v1 0) (item v2 2)))
    (- (* (item v1 0) (item v2 1)) (* (item v1 1) (item v2 0)))
  )
)

; Fuction to calculate the length of the vector V
(define (vector-length v) (sqrt (reduce + (map (lambda (x) (* x x)) v) 0)))

; Function to calculate normalized unit vector from V
(define (vector-normalize v) (vector-multiply-constant v (/ (vector-length v))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Scene
;;;
;;; Usage:
;;;   (scene
;;;     <spheres>           ; List of spheres - list <sphere>
;;;     <point-lights>      ; List of point lights - list <point-light>
;;;     <light-attenuation> ; Global light attenuation - vector(3)
;;;   )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Scene abstraction
(define scene list)

; Get functions
(define (scene-spheres scn) (item scn 0))
(define (scene-point-lights scn) (item scn 1))
(define (scene-light-attenuation scn) (item scn 2))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Color
;;;
;;; Usage:
;;;   (vector-color
;;;     <red>   ; Red - number 0..1
;;;     <green> ; Green - number 0..1
;;;     <blue>  ; Blue - number 0..1
;;;   )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Color abstraction (alias of vector)
(define vector-color vector)

; Get functions
(define (vector-color-red v) (item v 0))
(define (vector-color-green v) (item v 1))
(define (vector-color-blue v) (item v 2))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Point light
;;;
;;; Usage:
;;;   (point-light
;;;     <position> ; Position of point light - vector(3)
;;;     <color>    ; Vector color - vector-color
;;;   )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Point light abstraction
(define point-light list)

; Get functions
(define (point-light-position lt) (item lt 0))
(define (point-light-color lt) (item lt 1))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Camera
;;;
;;; Usage:
;;;   (camera
;;;     <position> ; Position of the camera - vector(3)
;;;     <center>   ; Center to look to from the position - vector(3)
;;;     <up>       ; Up vector - vector(3)
;;;     <fovy>     ; Field of view (vertical) - number
;;;   )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Camera abstraction
(define camera list)

; Get functions
(define (camera-position cam) (item cam 0))
(define (camera-center cam) (item cam 1))
(define (camera-up cam) (item cam 2))
(define (camera-fovy cam) (item cam 3))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Sphere
;;;
;;; Usage:
;;;   (sphere
;;;     <position> ; Position of the sphere - vector(3)
;;;     <radius>   ; Radius of the sphere - number
;;;     <material> ; Material - material
;;;   )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Sphere abstraction
(define sphere list)

; Get functions
(define (sphere-position sph) (item sph 0))
(define (sphere-radius sph) (item sph 1))
(define (sphere-material sph) (item sph 2))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Material
;;;
;;; Usage:
;;;   (material
;;;     <diffuse>   ; Diffuse color - vector-color
;;;     <specular>  ; Specular color - vector-color
;;;     <shininess> ; Shininess of the specular - number
;;;   )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Material abstraction
(define material list)

; Get functions
(define (material-diffuse m) (item m 0))
(define (material-specular m) (item m 1))
(define (material-shininess m) (item m 2))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Ray
;;;
;;; Usage:
;;;   (ray
;;;     <origin>    ; Origin of the ray - vector(3)
;;;     <direction> ; Direction (normalized preferred) of the ray - vector(3)
;;;   )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Ray abstraction
(define ray list)

; Get functions
(define (ray-origin r) (item r 0))
(define (ray-direction r) (item r 1))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Tracer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Function tracing the ray in the scene
; Returns nil if no hits discovered
; Otherwise a pair of distance and sphere
(define (trace-ray scn r)
  ; Find intersecting sphere
  (reduce
    (lambda (d_sph1 d_sph2)
      (cond
        ((and (null? d_sph1) (null? d_sph2)) nil)
        ((null? d_sph2) d_sph1)
        ((null? d_sph1) d_sph2)
        ((<= (car d_sph1) (car d_sph2)) d_sph1) ; Choose closer sphere
        (else d_sph2)
      )
    )
    (map (lambda (sph)
      ; Loop through all spheres
      ; Detect line-sphere intersection
      ; reflectionerence: https://en.wikipedia.org/wiki/Line–sphere_intersection
      (define ray-origin-subtract-sph-position (vector-subtract (ray-origin r) (sphere-position sph)))
      (define a (vector-dot (ray-direction r) (ray-direction r)))
      (define b (* 2 (vector-dot (ray-direction r) ray-origin-subtract-sph-position)))
      (define c (- (vector-dot ray-origin-subtract-sph-position ray-origin-subtract-sph-position) (* (sphere-radius sph) (sphere-radius sph))))
      (define delta (- (* b b) (* 4 a c)))

      (if
        (< delta 0)
        (begin ; Ray missed
          nil
        )
        (begin ; Ray hit the sphere
          (define d1 (/ (+ (- b) (sqrt delta)) (* 2 a)))
          (define d2 (/ (- (- b) (sqrt delta)) (* 2 a)))
          (cond
            ((and (< d1 0) (< d2 0)) (define d d1))
            ((and (>= d1 0) (< d2 0)) (define d d1))
            ((and (< d1 0) (>= d2 0)) (define d d2))
            ((and (>= d1 0) (>= d2 0)) (define d d2))
          )
          (if (> d 0)
            (cons d sph)
            nil
          )
        )
      )

    ) (scene-spheres scn))
    nil
  )
)

; Function getting the color while tracing the ray in the scene
; Returns a vector color
(define (trace-color scn r depth)
  (if (> depth 0)
    (begin
      (define d_sph (trace-ray scn r))
      ; If sphere found
      (if (not (null? d_sph))
        (begin ; Ray intersecting sphere at distance d
          (define d (car d_sph))
          (define sph (cdr d_sph))
          (define sph-material (sphere-material sph))
          (define intersection (vector-add (ray-origin r) (vector-multiply-constant (ray-direction r) d)))
          (define n (vector-normalize (vector-subtract intersection (sphere-position sph)))) ; Surface normal vector
            (define rough-surface-intersection (vector-add
              intersection
              (vector-multiply-constant n 0.0001)))
          (define r-reflection (ray ; reflection ray
            rough-surface-intersection
            (vector-normalize (vector-add
              (ray-direction r)
              (vector-multiply-constant n (* 2 (vector-dot (vector-multiply-constant (ray-direction r) -1) n)))
            ))
          ))
          (reduce
            vector-add
            (list
              (reduce ; Diffusion and specular caused by lights
                vector-add
                (map (lambda (lt)
                  ; Normalized vector pointing to light from the surface intersection
                  (define l (vector-normalize (vector-subtract (point-light-position lt) intersection)))
                  ; Test shadowness
                  (define r-shadow-direction (vector-subtract (point-light-position lt) rough-surface-intersection))
                  (define r-shadow-length (vector-length r-shadow-direction))
                  (define r-shadow (ray
                    rough-surface-intersection
                    (vector-normalize r-shadow-direction)
                  ))
                  (define d_sph (trace-ray scn r-shadow))
                  (if
                    (or
                      (null? d_sph)
                      (> (car d_sph) (vector-length (vector-subtract (point-light-position lt) intersection)))
                    ) ; Not in shadow
                    (vector-multiply-constant
                      (reduce
                        vector-add
                        (list
                          ; Diffusion
                          (vector-multiply-constant (vector-multiply (material-diffuse sph-material) (point-light-color lt)) (max (vector-dot l n) 0))
                          ; Specular
                          (vector-multiply-constant
                            (material-specular sph-material)
                            (max
                              (expt
                                (vector-dot
                                  (vector-normalize (vector-subtract l (ray-direction r)))
                                  n)
                                (material-shininess sph-material))
                              0))
                        )
                        (vector-color 0 0 0))
                      (min 1 (/ (+
                        (item (scene-light-attenuation scn) 0)
                        (* (item (scene-light-attenuation scn) 1) r-shadow-length)
                        (* (item (scene-light-attenuation scn) 2) r-shadow-length r-shadow-length)
                        ))) ; Light attenuation
                    )
                    (vector-color 0 0 0) ; In shadow
                  )
                ) (scene-point-lights scn))
                (vector-color 0 0 0))
              (vector-multiply (material-specular sph-material) (trace-color scn r-reflection (- depth 1)))
            )
            (vector-color 0 0 0))
        ) ; End of (not (null? d_sph))
        (vector-color 0 0 0))
    ) ; End of (> depth 0)
    (vector-color 0 0 0))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Draw
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (draw-scene scn cam depth pixel-size)
  (define pixel-width (quotient (screen_width) pixel-size))
  (define pixel-height (quotient (screen_height) pixel-size))
  (define pixels-total (* pixel-width pixel-height))
  (define aspect-ratio (/ pixel-width pixel-height))
  (define tan-cam-fovy (tan (camera-fovy cam)))
  (print (list 'canvas 'size: pixel-size 'width: pixel-width 'height: pixel-height))

  (print (list 'spheres (scene-spheres scn)))

  (define cam-w (vector-normalize (vector-subtract (camera-position cam) (camera-center cam))))
  (define cam-u (vector-cross3 (vector-normalize (camera-up cam)) cam-w))
  (define cam-v (vector-cross3 cam-w cam-u))
  (print (list 'camera 'u: cam-u 'v: cam-v 'w: cam-w))

  ; Set up canvas
  (speed 0) ; Run with no animation
  (pixelsize pixel-size)
  (ht) ; Hide turtle
  (pd) ; Pen down

  ; Iterate through the canvas
  (repeat 0 pixel-height (lambda (y)
    (repeat 0 pixel-width (lambda (x)
      (define pixels-current (+ (* y pixel-width) x))
      (print (list 'thread 'x: x 'y: y 'pixels: pixels-current '/ pixels-total '= (* 100 (/ pixels-current pixels-total)) '%))
      (thread ; New thread
        (lambda () ; Procedure on new thread
          (define c (trace-color
            scn
            (ray ; Tracing ray
              (camera-position cam) ; Vector origin
              (vector-normalize (vector-add
                (vector-multiply-constant cam-w -1) ; Camera pointed direction
                (vector-add ; x and y offsets
                  (vector-multiply-constant cam-u (* (- (/ (+ x 0.5) pixel-width) 0.5) aspect-ratio tan-cam-fovy))
                  (vector-multiply-constant cam-v (* (- (/ (+ y 0.5) pixel-height) 0.5) tan-cam-fovy))
                )
              )) ; Vector direction
            )
            depth
          ))
          c ; To pass down to the main thread in waterfall
        )
        (lambda (c) ; Procedure on main thread after new thread joins
          (define pixel-color (rgb
            (min (vector-color-red c) 1)
            (min (vector-color-green c) 1)
            (min (vector-color-blue c) 1)))
          (print (list 'pixel 'x: x 'y: y 'color: pixel-color))
          (pixel x y pixel-color)
          c ; To avoid not executing the tail case and returning a Thunk
        )
      )
    ))
    ; Refresh view every line
    (thread-join)
    (st)
    (ht)
  ))
  (thread-join) ; Join all current threads
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Draw
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (draw)
  ; Helper function to generate spheres in the scene
  (define (new-position position radius angle z)
    (vector-add
      position
      (vector-multiply-constant
        (vector
          (cos angle)
          (sin angle)
          z
        )
        radius
      )
    )
  )
  (define generate-sphere (mu (position)
    (sphere
      position
      radius
      (material
        (vector-color ; Diffusion
          (+ 0.5 (* 0.5
            (cos (* 2 (/ pi generate-spheres-depth) (+ generate-spheres-color-wheel-offset depth)))
          ))
          (+ 0.5 (* 0.5
            (cos (* 2 (/ pi generate-spheres-depth) (+ generate-spheres-color-wheel-offset depth (* 1 (/ generate-spheres-depth 3)))))
          ))
          (+ 0.5 (* 0.5
            (cos (* 2 (/ pi generate-spheres-depth) (+ generate-spheres-color-wheel-offset depth (* 2 (/ generate-spheres-depth 3)))))
          ))
        )
        (vector-color 0.6 0.6 0.6) ; Specular
        30 ; Shininess
      )
    )
  ))
  (define (generate-spheres position radius angle-offset depth)
    (define radius-large (* 2.1 radius))
    (if (<= depth 0)
      nil
      (reduce
        append
        (list
          (list
            (generate-sphere position)
            (generate-sphere (new-position position radius-large (* (/ (+ 0 angle-offset) 3) pi) 0))
            (generate-sphere (new-position position radius-large (* (/ (+ 2 angle-offset) 3) pi) 0))
            (generate-sphere (new-position position radius-large (* (/ (+ 4 angle-offset) 3) pi) 0))
          )
          (generate-spheres (new-position position radius-large (* (/ (+ 1 angle-offset) 3) pi) radius) (* radius 0.3) (+ angle-offset 3) (- depth 1))
          (generate-spheres (new-position position radius-large (* (/ (+ 3 angle-offset) 3) pi) radius) (* radius 0.3) (+ angle-offset 3) (- depth 1))
          (generate-spheres (new-position position radius-large (* (/ (+ 5 angle-offset) 3) pi) radius) (* radius 0.3) (+ angle-offset 3) (- depth 1))
        )
        nil
      )
    )
  )
  ; Draw the scene
  (define generate-spheres-depth 3)
  (define generate-spheres-color-wheel-offset 0.7)
  (define generate-spheres-origin (vector 0 0 0))
  (draw-scene
    ; Scene
    (scene
      ; Spheres
      (generate-spheres
        generate-spheres-origin ; Position
        0.28 ; Initial radius
        0 ; Offset: Default to 0 (multiple of 3)
        generate-spheres-depth ; Recursve depth
      )
      ; Point lights
      (list
        (point-light
          (new-position generate-spheres-origin 2.4 (* (/ 0.5 3) pi) 1)
          (vector-color 1 0.3 0.3)
        )
        (point-light
          (new-position generate-spheres-origin 2.4 (* (/ 2.5 3) pi) 1)
          (vector-color 0.3 1 0.3)
        )
        (point-light
          (new-position generate-spheres-origin 2.4 (* (/ 4.5 3) pi) 1)
          (vector-color 0.3 0.3 1)
        )
      )
      ; Global light attenuation
      (vector 1 0.1 0.05)
    )
    ; Camera
    (camera
      (vector 0 0 2)
      (vector 0 0 0)
      (vector 0 1 0)
      (* 3.1415 (/ 4)) ; 45deg
    )
    5 ; Ray tracing recursion depth: 5 for actual render
    1 ; Pixel size: 15 for shape preview, 1 for actual render
  )
  (exitonclick))

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