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