You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
105 lines
3.1 KiB
105 lines
3.1 KiB
2 years ago
|
module Main where
|
||
|
|
|
||
|
|
import Control.Monad (mapM)
|
||
|
|
import Control.Monad.Random
|
||
|
|
import Data.Ix
|
||
|
|
import Data.Maybe
|
||
|
|
import Debug.Trace
|
||
|
|
import Hittable
|
||
|
|
import Linear.V2
|
||
|
|
import Linear.V3
|
||
|
|
import Linear.Vector
|
||
|
|
import Maths
|
||
|
|
import Ray
|
||
|
|
import Text.Printf
|
||
|
|
|
||
|
|
type Color = (Double, Double, Double)
|
||
|
|
|
||
|
|
type Coord = (Int, Int)
|
||
|
|
|
||
|
|
type ImageDimensions = (Int, Int)
|
||
|
|
|
||
|
|
type ViewPortDimensions = (Double, Double)
|
||
|
|
|
||
|
|
-- TODO
|
||
|
|
-- add multiple samples per pixel
|
||
|
|
-- fix coordinate system
|
||
|
|
-- DONE fix random number generator
|
||
|
|
|
||
|
|
backgroundColor = V3 0.0 0.0 0.0
|
||
|
|
|
||
|
|
-- getRayColor :: (Shape s, RandomGen g) => [s] -> Int -> Ray Double -> Rand g (V3 Double)
|
||
|
|
-- need to accumulate somewhere
|
||
|
|
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)
|
||
|
|
getRayColor' (Ray o d) Nothing _ _ = do return $ colorGradient (unitVector d)
|
||
|
|
getRayColor' _ _ _ 0 = do return $ backgroundColor
|
||
|
|
getRayColor' (Ray o d) (Just (Hit t p n)) ws depth =
|
||
|
|
do
|
||
|
|
r <- randV3
|
||
|
|
let target = p ^+^ n ^+^ r
|
||
|
|
nextVal <- (getRayColor ws (depth - 1) (Ray p (target ^-^ p)))
|
||
|
|
return $ colorWithNormal (calculateRayNormal (Ray o d) t) ^+^ (0.5 *^ nextVal)
|
||
|
|
|
||
|
|
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
|
||
|
|
|
||
|
|
getBestHit :: [Hit] -> Maybe Hit
|
||
|
|
getBestHit [] = Nothing
|
||
|
|
getBestHit (h : hs) = Just (getBestHit' hs h)
|
||
|
|
|
||
|
|
getBestHit' :: [Hit] -> Hit -> Hit
|
||
|
|
getBestHit' (h : hs) bestHit =
|
||
|
|
if root h > root bestHit
|
||
|
|
then getBestHit' hs h
|
||
|
|
else getBestHit' hs bestHit
|
||
|
|
getBestHit' [] hit = hit
|
||
|
|
|
||
|
|
colorWithNormal :: V3 Double -> V3 Double
|
||
|
|
colorWithNormal v = 0.5 *^ (v ^+^ V3 1.0 1.0 1.0)
|
||
|
|
|
||
|
|
rayTrace :: (Shape s, RandomGen g) => (Int, Int) -> ImageDimensions -> ViewPortDimensions -> [s] -> Rand g (V3 Double)
|
||
|
|
rayTrace (x, y) (w, h) (vw, vh) world = do
|
||
|
|
getRayColor world 50 (buildRay (xf * (vw / wf)) (yf * (vh / hf)))
|
||
|
|
where
|
||
|
|
xf = fromIntegral x
|
||
|
|
yf = fromIntegral y
|
||
|
|
wf = fromIntegral (w - 1)
|
||
|
|
hf = fromIntegral (h - 1)
|
||
|
|
|
||
|
|
colorToString :: Color -> IO ()
|
||
|
|
colorToString (x, y, z) = tupToString (xr, yr, zr)
|
||
|
|
where
|
||
|
|
xr = round (x * 255.0)
|
||
|
|
yr = round (y * 255.0)
|
||
|
|
zr = round (z * 255.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
|
||
|
|
-- weirdly, the bottom circle appears on top and bottom
|
||
|
|
let world = [Circle (V3 0.0 0.0 1.0) 0.25, Circle (V3 0.0 (-10.05) 1.0) 10]
|
||
|
|
let coords = range ((-1 * (w `div` 2), -1 * (h `div` 2)), ((w `div` 2) - 1, (h `div` 2) - 1)) -- "canvas"
|
||
|
|
--let aspect = 16.0 / 9.0
|
||
|
|
g <- getStdGen
|
||
|
|
let colors = map (\x -> foldl (^+^) (V3 0.0 0.0 0.0) $ replicate 50 $ evalRand (rayTrace x (w - 1, h - 1) (1.0, 1.0) world) g) coords
|
||
|
|
let convertedColors = map v3ToColor colors
|
||
|
|
--mapM_ print colors
|
||
|
|
putStrLn "P3"
|
||
|
|
putStrLn (show w ++ " " ++ show h)
|
||
|
|
putStrLn "255"
|
||
|
|
mapM_ colorToString convertedColors
|