packages feed

jort-1.0.0: Lights.hs



module Lights(lighten) where

import Basics
import Vectors
import Data.List(minimumBy)
import Objects
import World
import Colors

lighten world material pos normal light = 
    if doesLighten world normal pos light
       then lighten' world material pos normal light
       else blackColor

lighten' world Material{diffuse=diffuse}
       pos normal light@(DotLight lightPos lightColor) = result
    where dist2 = sqnorm (lightPos - pos)
	  coef = (lightPos - pos) `dotProd` normal / dist2 * 10
	  result = abs coef `weight` (diffuse * lightColor)

lighten' world Material{diffuse=diffuse} pos normal light@(DirLight lightDir lightColor) = result
    where coef = lightDir `dotProd` normal
	  result = abs coef `weight` (diffuse * lightColor)

	 
lighten' _ Material{diffuse=diffuse} pos normal (AmbientLight color) = color * diffuse

doesLighten world normal pos light@(DotLight lightPos lightColor) = 
    all notHiding $ map (distance lightPos (normalized (pos-lightPos))) $ worldObjects world 
    where notHiding x = x > norm (pos-lightPos) - eps

doesLighten world normal pos (AmbientLight _) = True
doesLighten world normal pos (DirLight dir _) = 
    (rayDir `dotProd` normal) > 0 -- otherwise the surface is oriented to the light
     &&
    (all (== infinite) $ map (distance (pos + 0.1 `scale` rayDir) rayDir) $ worldObjects world)
    where rayDir = negate dir