First render

app/Main.hs

@@ -22,41 +22,41 @@ type ImageDimensions = (Int, Int)
 type ViewPortDimensions = (Double, Double)
 
 -- TODO
--- add multiple samples per pixel
+-- DONE add multiple samples per pixel
 -- fix coordinate system
 -- DONE fix random number generator
 
 backgroundColor = V3 0.0 0.0 0.0
 
--- getRayColor :: (Shape s, RandomGen g) => [s] -> Int -> Ray Double -> Rand g (V3 Double)
+getRayColor :: (Shape s, RandomGen g) => [s] -> Int -> Ray Double -> Rand g (V3 Double)
--- need to accumulate somewhere
 getRayColor ws d r = do
   let h = getBestHit (mapMaybe (testHit r) ws)
   v <- getRayColor' r h ws d
-  return $ v
+  return v
 
 getRayColor' :: (Shape s, RandomGen g) => Ray Double -> Maybe Hit -> [s] -> Int -> Rand g (V3 Double)
 getRayColor' (Ray o d) Nothing _ _ = do return $ colorGradient (unitVector d)
-getRayColor' _ _ _ 0 = do return $ backgroundColor
+getRayColor' (Ray o d) _ _ 0 = do return $ colorGradient (unitVector d)
 getRayColor' (Ray o d) (Just (Hit t p n)) ws depth =
   do
     r <- randV3
-    let target = p ^+^ n ^+^ r
+    let target = p ^+^ colorWithNormal (unitVector n) ^+^ r
-    nextVal <- (getRayColor ws (depth - 1) (Ray p (target ^-^ p)))
+    nextVal <- getRayColor ws (depth - 1) (Ray p (target ^-^ p))
-    return $ colorWithNormal (calculateRayNormal (Ray o d) t) ^+^ (0.5 *^ nextVal)
+    return (0.5 *^ nextVal)
 
 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
 
-getBestHit :: [Hit] -> Maybe Hit
+-- testHit needs to take into account other hits, not here
 getBestHit [] = Nothing
 getBestHit (h : hs) = Just (getBestHit' hs h)
 
 getBestHit' :: [Hit] -> Hit -> Hit
 getBestHit' (h : hs) bestHit =
-  if root h > root bestHit
+  -- always pick closest hit to camera
+  if root h < root bestHit
     then getBestHit' hs h
     else getBestHit' hs bestHit
 getBestHit' [] hit = hit
@@ -64,21 +64,29 @@ getBestHit' [] hit = hit
 colorWithNormal :: V3 Double -> V3 Double
 colorWithNormal v = 0.5 *^ (v ^+^ V3 1.0 1.0 1.0)
 
-rayTrace :: (Shape s, RandomGen g) => (Int, Int) -> ImageDimensions -> ViewPortDimensions -> [s] -> Rand g (V3 Double)
+rayTrace :: (Shape s) => (Int, Int) -> ImageDimensions -> ViewPortDimensions -> [s] -> IO (V3 Double)
 rayTrace (x, y) (w, h) (vw, vh) world = do
-  getRayColor world 50 (buildRay (xf * (vw / wf)) (yf * (vh / hf)))
+  evalRandIO (getRayColor world 50 $ buildRay (xf * (vw / wf)) (yf * (vh / hf)))
   where
     xf = fromIntegral x
     yf = fromIntegral y
     wf = fromIntegral (w - 1)
     hf = fromIntegral (h - 1)
 
+clamp :: Double -> Double -> Double -> Double
+clamp x mi ma
+  | x < mi = mi
+  | x > ma = ma
+  | otherwise = x
+
 colorToString :: Color -> IO ()
 colorToString (x, y, z) = tupToString (xr, yr, zr)
   where
-    xr = round (x * 255.0)
+    -- scale 1
-    yr = round (y * 255.0)
+    scale = 1.0
-    zr = round (z * 255.0)
+    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)
@@ -91,14 +99,13 @@ main = do
   let w = 400
   let h = 400
   -- weirdly, the bottom circle appears on top and bottom
