From 9a6ba0adce302dc0c2bd7b0701a8bfbfec529dbe Mon Sep 17 00:00:00 2001 From: Rostyslav Hnatyshyn Date: Tue, 13 Sep 2022 20:35:37 -0700 Subject: [PATCH] First render --- app/Main.hs | 49 ++++++++++++++++++++++++++++--------------------- src/Hittable.hs | 19 +++++++++++++++++-- src/Maths.hs | 4 +++- src/Ray.hs | 3 ++- 4 files changed, 50 insertions(+), 25 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 4615f9c..27b88bc 100644 --- a/app/Main.hs +++ b/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) --- need to accumulate somewhere +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) 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 - nextVal <- (getRayColor ws (depth - 1) (Ray p (target ^-^ p))) - return $ colorWithNormal (calculateRayNormal (Ray o d) t) ^+^ (0.5 *^ nextVal) + let target = p ^+^ colorWithNormal (unitVector n) ^+^ r + nextVal <- getRayColor ws (depth - 1) (Ray p (target ^-^ p)) + 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) - yr = round (y * 255.0) - zr = round (z * 255.0) + -- scale 1 + scale = 1.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] - let coords = range ((-1 * (w `div` 2), -1 * (h `div` 2)), ((w `div` 2) - 1, (h `div` 2) - 1)) -- "canvas" - --let aspect = 16.0 / 9.0 - g <- getStdGen - 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 + -- 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 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 - --mapM_ print colors putStrLn "P3" putStrLn (show w ++ " " ++ show h) putStrLn "255" mapM_ colorToString convertedColors + mapM_ print convertedColors diff --git a/src/Hittable.hs b/src/Hittable.hs index a3ea651..7bd242b 100644 --- a/src/Hittable.hs +++ b/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 diff --git a/src/Maths.hs b/src/Maths.hs index 8987379..a35139f 100644 --- a/src/Maths.hs +++ b/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 diff --git a/src/Ray.hs b/src/Ray.hs index 9db2c28..66bd598 100644 --- a/src/Ray.hs +++ b/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))