diff --git a/app/Main.hs b/app/Main.hs index b293751..8f4b2fa 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -35,6 +35,20 @@ scatter (Ray o d) (Hit t p n (Lambertian c)) = do scatter (Ray o d) (Hit t p n (Metal c)) = do let reflected = reflect (unitVector d) n return $ Ray p reflected +scatter (Ray o d) (Hit t p n (Glass c)) = do + let refraction_ratio = if isFrontFace (Ray o d) n then 1.0 / 1.5 else 1.0 + let ud = unitVector d + let ct = min (ud `dotP` (unitVector n)) 1.0 + let st = sqrt (1.0 - ct * ct) + rVal <- rand + + if refraction_ratio * st > 1.0 || reflectance ct refraction_ratio < rVal + then do + let reflected = reflect ud n + return $ Ray p reflected + else 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 ws d r = do @@ -105,8 +119,9 @@ main = do let w = 400 let h = 400 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)) + [ 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 diff --git a/src/Hittable.hs b/src/Hittable.hs index 0cdda9d..298f5e5 100644 --- a/src/Hittable.hs +++ b/src/Hittable.hs @@ -1,4 +1,4 @@ -module Hittable (Shape (..), Circle (..), Hit (..)) where +module Hittable (Shape (..), Circle (..), Hit (..), isFrontFace) where import Linear.V3 import Linear.Vector @@ -18,6 +18,11 @@ getFaceNormal (Ray o d) n | (d `dotP` n) < 0.0 = n | otherwise = (-1.0) *^ n +isFrontFace :: Ray Double -> V3 Double -> Bool +isFrontFace (Ray o d) n + | (d `dotP` n) < 0.0 = True + | otherwise = False + -- t_min 0 t_max infinity... need closest so far instance Shape Circle where testHit (Ray o d) (Circle center r m) = diff --git a/src/Material.hs b/src/Material.hs index fe60257..65043d6 100644 --- a/src/Material.hs +++ b/src/Material.hs @@ -5,8 +5,9 @@ import Linear.Vector import Maths import Ray -data Material = Lambertian (V3 Double) | Metal (V3 Double) +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) diff --git a/src/Maths.hs b/src/Maths.hs index d607ab0..09061e8 100644 --- a/src/Maths.hs +++ b/src/Maths.hs @@ -5,6 +5,8 @@ module Maths randV3, rand, reflect, + refract, + reflectance, ) where @@ -48,3 +50,16 @@ unitVector v = v ^/ vectorLength v reflect :: (Floating f) => V3 f -> V3 f -> V3 f reflect v n = v - (2 * (v `dotP` n)) *^ n + +refract :: (RealFloat f) => V3 f -> V3 f -> f -> V3 f +refract uv n etai_over_etat = perp ^+^ parallel + where + ct = min (uv `dotP` n) 1.0 + perp = etai_over_etat *^ ((-1.0 *^ uv) ^+^ (ct *^ n)) + parallel = -1.0 * sqrt (abs (1.0 - lengthSquared perp)) *^ n + +reflectance :: Double -> Double -> Double +reflectance c r = r00 + (1 - r00) * (1 - c) ^ 5 + where + r0 = (1 - r) / (1 + r) + r00 = r0 * r0