Added samples per pixel

master
Rostyslav Hnatyshyn 2 years ago
parent dce49e81dc
commit 220cfe21d5
  1. 13
      app/Main.hs
  2. 7
      src/Maths.hs

@ -84,26 +84,21 @@ getBestHit' [] hit = hit
colorWithNormal :: V3 Double -> V3 Double colorWithNormal :: V3 Double -> V3 Double
colorWithNormal v = 0.5 *^ (v ^+^ V3 1.0 1.0 1.0) colorWithNormal v = 0.5 *^ (v ^+^ V3 1.0 1.0 1.0)
rayTrace :: (Shape s) => (Int, Int) -> ImageDimensions -> ViewPortDimensions -> [s] -> IO (V3 Double) -- rayTrace :: (Shape s) => (Int, Int) -> ImageDimensions -> ViewPortDimensions -> [s] -> IO (V3 Double)
rayTrace (x, y) (w, h) (vw, vh) world = do rayTrace (x, y) (w, h) (vw, vh) world = do
evalRandIO (getRayColor world 50 $ buildRay (xf * (vw / wf)) (yf * (vh / hf))) l <- replicateM 25 (evalRandIO (getRayColor world 50 $ buildRay (xf * (vw / wf)) (yf * (vh / hf))))
return $ foldl (^+^) (V3 0.0 0.0 0.0) l
where where
xf = fromIntegral x xf = fromIntegral x
yf = fromIntegral y yf = fromIntegral y
wf = fromIntegral (w - 1) wf = fromIntegral (w - 1)
hf = fromIntegral (h - 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 :: Color -> IO ()
colorToString (x, y, z) = tupToString (xr, yr, zr) colorToString (x, y, z) = tupToString (xr, yr, zr)
where where
-- scale 1 -- scale 1
scale = 1.0 scale = 1.0 / 25
xr = truncate ((clamp (sqrt (x * scale)) 0.0 0.999) * 256.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) yr = truncate ((clamp (sqrt (y * scale)) 0.0 0.999) * 256.0)
zr = truncate ((clamp (sqrt (z * scale)) 0.0 0.999) * 256.0) zr = truncate ((clamp (sqrt (z * scale)) 0.0 0.999) * 256.0)

@ -7,6 +7,7 @@ module Maths
reflect, reflect,
refract, refract,
reflectance, reflectance,
clamp,
) )
where where
@ -63,3 +64,9 @@ reflectance c r = r00 + (1 - r00) * (1 - c) ^ 5
where where
r0 = (1 - r) / (1 + r) r0 = (1 - r) / (1 + r)
r00 = r0 * r0 r00 = r0 * r0
clamp :: Double -> Double -> Double -> Double
clamp x mi ma
| x < mi = mi
| x > ma = ma
| otherwise = x

Loading…
Cancel
Save