diff --git a/app/Main.hs b/app/Main.hs index 12474fc..40c79e1 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -26,14 +26,14 @@ 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 +scatter (Ray o d) (Hit t p n Glass) = do + let refraction_ratio = if isFrontFace (Ray o d) n then 1.0 / 1.5 else 1.5 let ud = unitVector d - let ct = min (ud `dotP` n) 1.0 + let ct = min (negated ud `dotP` n) 1.0 let st = sqrt (1.0 - ct * ct) - rVal <- rand + rVal <- randRange 0 1 - if refraction_ratio * st > 1.0 || reflectance ct refraction_ratio < rVal + if refraction_ratio * st > 1.0 || reflectance ct refraction_ratio > rVal then do let reflected = reflect ud n return $ Ray p reflected @@ -70,7 +70,7 @@ getRayColor' (Ray o d) (Just (Hit t p n m)) ws depth = do 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 + ((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 @@ -93,23 +93,19 @@ rayTrace :: (Shape s) => (Int, Int) -> ImageDimensions -> [s] -> Int -> Camera - rayTrace coord dim world samples camera = do let maxDepth = 50 l <- replicateM samples (evalRandIO (grc coord dim world maxDepth camera)) - return $ foldl (^+^) (V3 0.0 0.0 0.0) l + return $ sumV l main :: IO () main = do let w = 400 let h = 400 - let aspect = 1.0 --16.0 / 9.0 - let viewHeight = 2.0 - let viewWidth = aspect * viewHeight - let focalLength = 1.0 + let aspect = 1.0 -- 16.0 / 9.0 + let camera = makeCamera (V3 0.0 0.0 1.0) (V3 0.0 0.0 (-1.0)) (V3 0.0 1.0 0.0) 90 aspect - let camera = makeCamera (V3 0.0 0.0 0.0) viewWidth viewHeight focalLength - - let samples = 25 + let samples = 500 let world = - [ Circle (V3 0.0 0.0 (-1.0)) 0.5 (Glass (V3 1.0 1.0 1.0)), + [ Circle (V3 0.0 0.0 (-1.0)) 0.5 Glass, Circle (V3 1.0 0.0 (-1.0)) 0.5 (Lambertian (V3 1.0 0.753 0.796)), Circle (V3 0.0 (-100.5) (-1.0)) 100 (Lambertian (V3 0.7 0.6 0.5)) ] diff --git a/src/Camera.hs b/src/Camera.hs index cf5cdfb..aa880d8 100644 --- a/src/Camera.hs +++ b/src/Camera.hs @@ -2,13 +2,24 @@ module Camera (Camera (..), makeCamera) where import Linear.V3 import Linear.Vector +import Maths data Camera = Camera {origin :: V3 Double, lowerLeft :: V3 Double, horizontal :: V3 Double, vertical :: V3 Double} -makeCamera :: V3 Double -> Double -> Double -> Double -> Camera -makeCamera o viewWidth viewHeight focalLength = do - let horizontal = V3 viewWidth 0.0 0.0 - let vertical = V3 0.0 viewHeight 0.0 - let focalVec = V3 0.0 0.0 focalLength - let lowerLeft = o ^-^ (horizontal ^/ 2) ^-^ (vertical ^/ 2) ^-^ focalVec +--lookat :: V3 Double, vup :: V3 Double} + +makeCamera :: V3 Double -> V3 Double -> V3 Double -> Double -> Double -> Camera +makeCamera o lookat vup vfov aspect = do + let t = degToRadians vfov + let h = tan (t / 2) + let vh = 2.0 * h + let vw = aspect * vh + + let w = unitVector (o ^-^ lookat) + let u = unitVector (cross vup w) + let v = cross w u + + let horizontal = vw *^ u + let vertical = vh *^ v + let lowerLeft = o ^-^ (horizontal ^/ 2) ^-^ (vertical ^/ 2) ^-^ w Camera o lowerLeft horizontal vertical diff --git a/src/Hittable.hs b/src/Hittable.hs index f250f7d..53385ed 100644 --- a/src/Hittable.hs +++ b/src/Hittable.hs @@ -15,13 +15,13 @@ data Hit = Hit {root :: Double, p :: V3 Double, n :: V3 Double, m :: Material} getFaceNormal :: Ray -> V3 Double -> V3 Double getFaceNormal (Ray o d) n - | (d `dotP` n) < 0.0 = n - | otherwise = (-1.0) *^ n + | (d `dotP` n) > 0.0 = negated n + | otherwise = n isFrontFace :: Ray -> V3 Double -> Bool isFrontFace (Ray o d) n - | (d `dotP` n) < 0.0 = True - | otherwise = False + | (d `dotP` n) > 0.0 = False + | otherwise = True -- t_min 0 t_max infinity... need closest so far instance Shape Circle where @@ -41,8 +41,9 @@ instance Shape Circle where b = co `dotP` d c = lengthSquared co - r * r discriminant = b * b - a * c - root = (b * (-1.0) - sqrt discriminant) / a - rootP = (b * (-1.0) + sqrt discriminant) / a + sqrtd = sqrt discriminant + root = ((b * (-1.0)) - sqrtd) / a + rootP = ((b * (-1.0)) + sqrtd) / a p = rayAt (Ray o d) root pp = rayAt (Ray o d) rootP diff --git a/src/Material.hs b/src/Material.hs index 4cfc680..b4cf921 100644 --- a/src/Material.hs +++ b/src/Material.hs @@ -3,8 +3,8 @@ module Material (Material (..), attenuation) where import Linear.V3 import Linear.Vector -data Material = Lambertian (V3 Double) | Metal (V3 Double) | Glass (V3 Double) +data Material = Lambertian (V3 Double) | Metal (V3 Double) | Glass attenuation (Lambertian c) = c attenuation (Metal c) = c -attenuation (Glass c) = V3 1.0 1.0 1.0 +attenuation Glass = V3 1.0 1.0 1.0 diff --git a/src/Maths.hs b/src/Maths.hs index 941a032..e21f374 100644 --- a/src/Maths.hs +++ b/src/Maths.hs @@ -9,6 +9,7 @@ module Maths refract, reflectance, clamp, + degToRadians, ) where @@ -54,11 +55,11 @@ refract :: V3 Double -> V3 Double -> Double -> V3 Double 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 + perp = etai_over_etat *^ (negated 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 +reflectance c r = r00 + (1 - r00) * ((1 - c) ^ 5) where r0 = (1 - r) / (1 + r) r00 = r0 * r0