crocodile-0.1: app/src/Light.hs

-- Module for lights
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}

module Light (applyLight, 
              surfaceEpsilon, 
              Light(PointLight, AmbientLight, QuadLight),
              CommonLightData(CommonLightData), 
              LightingResult,
              position, 
              colour, 
              range, 
              deltaU, 
              deltaV, 
              addToPhotonMap, 
              common) where

import Vector
import Colour
import Ray
import Material
import Shader
import SceneGraph
import Misc
import RayTrace (findAnyIntersection)

data CommonLightData = CommonLightData { colour :: !Colour,
                                         addToPhotonMap :: !Bool } deriving (Show)

data Light = PointLight { common :: CommonLightData, position :: !Position, range :: !Double }
           | AmbientLight { common :: CommonLightData }
           | QuadLight { common :: CommonLightData, position :: !Position, range :: !Double, deltaU :: !Direction, deltaV :: !Direction } deriving (Show)

type LightingResult = (Colour, Colour, Colour) -- Ambient, diffuse, specular

-- Value for the surface epsilon
surfaceEpsilon :: Double
surfaceEpsilon = 0.1

-- Find the attenuation for a light source
lightAttenuation :: Vector -> Vector -> Double -> Double
lightAttenuation !lightPos !shadePos !lightRange =
    let dist = lightPos `Vector.distance` shadePos
    in if dist < lightRange then 1 - dist / lightRange else 0

-- Apply phong lighting to an object
phongLighting :: SurfaceLocation -> Light -> Material -> SceneGraph -> Direction -> Colour
phongLighting (!shadePos, !tanSpace) (PointLight (CommonLightData !lightColour !inPhotonMap') !lightPos !lightRange) objMaterial sceneGraph !viewDirection 
    | (lightPos `distanceSq` shadePos) < (lightRange * lightRange) && dotProd > 0 = case findAnyIntersection sceneGraph (rayWithPoints intersectionPlusEpsilon lightPos) of
                                                                                      Just _ -> colBlack -- An object is closer to our point of consideration than the light, so occluded
                                                                                      Nothing -> (lightColour * lightingSum) Colour.<*> attenuation
                                                                                          where
                                                                                            !lightingSum = diffuseLighting + specularLighting
                                                                                            !attenuation = lightAttenuation lightPos shadePos lightRange
                                                                                            !specularCorrection = (specularPower objMaterial + 2) / (2 * pi)
                                                                                            !specularLighting = specular objMaterial Colour.<*> (specularCorrection * saturate (reflection `dot3` Vector.negate viewDirection) ** specularPower objMaterial)
                                                                                            !reflection = reflect incoming normal
                                                                                            !diffuseLighting = if inPhotonMap'
                                                                                                               then colBlack
                                                                                                               else shaderDiffuse * diffuse objMaterial Colour.<*> saturate dotProd
                                                                                            !shaderDiffuse = evaluateDiffuse (shader objMaterial) shadePos tanSpace
    | otherwise = colBlack
    where 
      !intersectionPlusEpsilon = shadePos + (normal Vector.<*> surfaceEpsilon)
      !incoming = normalise (lightPos - shadePos)
      !dotProd = normal `dot3` incoming
      !normal = thr tanSpace
phongLighting _ (AmbientLight (CommonLightData _ _)) _ _ _ = error "phongLighting: Do not know how to handle AmbientLight"
phongLighting (!shadePos, !tanSpace) (QuadLight (CommonLightData !lightColour !inPhotonMap') !lightPos !lightRange !du !dv) objMaterial sceneGraph !viewDirection 
    | (lightCentre `distanceSq` shadePos) < (lightRange * lightRange) && dotProd > 0 = case findAnyIntersection sceneGraph (rayWithPoints intersectionPlusEpsilon lightCentre) of
                                                                                      Just _ -> colBlack -- An object is closer to our point of consideration than the light, so occluded
                                                                                      Nothing -> (lightColour * lightingSum) Colour.<*> attenuation
                                                                                          where
                                                                                            !lightingSum = diffuseLighting + specularLighting
                                                                                            !attenuation = lightAttenuation lightCentre shadePos lightRange
                                                                                            !specularCorrection = (specularPower objMaterial + 2) / (2 * pi)
                                                                                            !specularLighting = specular objMaterial Colour.<*> (specularCorrection * saturate (reflection `dot3` Vector.negate viewDirection) ** specularPower objMaterial)
                                                                                            !reflection = reflect incoming normal
                                                                                            !diffuseLighting = if inPhotonMap'
                                                                                                               then colBlack
                                                                                                               else shaderDiffuse * diffuse objMaterial Colour.<*> saturate dotProd
                                                                                            !shaderDiffuse = evaluateDiffuse (shader objMaterial) shadePos tanSpace
    | otherwise = colBlack
    where 
      !lightCentre = lightPos + du Vector.<*> 0.5 + dv Vector.<*> 0.5
      !intersectionPlusEpsilon = shadePos + (normal Vector.<*> surfaceEpsilon)
      !incoming = normalise (lightCentre - shadePos)
      !dotProd = normal `dot3` incoming
      !normal = thr tanSpace

-- For a given surface point, work out the lighting, including occlusion
applyLight :: SceneGraph -> SurfaceLocation -> Material -> Direction -> Light -> Colour
applyLight sceneGraph !intersectionPointNormal !objMaterial !viewDirection light@(PointLight (CommonLightData _ _) _ _)
    = phongLighting 
      intersectionPointNormal 
      light
      objMaterial 
      sceneGraph
      viewDirection
applyLight _ (!intersectionPoint, !intersectionTanSpace) !objMaterial _ (AmbientLight (CommonLightData !ambientColour _)) = 
    let shaderAmbient = evaluateAmbient (shader objMaterial) intersectionPoint intersectionTanSpace
        materialAmbient = ambient objMaterial
    in ambientColour * shaderAmbient * materialAmbient
applyLight sceneGraph !intersectionPointNormal !objMaterial !viewDirection light@(QuadLight (CommonLightData _ _) _ _ _ _)
    = phongLighting 
      intersectionPointNormal 
      light
      objMaterial 
      sceneGraph
      viewDirection