My dissertation this year has been on adding Simon Peyton Jones and Phil Wadlers Comprehensive Comprehensions to the Glasgow Haskell Compiler, and I might blog about that in the future. During this work, I needed to come up with some test cases for the generalized list comprehensions and so inspired by this post by LukeH I decided to implement a ray tracer in Haskell where all the raytracing logic is put within a single comprehension!

It turns out that the resulting program (which is heavily based on LukeH’s version) only needs to use one feature from the generalized comprehensions, but since it’s still pretty neat I thought you might be interested in seeing the (fairly crazy looking) inner loop:

render (Scene { lights, things, camera = Camera { forward, right, up, position } }) = [ row
        | y <- reverse $ (-fOV_HEIGHT, fOV_HEIGHT) `sampledBy` rESOLUTION_Y
        , let row = [ fromMaybe bACKGROUND_COLOR (traceRay ray 0)
                        | x <- (-fOV_WIDTH, fOV_WIDTH) `sampledBy` rESOLUTION_X
                , let lookingAt = norm $ forward #+ (x <* right) #+ (y <* up)
                , let ray = Ray { start = position, direction = lookingAt }
                , let traceRay innerRay depth = maybeHead [ (foldl' (#+) reflectColor naturalColors)
                        | (thing, Just (Intersection { distance, surfacePoint, surfaceNormal }))
                            <- [(thing, intersect thing innerRay) | thing <- things]
                        , then sortWith by distance
                        , let thingSurf = surface thing
                        , let reflectionNormal = norm $ (direction ray) `reflectedIn` surfaceNormal
                        , let naturalColors = [ color
                                | Light { lightPosition, lightColor } <- lights
                                , let lightVector = lightPosition #- surfacePoint
                                , let lightNormal = norm lightVector
                                , let lightDistance = magnitude lightVector
                                , let shadowTestRay = Ray { start = surfacePoint, direction = lightNormal }
                                , let nearestBlockerDistance = [ shadowDistance
                                        | Just (Intersection { distance = shadowDistance }) <-
                                            [intersect otherThing shadowTestRay | otherThing <- things]
                                        , then sortWith by shadowDistance ]
                                        `headOr` infinity
                                , nearestBlockerDistance > lightDistance
                                , let illuminance = lightNormal <.> surfaceNormal
                                , let diffuseColor = (max 0.0 illuminance) <* lightColor
                                , let specularity = lightNormal <.> reflectionNormal
                                , let specularColor = ((max 0.0 specularity) ^ (roughness thingSurf)) <* lightColor
                                , let color = ((diffuseColorAt thingSurf surfacePoint) #* diffuseColor) #+
                                              ((specularColorAt thingSurf surfacePoint) #* specularColor) ]
                        , let reflectSurfacePoint = surfacePoint #+ (epsilonOf reflectionNormal)
                        , let reflectColor =
                                if depth >= mAX_DEPTH
                                then eRROR_COLOR
                                else case (traceRay (Ray { start = reflectSurfacePoint,
                                    direction = reflectionNormal }) (depth + 1)) of
                                    Just reflectedColor ->
                                        (reflectance thingSurf surfacePoint) <* reflectedColor
                                    Nothing -> bACKGROUND_COLOR ] ] ]

Can you spot the generalized list comprehension feature that I’m using?

Here is the obligatory shot of some raytraced reflective colored spheres that it can produce:

Beautiful raytraced colored spheres

Aww, ain’t that purdy? I’ll post the full code up here if anyone shows any interest, but be warned - it’s not nearly as pretty as the pictures it produces! I might be writing a further post about some of the more interesting techniques I’ve used within in, however..