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

added camera object

Browse Source
This commit is contained in:
Rostyslav Hnatyshyn
2022-09-24 18:26:52 -07:00
parent 77dc540290
commit b0cc878ccc
4 changed files with 45 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files
app/Main.hs
+22 -16
View File
@@ -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"