; Copyright (C) 2010 Dave Griffiths : See LICENCE file

; this all needs a good tidy

(include "../scene/light.sc")

(define (make-constant-shader colour)
  (lambda (ray scene object position normal depth)
	 colour))

(define (make-lambert-shader diffuse)
  (lambda (ray scene object position normal depth)
	 (foldl
	   (lambda (l col)
    	 (if (shadow? l object (scene-objects scene) position)
        	 col
			 (let ((lc (light l object (scene-objects scene) position normal)))
        	   (vadd col (vector (* (vr diffuse) (vr lc))
			                     (* (vg diffuse) (vg lc))
							     (* (vb diffuse) (vb lc)))))))
	   (vector 0 0 0)
	   (scene-lights scene))))

(define (blinn light p n v rough)
  (let* ((l (vnorm (vsub (point-light-position light) p)))
		 (h (vnorm (vadd l v))))
	(expt (max 0 (vdot n h)) (/ 1 rough))))

(define (make-blinn-shader diffuse rough)
  (lambda (ray scene object position normal depth)
	 (foldl
	   (lambda (l col)
    	 (if (shadow? l object (scene-objects scene) position)
        	 col
			 (let ((lc (light l object (scene-objects scene) position normal))
			       (v (vnorm (vsub (car ray) (cadr ray)))))
        	   (vadd (vadd (vmul lc (blinn l position normal v rough)) col) (vector (* (vr diffuse) (vr lc))
			                                        (* (vg diffuse) (vg lc))
							                        (* (vb diffuse) (vb lc)))))))
	   (vector 0 0 0)
	   (scene-lights scene))))

(define (make-perfect-mirror-shader diffuse)
  (lambda (ray scene object position normal depth)
    (let ((v (vsub (cadr ray) (car ray))))
  	  (vadd diffuse (trace-scene (list position (vadd position (vreflect v normal))) scene depth)))))

(define (make-mirror-shader diffuse)
  (lambda (ray scene object position normal depth)
     (let ((v (vsub (cadr ray) (car ray))))
	 (foldl
	   (lambda (l col)
    	 (if (shadow? l object (scene-objects scene) position)
        	 col (vadd (vmul col 0.8) (vmul (vector 1 1 1) (blinn l position normal (vmul (vnorm v) -1) 0.03)))))
	   (trace-scene (list (vadd position (vmul normal 0.01)) (vadd position (vreflect v normal))) scene depth)
	   (scene-lights scene)))))
	   
(define (make-reflect-shader diffuse ref rough)
  (lambda (ray scene object position normal depth)
     (vadd 
	 	(let ((v (vsub (cadr ray) (car ray))))
	 	  (vmul (trace-scene (list (vadd position (vmul normal 0.01)) (vadd position (vreflect v normal))) scene depth) ref))
	   (vmul 
	     (foldl
	       (lambda (l col)
    	     (if (shadow? l object (scene-objects scene) position)
        	     col
			     (let ((lc (light l object (scene-objects scene) position normal))
			           (v (vnorm (vsub (car ray) (cadr ray)))))
        	       (vadd col (vadd (vadd (vmul lc (blinn l position normal v rough)) col) (vector (* (vr diffuse) (vr lc))
			                                            (* (vg diffuse) (vg lc))
					    		                          (* (vb diffuse) (vb lc))))))))
	       (vector 0 0 0)
	       (scene-lights scene)) (- 1 ref)))))