clean up code

app/Main.hs

@@ -4,17 +4,14 @@ import Control.Monad (mapM)
 import Control.Monad.Random
 import Data.Ix
 import Data.Maybe
-import Debug.Trace
 import Hittable
+import IOUtils
 import Linear.V2
 import Linear.V3
 import Linear.Vector
 import Material
 import Maths
 import Ray
-import Text.Printf
-
-type Color = (Double, Double, Double)
 
 type Coord = (Int, Int)
 
@@ -25,9 +22,8 @@ type ViewPortDimensions = (Double, Double)
 -- TODO
 -- antialiasing
 
-backgroundColor = V3 0.0 0.0 0.0
-
-scatter :: (RandomGen g) => Ray Double -> Hit -> Rand g (Ray Double)
+-- scatter rays based on the material of the object that was hit
+scatter :: (RandomGen g) => Ray -> Hit -> Rand g (Ray)
 scatter (Ray o d) (Hit t p n (Lambertian c)) = do
   r <- randV3
   let target = p ^+^ colorWithNormal (unitVector n) ^+^ r
@@ -50,13 +46,14 @@ scatter (Ray o d) (Hit t p n (Glass c)) = do
       let refracted = refract ud n refraction_ratio
       return $ Ray p refracted
 
-getRayColor :: (Shape s, RandomGen g) => [s] -> Int -> Ray Double -> Rand g (V3 Double)
+getRayColor :: (Shape s, RandomGen g) => [s] -> Int -> Ray -> Rand g (V3 Double)
 getRayColor ws d r = do
   let h = getBestHit (mapMaybe (testHit r) ws)
   v <- getRayColor' r h ws d
   return v
 
-getRayColor' :: (Shape s, RandomGen g) => Ray Double -> Maybe Hit -> [s] -> Int -> Rand g (V3 Double)
+-- get color of pixel according to the closest hit found
+getRayColor' :: (Shape s, RandomGen g) => Ray -> Maybe Hit -> [s] -> Int -> Rand g (V3 Double)
 getRayColor' (Ray o d) Nothing _ _ = do return $ colorGradient (unitVector d)
 getRayColor' (Ray o d) _ _ 0 = do return $ colorGradient (unitVector d)
 getRayColor' (Ray o d) (Just (Hit t p n m)) ws depth = do
@@ -65,17 +62,19 @@ getRayColor' (Ray o d) (Just (Hit t p n m)) ws depth = do
   nextVal <- getRayColor ws (depth - 1) ray
   return (a * nextVal)
 
+-- used for coloring the background, color based on direction vector
 colorGradient :: V3 Double -> V3 Double
 colorGradient (V3 x y z) = do
   let t = 0.5 * (y + 1.0)
   (1.0 - t) *^ V3 1.0 1.0 1.0 + t *^ V3 0.5 0.7 1.0
 
