(define-structure point x y z)

(define-structure scene c r scenes)

(define-structure hit l n)

(define fail #f)

(define infinity (/ 1.0 0.0))

(define delta (sqrt 1e-15))

(define (fold f i l)
 (let loop ((result i) (l l))
  (if (null? l) result (loop (f (car l) result) (cdr l)))))

(define (s*v s b)
 (make-point (* s (point-x b)) (* s (point-y b)) (* s (point-z b))))

(define (v+v a b)
 (make-point (+ (point-x a) (point-x b))
	     (+ (point-y a) (point-y b))
	     (+ (point-z a) (point-z b))))

(define (v-v a b)
 (make-point (- (point-x a) (point-x b))
	     (- (point-y a) (point-y b))
	     (- (point-z a) (point-z b))))

(define (dot a b)
 (+ (* (point-x a) (point-x b))
    (* (point-y a) (point-y b))
    (* (point-z a) (point-z b))))

(define (magnitude r) (sqrt (dot r r)))

(define (unitise r) (s*v (/ 1.0 (magnitude r)) r))

(define (ray-sphere orig dir center radius)
 (let* ((v (v-v center orig))
	(b (dot v dir))
	(disc (+ (- (* b b) (dot v v)) (* radius radius))))
  (if (negative? disc)
      infinity
      (let* ((disc (sqrt disc)) (t2 (+ b disc)))
       (if (negative? t2)
	   infinity
	   (let ((t1 (- b disc))) (if (positive? t1) t1 t2)))))))

(define zero (make-point 0.0 0.0 0.0))

(define (intersect orig dir scene)
 (let aux ((scene scene) (hit (make-hit infinity zero)))
  (let ((l (hit-l hit)))
   (if (null? (scene-scenes scene))
       (let ((l-prime (ray-sphere orig dir (scene-c scene) (scene-r scene))))
	(if (>= l-prime l)
	    hit
	    (make-hit
	     l-prime
	     (unitise (v+v orig (v-v (s*v l-prime dir) (scene-c scene)))))))
       (if (>= (ray-sphere orig dir (scene-c scene) (scene-r scene)) l)
	   hit
	   (fold aux hit (scene-scenes scene)))))))

(define neg-light (unitise (make-point 1.0 3.0 -2.0)))

(define (ray-trace orig dir scene)
 (let* ((hit (intersect orig dir scene)) (lam (hit-l hit)) (n (hit-n hit)))
  (if (>= lam infinity)
      0.0
      (let ((g (dot n neg-light)))
       (if (and (positive? g)
		(>= (hit-l (intersect
			    (v+v orig (v+v (s*v lam dir) (s*v delta n)))
			    neg-light
			    scene))
		    infinity))
	   g
	   0.0)))))

(define (create level r c)
 (let ((obj (make-scene c r '())))
  (if (= level 1)
      obj
      (let* ((r-prime (* 3.0 (/ r (sqrt 12.0))))
	     (aux (lambda (x-prime z-prime)
		   (create (- level 1)
			   (* 0.5 r)
			   (v+v c (make-point x-prime r-prime z-prime)))))
	     (objs (list obj
			 (aux (- r-prime) (- r-prime))
			 (aux r-prime (- r-prime))
			 (aux (- r-prime) r-prime)
			 (aux r-prime r-prime))))
       (make-scene c (* 3.0 r) objs)))))

(define level
 (if (= (vector-length argv) 3)
     (inexact->exact (truncate (string->number (vector-ref argv 1))))
     9))

(define n
 (if (= (vector-length argv) 3)
     (inexact->exact (truncate (string->number (vector-ref argv 2))))
     512))

(define ss 4)

(define scene (create level 1.0 (make-point 0.0 -1.0 0.0)))

(define (aux x d) (+ (- x (/ n 2.0)) (/ d ss)))

(define orig (make-point 0.0 0.0 -4.0))

(define (g x y)
 (do ((dx  0   (+ dx 1))
      (sum 0.0 (do ((dy	 0   (+ dy 1))
		    (sum sum (+ sum
				(ray-trace orig
					   (unitise
					    (make-point (aux x dx)
							(aux (- (- n 1) y) dy)
							(exact->inexact n)))
					   scene))))
		 ((>= dy ss) sum))))
   ((>= dx ss) sum)))

(define (pixel x y)
 (write-char
  (integer->char
   (inexact->exact (truncate (+ 0.5 (* 255 (/ (g x y) (* ss ss)))))))))

(define (go)
 (display "P5")
 (newline)
 (display n)
 (display " ")
 (display n)
 (newline)
 (display 255)
 (newline)
 (do ((y 0 (+ y 1))) ((>= y n)) (do ((x 0 (+ x 1))) ((>= x n)) (pixel x y))))

(go)