rostyhn/haskell-raytracer
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

clean up code

Browse Source
This commit is contained in:
Rostyslav Hnatyshyn
2022-09-22 20:38:08 -07:00
parent 220cfe21d5
commit 73e374aba2
6 changed files with 58 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files
app/Main.hs
+20 -30
View File
@@ -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
src/Hittable.hs
+4 -4
View File
@@ -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
src/IOUtils.hs
+22
View File
@@ -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)
src/Material.hs
+1 -4
View File
@@ -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
src/Maths.hs
+7 -9
View File
@@ -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
src/Ray.hs
+4 -4
View File
@@ -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))