Shader.hs

-- Generic shaders to return colour and texture information
{-# LANGUAGE MagicHash #-}

module Shader where

import Vector
import Colour
import Misc

data Shader = CheckedShader { scale :: {-# UNPACK #-} !Vector, colour1 :: {-# UNPACK #-} !Colour, colour2 :: {-# UNPACK #-} !Colour }
            | ShowNormalShader
            | NullShader deriving (Show, Eq)

-- Functions available for each shader
evaluateAmbient :: Shader -> Position -> TangentSpace -> Colour
evaluateDiffuse :: Shader -> Position -> TangentSpace -> Colour
evaluateSpecular :: Shader -> Position -> TangentSpace -> Colour
shadePoint :: Shader -> (Position, Direction) -> (Colour, Colour, Colour) -> Colour

-- Checked shaders
evaluateDiffuse (CheckedShader checkScale checkColour1 checkColour2) position _ = 
    let scaledPosition = checkScale * position
        scaledX = round (vecX scaledPosition) :: Int
        scaledY = round (vecY scaledPosition) :: Int
        scaledZ = round (vecZ scaledPosition) :: Int
    in if odd scaledX `xor` odd scaledY `xor` odd scaledZ then checkColour1 else checkColour2

-- Normal display
evaluateDiffuse ShowNormalShader _ (_, _, normal) = encodeNormal normal

-- Null shader
evaluateDiffuse NullShader _ _ = colWhite

-- Defaults
evaluateSpecular = evaluateDiffuse
evaluateAmbient = evaluateDiffuse

-- New style shader interface
shadePoint (CheckedShader checkScale checkColour1 checkColour2) (position, _) (ambient, diffuse, specular) = (ambient + diffuse + specular) * checkColour
    where
      scaledPosition = checkScale * position
      scaledX = round (vecX scaledPosition) :: Int
      scaledY = round (vecY scaledPosition) :: Int
      scaledZ = round (vecZ scaledPosition) :: Int
      checkColour = if odd scaledX `xor` odd scaledY `xor` odd scaledZ then checkColour1 else checkColour2

shadePoint ShowNormalShader (_, norm) (_, _, _) = encodeNormal norm

-- Default fallback
shadePoint _ (_, _) (ambient, diffuse, specular) = ambient + diffuse + specular