-  let world = [Circle (V3 0.0 0.0 1.0) 0.25, Circle (V3 0.0 (-10.05) 1.0) 10]
+  -- Circle (V3 0.0 (-10.05) 1.0) 5]
-  let coords = range ((-1 * (w `div` 2), -1 * (h `div` 2)), ((w `div` 2) - 1, (h `div` 2) - 1)) -- "canvas"
+  let world = [Circle (V3 0.0 0.0 (-1.0)) 0.25, Circle (V3 0.0 (-10.25) (-1.0)) 10]
-  --let aspect = 16.0 / 9.0
+  let coords = reverse $ range ((-1 * (w `div` 2), -1 * (h `div` 2)), ((w `div` 2) - 1, (h `div` 2) - 1)) -- "canvas"
-  g <- getStdGen
+  colors <- mapM (\x -> rayTrace x (w, h) (1.0, 1.0) world) coords
-  let colors = map (\x -> foldl (^+^) (V3 0.0 0.0 0.0) $ replicate 50 $ evalRand (rayTrace x (w - 1, h - 1) (1.0, 1.0) world) g) coords
   let convertedColors = map v3ToColor colors
-  --mapM_ print colors
   putStrLn "P3"
   putStrLn (show w ++ " " ++ show h)
   putStrLn "255"
   mapM_ colorToString convertedColors
+  mapM_ print convertedColors

src/Hittable.hs

@@ -5,6 +5,7 @@ import Linear.Vector
 import Maths
 import Ray
 
+-- section 6.4 will be the key here
 class Shape s where
   testHit :: Ray Double -> s -> Maybe Hit
 
@@ -12,18 +13,32 @@ data Circle = Circle (V3 Double) Double
 
 data Hit = Hit {root :: Double, p :: V3 Double, n :: V3 Double}
 
+getFaceNormal :: Ray Double -> V3 Double -> V3 Double
+getFaceNormal (Ray o d) n
+  | (d `dotP` n) < 0.0 = n
+  | otherwise = (-1.0) *^ n
+
+-- t_min 0 t_max infinity... need closest so far
 instance Shape Circle where
   testHit (Ray o d) (Circle center r) =
     if discriminant < 0.0
       then Nothing
-      else Just (Hit root p (p - center ^/ r))
+      else
+        if root > 0.001
+          then Just (Hit root p (getFaceNormal (Ray o d) ((p - center) ^/ r)))
+          else
+            if rootP > 0.001
+              then Just (Hit rootP pp (getFaceNormal (Ray o d) ((pp - center) ^/ r)))
+              else Nothing
     where
       co = o - center
       a = lengthSquared d -- a vector dotted with itself is = lengthSquared
-      b = d `dotP` co
+      b = co `dotP` d
       c = lengthSquared co - r ^ 2
       discriminant = b ^ 2 - a * c
       root = (b * (-1.0) - sqrt discriminant) / a
+      rootP = (b * (-1.0) + sqrt discriminant) / a
       p = rayAt (Ray o d) root
+      pp = rayAt (Ray o d) rootP
 
 -- would make sense to build a Functor for shapes

src/Maths.hs

@@ -22,7 +22,9 @@ randV3 = do
   x <- rand
   y <- rand
   z <- rand
-  return $ V3 x y z
+  if vectorLength (V3 x y z) >= 1.0
+    then randV3
+    else return $ unitVector (V3 x y z)
 
 --  _ -> randV3
 

src/Ray.hs

@@ -6,6 +6,7 @@ module Ray
   )
 where
 
+import Control.Monad.Random
 import Linear.V3
 import Linear.Vector
 import Maths
@@ -21,4 +22,4 @@ calculateRayNormal :: (Floating f) => Ray f -> f -> V3 f
 calculateRayNormal r t = unitVector (rayAt r t ^-^ V3 0.0 0.0 1.0)
 
 buildRay :: (Floating f) => f -> f -> Ray f
-buildRay u v = Ray (V3 0.0 0.0 0.0) (V3 v u 1.0)
+buildRay u v = Ray (V3 0.0 0.0 0.0) (V3 v u (-1.0))