glome-hs-0.4.1: Trace.hs

module Trace where
import Vec
import Clr
import Solid
import Data.List
import Control.Concurrent.MVar
import System.IO.Unsafe

{-
  We put lighting code in this file because it needs to be 
  mutually recursive with the trace function, for refraction
  and reflection.
 -}

{-
simple_shade :: Rayint -> [Light] -> Solid -> Color -> Color
simple_shade ri lights s bg =
 case ri of
  (RayHit d p n t) ->
   let (Material clr refl refr ior kd shine) = t ri
   in cscale clr (vdot n (Vec 0.0 1.0 0.0))
  (RayMiss) -> bg
-}

debug_norm_shade :: Rayint -> Ray -> Scene -> Int -> Int -> Color
debug_norm_shade ri (Ray o indir) scn recurs debug =
 case ri of
  RayHit d p (Vec nx ny nz) t -> (Color (abs $ nx/2) (abs $ ny/2) (abs $ nz/2))
  RayMiss -> bground scn

-- handles diffuse light, shadows, and reflection
-- todo: specular highlights, refraction
shade :: Rayint -> Ray -> Scene -> Int -> Int -> Color
shade ri (Ray o indir) scn recurs !debug = 
 case ri of
  (RayHit d p n t) ->
   let (Material clr refl refr ior kd shine) = t ri
       s    = sld scn
       lits = lights scn
       direct = foldl' cadd c_black 
                 (map (\ (Light lp lc) ->
                   let eyedir = vinvert indir
                       lvec = vsub lp p
                       llen = vlen lvec
                       ldir = vscale lvec (1.0/llen)   
                       halfangle = bisect ldir eyedir
                       ldotn  = fmax 0 $ vdot ldir n
                       -- blinn  = fmax 0 ((vdot halfangle n)**(shine*3))
                       blinn = fmax 0 $ ((vdot halfangle n) ** shine) * ldotn
                       blinn_correct = if isNaN blinn then 0 else blinn
                       -- indotn = fmax 0 $ vdot eyedir n
                       intensity = 5.0 / (llen*llen)
                       --intensity = 0.2
                   in
                    --if blinn /= blinn 
                    --then error $ "nan " ++ (show (vdot halfangle n)) ++ " " ++ 
                    --                       (show $ shine*3) ++ " " ++ (show blinn)
                    --else
                     if not $ shadow s (Ray (vscaleadd p n delta) ldir) (llen-(2*delta))
                     then
                       cadd 
                        -- diffuse
                        --c_black
                        (cmul clr $ cscale lc $ ldotn * intensity)
                        -- blinn/torrance-sparrow  highlight (pbrt p 440)
                        (cscale lc $ blinn_correct * intensity)
                        -- c_black
                     else 
                       c_black) lits)
       reflect = 
         if (refl > delta) && (recurs > 0)
         then let outdir = Vec.reflect indir n 
              in cscale (trace scn 
                               (Ray (vscaleadd p outdir delta) outdir) 
                               infinity (recurs-1) ) refl
         else c_black
       refract = 
         if (refr > delta) && (recurs > 0)
         then c_black
         else c_black
       in
         cadd direct $ cadd reflect refract

  (RayMiss) -> bground scn


trace :: Scene -> Ray -> Flt -> Int -> Color

trace scn ray depth recurs =
 let (Scene sld lights cam dtex bgcolor) = scn 
 in shade (rayint_check sld ray depth dtex) ray scn recurs 0
         

{- experiments in MVar usage
trace scn ray depth recurs =
 let (Scene sld lights cam dtex bgcolor) = scn 
 in
 unsafePerformIO $
  do
     debug_start <- (readMVar bihctr)
     let ri = rayint sld ray depth dtex
     debug_end <- (readMVar bihctr)
     let bihhits = debug_end - debug_start
     print bihhits
     return $ shade ri ray scn recurs bihhits
-}