diff --git a/app/Main.hs b/app/Main.hs index 76dc5cc..17a2feb 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,12 +1,12 @@ module Main where +import Camera import Control.Monad (mapM) import Control.Monad.Random import Data.Ix import Data.Maybe import Hittable import IOUtils -import Linear.V2 import Linear.V3 import Linear.Vector import Material @@ -17,8 +17,6 @@ type Coord = (Int, Int) type ImageDimensions = (Int, Int) -type ViewPortDimensions = (Double, Double) - -- TODO -- antialiasing @@ -26,24 +24,24 @@ type ViewPortDimensions = (Double, Double) 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 + let target = p ^+^ colorWithNormal n ^+^ r return $ Ray p (target ^-^ p) scatter (Ray o d) (Hit t p n (Metal c)) = do - let reflected = reflect (unitVector d) (unitVector n) + 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 ct = min (ud `dotP` 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 (unitVector n) + let reflected = reflect ud n return $ Ray p reflected else do - let refracted = refract ud (unitVector n) refraction_ratio + let refracted = refract ud n refraction_ratio return $ Ray p refracted getRayColor :: (Shape s, RandomGen g) => [s] -> Int -> Ray -> Rand g (V3 Double) @@ -84,10 +82,10 @@ colorWithNormal v = 0.5 *^ (v ^+^ V3 1.0 1.0 1.0) -- 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 +rayTrace :: (Shape s) => (Int, Int) -> ImageDimensions -> [s] -> Int -> Camera -> IO (V3 Double) +rayTrace (x, y) (w, h) world samples camera = do let maxDepth = 50 - l <- replicateM samples (evalRandIO (getRayColor world maxDepth $ (buildRay (xf * (vw / wf)) (yf * (vh / hf))))) + l <- replicateM samples (evalRandIO (getRayColor world maxDepth $ buildRay (xf / wf) (yf / hf) camera)) return $ foldl (^+^) (V3 0.0 0.0 0.0) l where xf = fromIntegral x @@ -99,14 +97,22 @@ 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 camera = makeCamera (V3 0.0 0.0 0.0) viewWidth viewHeight focalLength + 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)) + [ Circle (V3 0.0 0.0 (-1.0)) 0.5 (Glass (V3 1.0 1.0 1.0)), + Circle (V3 1.0 0.0 (-1.0)) 0.5 (Lambertian (V3 0.7 0.1 0.1)), + Circle (V3 0.0 (-100.5) (-1.0)) 100 (Lambertian (V3 0.7 0.6 0.5)) ] - let coords = [(x, y) | x <- reverse $ [-1 * (w `div` 2) .. (w `div` 2) - 1], y <- [-1 * (h `div` 2) .. (h `div` 2) - 1]] - colors <- mapM (\x -> rayTrace x (w, h) (1.0, 1.0) world samples) coords + let coords = [(x, y) | x <- reverse [0 .. w - 1], y <- [0 .. h - 1]] + colors <- mapM (\x -> rayTrace x (w, h) world samples camera) coords let convertedColors = map v3ToColor colors -- print ppm header putStrLn "P3" diff --git a/src/Camera.hs b/src/Camera.hs new file mode 100644 index 0000000..cf5cdfb --- /dev/null +++ b/src/Camera.hs @@ -0,0 +1,14 @@ +module Camera (Camera (..), makeCamera) where + +import Linear.V3 +import Linear.Vector + +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 + Camera o lowerLeft horizontal vertical diff --git a/src/Hittable.hs b/src/Hittable.hs index af11103..f250f7d 100644 --- a/src/Hittable.hs +++ b/src/Hittable.hs @@ -36,11 +36,11 @@ instance Shape Circle where then Just (Hit rootP pp (getFaceNormal (Ray o d) ((pp - center) ^/ r)) m) else Nothing where - co = o - center + co = o ^-^ center a = lengthSquared d -- a vector dotted with itself is = lengthSquared b = co `dotP` d - c = lengthSquared co - r ^ 2 - discriminant = b ^ 2 - a * c + c = lengthSquared co - r * r + discriminant = b * b - a * c root = (b * (-1.0) - sqrt discriminant) / a rootP = (b * (-1.0) + sqrt discriminant) / a p = rayAt (Ray o d) root diff --git a/src/Ray.hs b/src/Ray.hs index d4b7473..334c425 100644 --- a/src/Ray.hs +++ b/src/Ray.hs @@ -7,6 +7,7 @@ module Ray ) where +import Camera import Control.Monad.Random import Linear.V3 import Linear.Vector @@ -22,11 +23,11 @@ rayAt (Ray origin dir) t = origin + (t *^ dir) calculateRayNormal :: Ray -> Double -> V3 Double calculateRayNormal r t = unitVector (rayAt r t ^-^ V3 0.0 0.0 1.0) -buildRayAA :: (RandomGen g) => Double -> Double -> Rand g Ray -buildRayAA u v = do +buildRayAA :: (RandomGen g) => Double -> Double -> Camera -> Rand g Ray +buildRayAA u v camera = do ur <- rand vr <- rand - return (Ray (V3 0.0 0.0 0.0) (V3 (v + vr) (u + ur) (-1.0))) + return $ buildRay (u + ur) (v + vr) camera -buildRay :: Double -> Double -> Ray -buildRay u v = Ray (V3 0.0 0.0 0.0) (V3 v u (-1.0)) +buildRay :: Double -> Double -> Camera -> Ray +buildRay u v (Camera o ll h vv) = Ray o (ll ^+^ (v *^ h) ^+^ (u *^ vv) ^-^ o)