diff --git a/app/Main.hs b/app/Main.hs index 09b1b8f..5de164d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -4,17 +4,14 @@ import Control.Monad (mapM) import Control.Monad.Random import Data.Ix import Data.Maybe -import Debug.Trace import Hittable +import IOUtils import Linear.V2 import Linear.V3 import Linear.Vector import Material import Maths import Ray -import Text.Printf - -type Color = (Double, Double, Double) type Coord = (Int, Int) @@ -25,9 +22,8 @@ type ViewPortDimensions = (Double, Double) -- TODO -- antialiasing -backgroundColor = V3 0.0 0.0 0.0 - -scatter :: (RandomGen g) => Ray Double -> Hit -> Rand g (Ray Double) +-- scatter rays based on the material of the object that was hit +scatter :: (RandomGen g) => Ray -> Hit -> Rand g (Ray) scatter (Ray o d) (Hit t p n (Lambertian c)) = do r <- randV3 let target = p ^+^ colorWithNormal (unitVector n) ^+^ r @@ -50,13 +46,14 @@ scatter (Ray o d) (Hit t p n (Glass c)) = 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 :: (Shape s, RandomGen g) => [s] -> Int -> Ray -> Rand g (V3 Double) getRayColor ws d r = do let h = getBestHit (mapMaybe (testHit r) ws) v <- getRayColor' r h ws d return v -getRayColor' :: (Shape s, RandomGen g) => Ray Double -> Maybe Hit -> [s] -> Int -> Rand g (V3 Double) +-- get color of pixel according to the closest hit found +getRayColor' :: (Shape s, RandomGen g) => Ray -> 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 m)) ws depth = do @@ -65,17 +62,19 @@ getRayColor' (Ray o d) (Just (Hit t p n m)) ws depth = do nextVal <- getRayColor ws (depth - 1) ray return (a * nextVal) +-- used for coloring the background, color based on direction vector 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 +-- from a list of possible hits, get the closest possible hit found +getBestHit :: [Hit] -> Maybe Hit getBestHit [] = Nothing getBestHit (h : hs) = Just (getBestHit' hs h) getBestHit' :: [Hit] -> Hit -> Hit getBestHit' (h : hs) bestHit = - -- always pick closest hit to camera if root h < root bestHit then getBestHit' hs h else getBestHit' hs bestHit @@ -84,9 +83,12 @@ getBestHit' [] hit = hit colorWithNormal :: V3 Double -> V3 Double colorWithNormal v = 0.5 *^ (v ^+^ V3 1.0 1.0 1.0) --- rayTrace :: (Shape s) => (Int, Int) -> ImageDimensions -> ViewPortDimensions -> [s] -> IO (V3 Double) -rayTrace (x, y) (w, h) (vw, vh) world = do - l <- replicateM 25 (evalRandIO (getRayColor world 50 $ buildRay (xf * (vw / wf)) (yf * (vh / hf)))) +-- heart of loop, for each x y coordinate pixel, convert it into world space and then run the ray tracing algorithm +-- run [samples] times in order to increase fidelity +rayTrace :: (Shape s) => (Int, Int) -> ImageDimensions -> ViewPortDimensions -> [s] -> Int -> IO (V3 Double) +rayTrace (x, y) (w, h) (vw, vh) world samples = do + let maxDepth = 50 + l <- replicateM samples (evalRandIO (getRayColor world maxDepth $ buildRay (xf * (vw / wf)) (yf * (vh / hf)))) return $ foldl (^+^) (V3 0.0 0.0 0.0) l where xf = fromIntegral x @@ -94,35 +96,23 @@ rayTrace (x, y) (w, h) (vw, vh) world = do wf = fromIntegral (w - 1) hf = fromIntegral (h - 1) -colorToString :: Color -> IO () -colorToString (x, y, z) = tupToString (xr, yr, zr) - where - -- scale 1 - scale = 1.0 / 25 - 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) - -v3ToColor :: V3 Double -> Color -v3ToColor (V3 x y z) = (x, y, z) - main :: IO () main = do let w = 400 let h = 400 + let samples = 25 let world = [ 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 + colors <- mapM (\x -> rayTrace x (w, h) (1.0, 1.0) world samples) coords let convertedColors = map v3ToColor colors + -- print ppm header putStrLn "P3" putStrLn (show w ++ " " ++ show h) putStrLn "255" - mapM_ colorToString convertedColors + -- print each color converted to ppm format string + mapM_ (colorToString samples) convertedColors mapM_ print convertedColors diff --git a/src/Hittable.hs b/src/Hittable.hs index 298f5e5..af11103 100644 --- a/src/Hittable.hs +++ b/src/Hittable.hs @@ -7,18 +7,18 @@ import Maths import Ray class Shape s where - testHit :: Ray Double -> s -> Maybe Hit + testHit :: Ray -> s -> Maybe Hit -data Circle = Circle (V3 Double) Double Material +data Circle = Circle {center :: V3 Double, radius :: Double, material :: Material} data Hit = Hit {root :: Double, p :: V3 Double, n :: V3 Double, m :: Material} -getFaceNormal :: Ray Double -> V3 Double -> V3 Double +getFaceNormal :: Ray -> V3 Double -> V3 Double getFaceNormal (Ray o d) n | (d `dotP` n) < 0.0 = n | otherwise = (-1.0) *^ n -isFrontFace :: Ray Double -> V3 Double -> Bool +isFrontFace :: Ray -> V3 Double -> Bool isFrontFace (Ray o d) n | (d `dotP` n) < 0.0 = True | otherwise = False diff --git a/src/IOUtils.hs b/src/IOUtils.hs new file mode 100644 index 0000000..94b9eac --- /dev/null +++ b/src/IOUtils.hs @@ -0,0 +1,22 @@ +module IOUtils (Color, colorToString, tupToString, v3ToColor) where + +import Linear.V3 +import Maths + +type Color = (Double, Double, Double) + +-- convert color to string, make sure each value is between 0 and 256 +colorToString :: Int -> Color -> IO () +colorToString samples (x, y, z) = tupToString (xr, yr, zr) + where + samplesD = fromIntegral samples + scale = 1.0 / samplesD + 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) + +v3ToColor :: V3 Double -> Color +v3ToColor (V3 x y z) = (x, y, z) diff --git a/src/Material.hs b/src/Material.hs index 65043d6..4cfc680 100644 --- a/src/Material.hs +++ b/src/Material.hs @@ -2,12 +2,9 @@ module Material (Material (..), attenuation) where import Linear.V3 import Linear.Vector -import Maths -import Ray 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) +attenuation (Glass c) = V3 1.0 1.0 1.0 diff --git a/src/Maths.hs b/src/Maths.hs index 74e8fef..65d6d9a 100644 --- a/src/Maths.hs +++ b/src/Maths.hs @@ -12,8 +12,6 @@ module Maths where import Control.Monad.Random -import Control.Monad.State (State, evalState, get, put) -import Debug.Trace import Linear.V3 import Linear.Vector import System.Random @@ -34,25 +32,25 @@ randV3 = do --inf = read "Infinity" -degToRadians :: (Floating a) => a -> a +degToRadians :: Double -> Double degToRadians d = (d * pi) / 180.0 -dotP :: (Num a) => V3 a -> V3 a -> a +dotP :: V3 Double -> V3 Double -> Double dotP (V3 a b c) (V3 d e f) = a * d + b * e + c * f -lengthSquared :: (Num a) => V3 a -> a +lengthSquared :: V3 Double -> Double lengthSquared (V3 x y z) = x ^ 2 + y ^ 2 + z ^ 2 -vectorLength :: (Floating f) => V3 f -> f +vectorLength :: V3 Double -> Double vectorLength v = sqrt (lengthSquared v) -unitVector :: (Floating f) => V3 f -> V3 f +unitVector :: V3 Double -> V3 Double unitVector v = v ^/ vectorLength v -reflect :: (Floating f) => V3 f -> V3 f -> V3 f +reflect :: V3 Double -> V3 Double -> V3 Double reflect v n = v - (2 * (v `dotP` n)) *^ n -refract :: (RealFloat f) => V3 f -> V3 f -> f -> V3 f +refract :: V3 Double -> V3 Double -> Double -> V3 Double refract uv n etai_over_etat = perp ^+^ parallel where ct = min (uv `dotP` n) 1.0 diff --git a/src/Ray.hs b/src/Ray.hs index 66bd598..9a4b5f9 100644 --- a/src/Ray.hs +++ b/src/Ray.hs @@ -11,15 +11,15 @@ import Linear.V3 import Linear.Vector import Maths -data Ray f = Ray (V3 f) (V3 f) +data Ray = Ray {origin :: V3 Double, direction :: V3 Double} -- P(t) = A + tB; A is origin, B is direction -rayAt :: (Floating f) => Ray f -> f -> V3 f +rayAt :: Ray -> Double -> V3 Double rayAt (Ray origin dir) t = origin + (t *^ dir) -- get the normal of the point at t -calculateRayNormal :: (Floating f) => Ray f -> f -> V3 f +calculateRayNormal :: Ray -> Double -> V3 Double calculateRayNormal r t = unitVector (rayAt r t ^-^ V3 0.0 0.0 1.0) -buildRay :: (Floating f) => f -> f -> Ray f +buildRay :: Double -> Double -> Ray buildRay u v = Ray (V3 0.0 0.0 0.0) (V3 v u (-1.0))