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)
where
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
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
```

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

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

Published: Sunday, July 19, 2015

Hackification.io 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 amazon.com. I may earn a small commission for my endorsement, recommendation, testimonial, and/or link to any products or services from this website.