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.


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)
    clamp x
      | x < 0.0   = 0.0
      | x > 1.0   = 1.0
      | otherwise = x


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
    diffuseLight (PointLightSource !lightPosition !lightColor)
        | diffuseFactor > 0 = lightColor `colored` col `scaled` diffuseFactor
        | otherwise         = black
        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.


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
    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.

Published: Sunday, July 19, 2015

You may be interested in... is a participant in the Amazon Services LLC Associates Program, an affiliate advertising program designed to provide a means for sites to earn advertising fees by advertising and linking to I may earn a small commission for my endorsement, recommendation, testimonial, and/or link to any products or services from this website.

Comments? Questions?