; example baking an ambient occlusion texture map by
; doing lots of raytracing - watch the texture 
; slowly build up

; as raytracing is really slow and painful to do, it's
; a good idea to do it once and store the results in a 
; texture for use later on. the downside is that it won't 
; update if the model deforms or moves.

; need to include the optional extras

(define (occlusion-texture-bake tex prim samples-per-face rays-per-sample ray-length debug)
    
    (define (make-sample-hemi n count l)
        (cond 
            ((zero? count) l)
            (else
                (make-sample-hemi n (- count 1) 
                    (cons (vmul (hrndhemi n) ray-length) l)))))
    
    (define (sample-rnd-face-point indices b)
        (let 
            ((pos (vadd
                        (vadd (vmul (pdata-ref "p" (list-ref indices 0)) (vx b))
                            (vmul (pdata-ref "p" (list-ref indices 1)) (vy b)))
                        (vmul (pdata-ref "p" (list-ref indices 2)) (vz b))))
                (norm (vadd
                        (vadd (vmul (pdata-ref "n" (list-ref indices 0)) (vx b))
                            (vmul (pdata-ref "n" (list-ref indices 1)) (vy b)))
                        (vmul (pdata-ref "n" (list-ref indices 2)) (vz b)))))
            (if (> (vmag norm) 0)
            (foldl
                (lambda (point r)                     
                    
                    (let ((a (vadd pos (vmul norm 0.01)))
                            (b (vadd pos point)))
                        
                        ; visualise the rays
                        #;(when debug
                            (let ((l (with-state
                                            (concat (with-primitive prim (get-transform)))
                                            (hint-none)
                                            (hint-unlit)
                                            (hint-wire)
                                            (hint-vertcols)
                                            (wire-opacity 0.5)
                                            (build-ribbon 2))))
                                (with-primitive l
                                    (pdata-set! "p" 0 a)
                                    (pdata-set! "p" 1 b)
                                    (pdata-set! "c" 0 (vector 0 0 0))
                                    (pdata-set! "c" 1 (vector 1 1 1)))))
                        
                        (if (not (null? (line-intersect a b)))
                            (* r 0.6)
                            r)))
                1
                (make-sample-hemi norm rays-per-sample '()))
                1)))
    
    (let ((w (with-primitive tex (pixels-width)))
            (h (with-primitive tex (pixels-height))))
        (with-primitive prim
            (texture (pixels->texture tex))
            (poly-for-each-tri-sample
                (lambda (indices bary)
                    (let* ((v (sample-rnd-face-point indices bary))
                            (tc (vadd
                                    (vadd (vmul (pdata-ref "t" (list-ref indices 0)) (vx bary))
                                        (vmul (pdata-ref "t" (list-ref indices 1)) (vy bary)))
                                    (vmul (pdata-ref "t" (list-ref indices 2)) (vz bary))))
                            (tu (inexact->exact (round (* (vector-ref tc 0) w))))
                            (tv (inexact->exact (round (* (vector-ref tc 1) h)))))
                        
                        (printf "sample: ~a ~n" v)
                        
                        (with-primitive tex
                            (when (< v 1)
                                (pdata-set! "c" (+ tu (* tv w)) v))
                            (pixels-upload))))
                samples-per-face))))

(clear)

; make the texture map
(define tex (with-state 
        (translate (vector 1 0 0))
        (build-pixels 256 256)))

; load in a complex model to test
(define s (with-state
        (hint-unlit)
;        (hint-normal)
        (rotate (vector 90 0 0))
        ; apply the pixel prim as texture
        (texture (pixels->texture tex)) 
        (load-primitive "meshes/004.obj")))

(define (run)
    (with-primitive tex
        (pdata-map! (lambda (c) (vector 1 1 1 1)) "c")
        (occlusion-texture-bake tex s 2000 10 0.2 #t)
        
        (display "done...")(newline)
        ; uncomment to save the texture out - give
        ; it some gaussian blur and contrast in the gimp,
        ; and apply it to the model as normal with (hint-unlit)
        (save-primitive "004.occ.png")
        ))

; call the function in a thread, so fluxus stays active,
; and you can watch the raytracing happen
(thread run)