From 099e77e9a39dde0acf35ab6d0153c8456c5f6e3f Mon Sep 17 00:00:00 2001
From: Rostyslav Hnatyshyn <rostyslav.hnatyshyn@gmail.com>
Date: Tue, 20 Sep 2022 21:15:53 -0700
Subject: [PATCH] added materials

---
 app/Main.hs     | 33 ++++++++++++++++++++-------------
 src/Hittable.hs | 12 ++++++------
 src/Material.hs | 12 ++++++++++++
 src/Maths.hs    |  4 ++++
 4 files changed, 42 insertions(+), 19 deletions(-)
 create mode 100644 src/Material.hs

diff --git a/app/Main.hs b/app/Main.hs
index 27b88bc..b293751 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -9,6 +9,7 @@ import Hittable
 import Linear.V2
 import Linear.V3
 import Linear.Vector
+import Material
 import Maths
 import Ray
 import Text.Printf
@@ -22,12 +23,19 @@ type ImageDimensions = (Int, Int)
 type ViewPortDimensions = (Double, Double)
 
 -- TODO
--- DONE add multiple samples per pixel
--- fix coordinate system
--- DONE fix random number generator
+-- antialiasing
 
 backgroundColor = V3 0.0 0.0 0.0
 
+scatter :: (RandomGen g) => Ray Double -> Hit -> Rand g (Ray Double)
+scatter (Ray o d) (Hit t p n (Lambertian c)) = do
+  r <- randV3
+  let target = p ^+^ colorWithNormal (unitVector n) ^+^ r
+  return $ Ray p (target ^-^ p)
+scatter (Ray o d) (Hit t p n (Metal c)) = do
+  let reflected = reflect (unitVector d) n
+  return $ Ray p reflected
+
 getRayColor :: (Shape s, RandomGen g) => [s] -> Int -> Ray Double -> Rand g (V3 Double)
 getRayColor ws d r = do
   let h = getBestHit (mapMaybe (testHit r) ws)
@@ -37,19 +45,17 @@ getRayColor ws d r = do
 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' (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 ^+^ colorWithNormal (unitVector n) ^+^ r
-    nextVal <- getRayColor ws (depth - 1) (Ray p (target ^-^ p))
-    return (0.5 *^ nextVal)
+getRayColor' (Ray o d) (Just (Hit t p n m)) ws depth = do
+  let a = attenuation m
+  ray <- scatter (Ray o d) (Hit t p n m)
+  nextVal <- getRayColor ws (depth - 1) ray
+  return (a * 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
 
--- testHit needs to take into account other hits, not here
 getBestHit [] = Nothing
 getBestHit (h : hs) = Just (getBestHit' hs h)
 
@@ -98,9 +104,10 @@ main :: IO ()
 main = do
   let w = 400
   let h = 400
-  -- weirdly, the bottom circle appears on top and bottom
-  -- Circle (V3 0.0 (-10.05) 1.0) 5]
-  let world = [Circle (V3 0.0 0.0 (-1.0)) 0.25, Circle (V3 0.0 (-10.25) (-1.0)) 10]
+  let world =
+        [ Circle (V3 0.0 0.0 (-1.0)) 0.25 (Metal (V3 0.8 0.8 0.8)),
+          Circle (V3 0.0 (-10.25) (-1.0)) 10 (Lambertian (V3 0.7 0.3 0.3))
+        ]
   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
   let convertedColors = map v3ToColor colors
diff --git a/src/Hittable.hs b/src/Hittable.hs
index 7bd242b..0cdda9d 100644
--- a/src/Hittable.hs
+++ b/src/Hittable.hs
@@ -2,16 +2,16 @@ module Hittable (Shape (..), Circle (..), Hit (..)) where
 
 import Linear.V3
 import Linear.Vector
+import Material
 import Maths
 import Ray
 
--- section 6.4 will be the key here
 class Shape s where
   testHit :: Ray Double -> s -> Maybe Hit
 
-data Circle = Circle (V3 Double) Double
+data Circle = Circle (V3 Double) Double Material
 
-data Hit = Hit {root :: Double, p :: V3 Double, n :: V3 Double}
+data Hit = Hit {root :: Double, p :: V3 Double, n :: V3 Double, m :: Material}
 
 getFaceNormal :: Ray Double -> V3 Double -> V3 Double
 getFaceNormal (Ray o d) n
@@ -20,15 +20,15 @@ getFaceNormal (Ray o d) n
 
 -- t_min 0 t_max infinity... need closest so far
 instance Shape Circle where
-  testHit (Ray o d) (Circle center r) =
+  testHit (Ray o d) (Circle center r m) =
     if discriminant < 0.0
       then Nothing
       else
         if root > 0.001
-          then Just (Hit root p (getFaceNormal (Ray o d) ((p - center) ^/ r)))
+          then Just (Hit root p (getFaceNormal (Ray o d) ((p - center) ^/ r)) m)
           else
             if rootP > 0.001
-              then Just (Hit rootP pp (getFaceNormal (Ray o d) ((pp - center) ^/ r)))
+              then Just (Hit rootP pp (getFaceNormal (Ray o d) ((pp - center) ^/ r)) m)
               else Nothing
     where
       co = o - center
diff --git a/src/Material.hs b/src/Material.hs
new file mode 100644
index 0000000..fe60257
--- /dev/null
+++ b/src/Material.hs
@@ -0,0 +1,12 @@
+module Material (Material (..), attenuation) where
+
+import Linear.V3
+import Linear.Vector
+import Maths
+import Ray
+
+data Material = Lambertian (V3 Double) | Metal (V3 Double)
+
+-- attenuation :: (Material m) => m -> V3 Double
+attenuation (Lambertian c) = c
+attenuation (Metal c) = c
diff --git a/src/Maths.hs b/src/Maths.hs
index a35139f..d607ab0 100644
--- a/src/Maths.hs
+++ b/src/Maths.hs
@@ -4,6 +4,7 @@ module Maths
     unitVector,
     randV3,
     rand,
+    reflect,
   )
 where
 
@@ -44,3 +45,6 @@ vectorLength v = sqrt (lengthSquared v)
 
 unitVector :: (Floating f) => V3 f -> V3 f
 unitVector v = v ^/ vectorLength v
+
+reflect :: (Floating f) => V3 f -> V3 f -> V3 f
+reflect v n = v - (2 * (v `dotP` n)) *^ n