Rendering in Haskell, Part 3: Diffuse Lighting

Diffuse lighting In the previous post, I showed flat shading - not because it’s realistic, but purely to show that the perspective transforms and intersection tests were working. I now need to bring lighting into play.

Light

I need to distinguish between color, which represents the color of a pixel on screen, and light, which represents light as it travels around the scene. Each RGB component of a color may range between 0 and 1 (since a screen pixel has a maximum brightness), but the values for light may be arbitrarily large.

Light is simply defined as three values:

data Light = Light !Double !Double !Double

Light may be added to other light, or scaled:

plus :: Light -> Light -> Light
plus (Light !r1 !g1 !b1) (Light !r2 !g2 !b2) =
    Light (r1 + r2)
          (g1 + g2)
          (b1 + b2)

sumLights :: [Light] -> Light
sumLights =
    foldl' plus black

scaled :: Light -> Double -> Light
scaled (Light !r1 !g1 !b1) !s =
    Light (r1 * s) (g1 * s) (b1 * s)

It can also be scaled separately in each of the RGB components, and for convenience I do this via a Color:

colored :: Light -> Color -> Light
colored (Light !r1 !g1 !b1) (Color !r2 !g2 !b2) =
    Light (r1 * r2) (g1 * g2) (b1 * b2)

Finally, light can be converted to a color simply by clamping off the value. (As you might guess, light normally needs to be suitably scaled before this happens).

toColor :: Light -> Color
toColor (Light !r !g !b) =
    Color (clamp r) (clamp g) (clamp b)
  where
    clamp x
      | x < 0.0   = 0.0
      | x > 1.0   = 1.0
      | otherwise = x

Materials

Instead of defining each Surface in the Scene as having a (flat) Color, I now give each Surface a Material instead. Also, since surface lighting is strongly dependent on the surface’s normal, I include a function for calculating that as well:

data Surface = Surface
    { intersection  :: Ray   -> Maybe RayPosition
    , normalAtPoint :: Point -> UnitVector
    , material      :: Material
    }

The Material itself is simply a synonym for a function:

type Material = [PointLightSource] -> Ray -> Point -> UnitVector -> Light

In other words, a Material takes…

  • a set of light sources;
  • a ray from the camera to the material;
  • a point at which the surface was intersected;
  • and a surface normal.

From this information, an output Light value is computed.

For simplicity here, I’ve only defined two materials: a flat-shaded material (for rendering the surface representing the light source), and a diffuse material (used everywhere else):

flatMaterial :: Color -> [PointLightSource] -> Ray -> Point -> UnitVector -> Light
flatMaterial !col _ _ _ _ =
    colorToLight col

diffuseMaterial :: Color -> Double -> [PointLightSource] -> Ray -> Point -> UnitVector -> Light
diffuseMaterial !col !factor !lights _ intersectionPosition surfaceNormal =
    sumLights $ map diffuseLight lights
  where
    diffuseLight (PointLightSource !lightPosition !lightColor)
        | diffuseFactor > 0 = lightColor `colored` col `scaled` diffuseFactor
        | otherwise         = black
      where
        lightVector      = intersectionPosition `to` lightPosition
        lightDistance    = magnitude lightVector
        lightRay         = normalize lightVector
        lightAttenuation = 1.0 / lightDistance
        diffuseFactor    = factor * (surfaceNormal |.| lightRay) * lightAttenuation

Core Maths

At this point I started to get confused between vectors that represented arbitrary movements within the scene, and with vectors that needed to be normalized (unit length) for calculations to be correct.

Logical errors of this kind can be flushed out with a good type system, so I split Vector into two parts: UnitVector and NonUnitVector. (Vector became private, usable only by the Core module).

newtype NonUnitVector = NonUnitVector Vector

newtype UnitVector = UnitVector Vector

Next, I defined (as typeclasses), the unary and binary operations that can be performed on vectors of all kinds:

class VectorUnaryOps v where
    neg          :: v -> v
    vectorValues :: v -> (Double, Double, Double)
    (|*|)        :: v -> Double -> NonUnitVector

class VectorBinaryOps v1 v2 where
    (|.|) :: v1 -> v2 -> Double
    (|+|) :: v1 -> v2 -> NonUnitVector
    cross :: v1 -> v2 -> NonUnitVector

Note the return types: most vector operations produce a non-normalized vector. Some functions of course, specifically produce a normalized one:

normalize :: NonUnitVector -> UnitVector
...

With the typeclasses in place, I then create instances for each combination of UnitVector and NonUnitVector:

instance VectorUnaryOps NonUnitVector ...
instance VectorUnaryOps UnitVector ...
instance VectorBinaryOps NonUnitVector NonUnitVector ...
instance VectorBinaryOps NonUnitVector UnitVector ...
instance VectorBinaryOps UnitVector UnitVector ...

(There don’t seem to be any usages of the binary operators against a UnitVector and a NonUnitVector in that order, so I’ve skipped that).

There are two advantages to this approach:

  • I can specify, as a type, whether a method specifically requires a normalized vector, and;
  • I can be sure that I won’t write inefficient code that tries to re-normalize already-normalized vectors.

The disadvantage is of course code duplication - the code for the two unary paths, and for the three binary paths, is basically duplicated. I’d be interested to hear if anyone has a better solution here.

Rendering

The above code snippets aren’t the whole story - there were plenty of other refactoring changes needed to adapt the rest of the code. The only remaining significant change was to the rendering function:

renderRay :: Ray -> Scene -> Color
renderRay ray scene =
    toColor $ fromMaybe black maybeColor
  where
    maybeColor = do
        (Intersection rt (Surface _ nrm mat) _ wp) <- sceneIntersection scene ray
        return $ mat (pointLightSources scene) rt wp (nrm wp)

The end result is an image that looks as follows:

Diffuse lighting

Code is in Github, if you want to take a look.

Written on July 19, 2015. Category: Rendering in Haskell