|
|
@ -17,9 +17,6 @@ type Coord = (Int, Int) |
|
|
|
|
|
|
|
|
|
|
|
type ImageDimensions = (Int, Int) |
|
|
|
type ImageDimensions = (Int, Int) |
|
|
|
|
|
|
|
|
|
|
|
-- TODO |
|
|
|
|
|
|
|
-- antialiasing |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
-- scatter rays based on the material of the object that was hit |
|
|
|
-- scatter rays based on the material of the object that was hit |
|
|
|
scatter :: (RandomGen g) => Ray -> Hit -> Rand g (Ray) |
|
|
|
scatter :: (RandomGen g) => Ray -> Hit -> Rand g (Ray) |
|
|
|
scatter (Ray o d) (Hit t p n (Lambertian c)) = do |
|
|
|
scatter (Ray o d) (Hit t p n (Lambertian c)) = do |
|
|
@ -44,6 +41,16 @@ scatter (Ray o d) (Hit t p n (Glass c)) = do |
|
|
|
let refracted = refract ud n refraction_ratio |
|
|
|
let refracted = refract ud n refraction_ratio |
|
|
|
return $ Ray p refracted |
|
|
|
return $ Ray p refracted |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
grc :: (RandomGen g, Shape s) => (Int, Int) -> ImageDimensions -> [s] -> Int -> Camera -> Rand g (V3 Double) |
|
|
|
|
|
|
|
grc (x, y) (w, h) ws d camera = do |
|
|
|
|
|
|
|
ray <- buildRayAA xf yf wf hf camera |
|
|
|
|
|
|
|
getRayColor ws d ray |
|
|
|
|
|
|
|
where |
|
|
|
|
|
|
|
xf = fromIntegral x |
|
|
|
|
|
|
|
yf = fromIntegral y |
|
|
|
|
|
|
|
wf = fromIntegral (w - 1) |
|
|
|
|
|
|
|
hf = fromIntegral (h - 1) |
|
|
|
|
|
|
|
|
|
|
|
getRayColor :: (Shape s, RandomGen g) => [s] -> Int -> Ray -> Rand g (V3 Double) |
|
|
|
getRayColor :: (Shape s, RandomGen g) => [s] -> Int -> Ray -> Rand g (V3 Double) |
|
|
|
getRayColor ws d r = do |
|
|
|
getRayColor ws d r = do |
|
|
|
let h = getBestHit (mapMaybe (testHit r) ws) |
|
|
|
let h = getBestHit (mapMaybe (testHit r) ws) |
|
|
@ -83,15 +90,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 |
|
|
|
-- 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 |
|
|
|
-- run [samples] times in order to increase fidelity |
|
|
|
rayTrace :: (Shape s) => (Int, Int) -> ImageDimensions -> [s] -> Int -> Camera -> IO (V3 Double) |
|
|
|
rayTrace :: (Shape s) => (Int, Int) -> ImageDimensions -> [s] -> Int -> Camera -> IO (V3 Double) |
|
|
|
rayTrace (x, y) (w, h) world samples camera = do |
|
|
|
rayTrace coord dim world samples camera = do |
|
|
|
let maxDepth = 50 |
|
|
|
let maxDepth = 50 |
|
|
|
l <- replicateM samples (evalRandIO (getRayColor world maxDepth $ buildRay (xf / wf) (yf / hf) camera)) |
|
|
|
l <- replicateM samples (evalRandIO (grc coord dim world maxDepth camera)) |
|
|
|
return $ foldl (^+^) (V3 0.0 0.0 0.0) l |
|
|
|
return $ foldl (^+^) (V3 0.0 0.0 0.0) l |
|
|
|
where |
|
|
|
|
|
|
|
xf = fromIntegral x |
|
|
|
|
|
|
|
yf = fromIntegral y |
|
|
|
|
|
|
|
wf = fromIntegral (w - 1) |
|
|
|
|
|
|
|
hf = fromIntegral (h - 1) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
main :: IO () |
|
|
|
main :: IO () |
|
|
|
main = do |
|
|
|
main = do |
|
|
@ -108,10 +110,11 @@ main = do |
|
|
|
let samples = 25 |
|
|
|
let samples = 25 |
|
|
|
let world = |
|
|
|
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 (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 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)) |
|
|
|
Circle (V3 0.0 (-100.5) (-1.0)) 100 (Lambertian (V3 0.7 0.6 0.5)) |
|
|
|
] |
|
|
|
] |
|
|
|
let coords = [(x, y) | x <- reverse [0 .. w - 1], y <- [0 .. h - 1]] |
|
|
|
-- y x because most raytracing algorithms go top to bottom, left to right |
|
|
|
|
|
|
|
let coords = [(y, x) | x <- reverse [0 .. w - 1], y <- [0 .. h - 1]] |
|
|
|
colors <- mapM (\x -> rayTrace x (w, h) world samples camera) coords |
|
|
|
colors <- mapM (\x -> rayTrace x (w, h) world samples camera) coords |
|
|
|
let convertedColors = map v3ToColor colors |
|
|
|
let convertedColors = map v3ToColor colors |
|
|
|
-- print ppm header |
|
|
|
-- print ppm header |
|
|
|