+-- from a list of possible hits, get the closest possible hit found
+getBestHit :: [Hit] -> Maybe Hit
 getBestHit [] = Nothing
 getBestHit (h : hs) = Just (getBestHit' hs h)
 
 getBestHit' :: [Hit] -> Hit -> Hit
 getBestHit' (h : hs) bestHit =
-  -- always pick closest hit to camera
   if root h < root bestHit
     then getBestHit' hs h
     else getBestHit' hs bestHit
@@ -84,9 +83,12 @@ getBestHit' [] hit = hit
 colorWithNormal :: V3 Double -> V3 Double
 colorWithNormal v = 0.5 *^ (v ^+^ V3 1.0 1.0 1.0)
 
--- rayTrace :: (Shape s) => (Int, Int) -> ImageDimensions -> ViewPortDimensions -> [s] -> IO (V3 Double)
-rayTrace (x, y) (w, h) (vw, vh) world = do
-  l <- replicateM 25 (evalRandIO (getRayColor world 50 $ buildRay (xf * (vw / wf)) (yf * (vh / hf))))
+-- heart of loop, for each x y coordinate pixel, convert it into world space and then run the ray tracing algorithm
+-- run [samples] times in order to increase fidelity
+rayTrace :: (Shape s) => (Int, Int) -> ImageDimensions -> ViewPortDimensions -> [s] -> Int -> IO (V3 Double)
+rayTrace (x, y) (w, h) (vw, vh) world samples = do
+  let maxDepth = 50
+  l <- replicateM samples (evalRandIO (getRayColor world maxDepth $ buildRay (xf * (vw / wf)) (yf * (vh / hf))))
   return $ foldl (^+^) (V3 0.0 0.0 0.0) l
   where
     xf = fromIntegral x
@@ -94,35 +96,23 @@ rayTrace (x, y) (w, h) (vw, vh) world = do
     wf = fromIntegral (w - 1)
     hf = fromIntegral (h - 1)
 
-colorToString :: Color -> IO ()
-colorToString (x, y, z) = tupToString (xr, yr, zr)
-  where
-    -- scale 1
-    scale = 1.0 / 25
-    xr = truncate ((clamp (sqrt (x * scale)) 0.0 0.999) * 256.0)
-    yr = truncate ((clamp (sqrt (y * scale)) 0.0 0.999) * 256.0)
-    zr = truncate ((clamp (sqrt (z * scale)) 0.0 0.999) * 256.0)
-
-tupToString :: (Show a) => (a, a, a) -> IO ()
-tupToString (x, y, z) = putStrLn (show x ++ " " ++ show y ++ " " ++ show z)
-
-v3ToColor :: V3 Double -> Color
-v3ToColor (V3 x y z) = (x, y, z)
-
 main :: IO ()
 main = do
   let w = 400
   let h = 400
+  let samples = 25
   let world =
         [ Circle (V3 (0.0) 0.0 (-1.0)) 0.25 (Glass (V3 1.0 1.0 1.0)),
           Circle (V3 (-0.5) 0.0 (-1.0)) 0.25 (Lambertian (V3 0.7 0.1 0.1)),
           Circle (V3 0.0 (-10.25) (-1.0)) 10 (Lambertian (V3 0.7 0.6 0.5))
         ]
   let coords = reverse $ range ((-1 * (w `div` 2), -1 * (h `div` 2)), ((w `div` 2) - 1, (h `div` 2) - 1)) -- "canvas"
-  colors <- mapM (\x -> rayTrace x (w, h) (1.0, 1.0) world) coords
+  colors <- mapM (\x -> rayTrace x (w, h) (1.0, 1.0) world samples) coords
   let convertedColors = map v3ToColor colors
+  -- print ppm header
   putStrLn "P3"
   putStrLn (show w ++ " " ++ show h)
   putStrLn "255"
-  mapM_ colorToString convertedColors
+  -- print each color converted to ppm format string
+  mapM_ (colorToString samples) convertedColors
   mapM_ print convertedColors

src/Hittable.hs

@@ -7,18 +7,18 @@ import Maths
 import Ray
 
 class Shape s where
-  testHit :: Ray Double -> s -> Maybe Hit
+  testHit :: Ray -> s -> Maybe Hit
 
-data Circle = Circle (V3 Double) Double Material
+data Circle = Circle {center :: V3 Double, radius :: Double, material :: Material}
 
 data Hit = Hit {root :: Double, p :: V3 Double, n :: V3 Double, m :: Material}
 
-getFaceNormal :: Ray Double -> V3 Double -> V3 Double
+getFaceNormal :: Ray -> V3 Double -> V3 Double
 getFaceNormal (Ray o d) n
   | (d `dotP` n) < 0.0 = n
   | otherwise = (-1.0) *^ n
 
-isFrontFace :: Ray Double -> V3 Double -> Bool
+isFrontFace :: Ray -> V3 Double -> Bool
 isFrontFace (Ray o d) n
   | (d `dotP` n) < 0.0 = True
   | otherwise = False

src/IOUtils.hs

@@ -0,0 +1,22 @@
+module IOUtils (Color, colorToString, tupToString, v3ToColor) where
+
+import Linear.V3
+import Maths
+
+type Color = (Double, Double, Double)
+
+-- convert color to string, make sure each value is between 0 and 256
+colorToString :: Int -> Color -> IO ()
+colorToString samples (x, y, z) = tupToString (xr, yr, zr)
+  where
+    samplesD = fromIntegral samples
+    scale = 1.0 / samplesD
+    xr = truncate $ (clamp (sqrt (x * scale)) 0.0 0.999) * 256.0
+    yr = truncate $ (clamp (sqrt (y * scale)) 0.0 0.999) * 256.0
+    zr = truncate $ (clamp (sqrt (z * scale)) 0.0 0.999) * 256.0
+
+tupToString :: (Show a) => (a, a, a) -> IO ()
+tupToString (x, y, z) = putStrLn (show x ++ " " ++ show y ++ " " ++ show z)
+
+v3ToColor :: V3 Double -> Color
+v3ToColor (V3 x y z) = (x, y, z)

src/Material.hs

@@ -2,12 +2,9 @@ module Material (Material (..), attenuation) where
 
 import Linear.V3
 import Linear.Vector
-import Maths
-import Ray
 
 data Material = Lambertian (V3 Double) | Metal (V3 Double) | Glass (V3 Double)
 
--- attenuation :: (Material m) => m -> V3 Double
 attenuation (Lambertian c) = c
 attenuation (Metal c) = c
-attenuation (Glass c) = (V3 1.0 1.0 1.0)
+attenuation (Glass c) = V3 1.0 1.0 1.0

src/Maths.hs

@@ -12,8 +12,6 @@ module Maths
 where
 
 import Control.Monad.Random
-import Control.Monad.State (State, evalState, get, put)
-import Debug.Trace
 import Linear.V3
 import Linear.Vector
 import System.Random
@@ -34,25 +32,25 @@ randV3 = do
 
 --inf = read "Infinity"
 
-degToRadians :: (Floating a) => a -> a
+degToRadians :: Double -> Double
 degToRadians d = (d * pi) / 180.0
 
-dotP :: (Num a) => V3 a -> V3 a -> a
+dotP :: V3 Double -> V3 Double -> Double
 dotP (V3 a b c) (V3 d e f) = a * d + b * e + c * f
 
-lengthSquared :: (Num a) => V3 a -> a
+lengthSquared :: V3 Double -> Double
 lengthSquared (V3 x y z) = x ^ 2 + y ^ 2 + z ^ 2
 
-vectorLength :: (Floating f) => V3 f -> f
+vectorLength :: V3 Double -> Double
 vectorLength v = sqrt (lengthSquared v)
 
-unitVector :: (Floating f) => V3 f -> V3 f
+unitVector :: V3 Double -> V3 Double
 unitVector v = v ^/ vectorLength v
 
-reflect :: (Floating f) => V3 f -> V3 f -> V3 f
+reflect :: V3 Double -> V3 Double -> V3 Double
 reflect v n = v - (2 * (v `dotP` n)) *^ n
 
-refract :: (RealFloat f) => V3 f -> V3 f -> f -> V3 f
+refract :: V3 Double -> V3 Double -> Double -> V3 Double
 refract uv n etai_over_etat = perp ^+^ parallel
   where
     ct = min (uv `dotP` n) 1.0

src/Ray.hs

@@ -11,15 +11,15 @@ import Linear.V3
 import Linear.Vector
 import Maths
 
-data Ray f = Ray (V3 f) (V3 f)
+data Ray = Ray {origin :: V3 Double, direction :: V3 Double}
 
 -- P(t) = A + tB; A is origin, B is direction
-rayAt :: (Floating f) => Ray f -> f -> V3 f
+rayAt :: Ray -> Double -> V3 Double
 rayAt (Ray origin dir) t = origin + (t *^ dir)
 
 -- get the normal of the point at t
-calculateRayNormal :: (Floating f) => Ray f -> f -> V3 f
+calculateRayNormal :: Ray -> Double -> V3 Double
 calculateRayNormal r t = unitVector (rayAt r t ^-^ V3 0.0 0.0 1.0)
 
-buildRay :: (Floating f) => f -> f -> Ray f
+buildRay :: Double -> Double -> Ray
 buildRay u v = Ray (V3 0.0 0.0 0.0) (V3 v u (-1.0))