added antialiasing, fixed x-y issue
This commit is contained in:
+15
-12
@@ -17,9 +17,6 @@ type Coord = (Int, Int)
|
||||
|
||||
type ImageDimensions = (Int, Int)
|
||||
|
||||
-- TODO
|
||||
-- antialiasing
|
||||
|
||||
-- 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
|
||||
@@ -44,6 +41,16 @@ scatter (Ray o d) (Hit t p n (Glass c)) = do
|
||||
let refracted = refract ud n refraction_ratio
|
||||
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 ws d r = do
|
||||
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
|
||||
-- run [samples] times in order to increase fidelity
|
||||
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
|
||||
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
|
||||
where
|
||||
xf = fromIntegral x
|
||||
yf = fromIntegral y
|
||||
wf = fromIntegral (w - 1)
|
||||
hf = fromIntegral (h - 1)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
@@ -108,10 +110,11 @@ main = do
|
||||
let samples = 25
|
||||
let world =
|
||||
[ 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))
|
||||
]
|
||||
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
|
||||
let convertedColors = map v3ToColor colors
|
||||
-- print ppm header
|
||||
|
||||
+4
-4
@@ -23,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 -> Camera -> Rand g Ray
|
||||
buildRayAA u v camera = do
|
||||
buildRayAA :: (RandomGen g) => Double -> Double -> Double -> Double -> Camera -> Rand g Ray
|
||||
buildRayAA u v w h camera = do
|
||||
ur <- rand
|
||||
vr <- rand
|
||||
return $ buildRay (u + ur) (v + vr) camera
|
||||
return $ buildRay ((u + ur) / w) ((v + vr) / h) camera
|
||||
|
||||
buildRay :: Double -> Double -> Camera -> Ray
|
||||
buildRay u v (Camera o ll h vv) = Ray o (ll ^+^ (v *^ h) ^+^ (u *^ vv) ^-^ o)
|
||||
buildRay u v (Camera o ll h vv) = Ray o (ll ^+^ (u *^ h) ^+^ (v *^ vv) ^-^ o)
|
||||
|
||||
Reference in New Issue
Block a user