diff --git a/src/Scene/Renderer.hs b/src/Scene/Renderer.hs index 0ad300d..a1a2758 100644 --- a/src/Scene/Renderer.hs +++ b/src/Scene/Renderer.hs @@ -19,29 +19,66 @@ import Debug.Trace data Ray = Ray (V3 Float) (V3 Float) -data Collision = Collision (V3 Float) Float Collidable +-- | Collision position normal distance object +data Collision = Collision (V3 Float) (V3 Float) Float Collidable deriving (Eq) instance Ord Collision where - compare (Collision _ a _) (Collision _ b _) = compare a b + compare (Collision _ _ a _) (Collision _ _ b _) = compare a b render :: Int -> Int -> Scene -> Int -> PixelRGB8 -render w h s index = case pcolls of - [] -> PixelRGB8 (ci br) (ci bg) (ci bb) --no collision -> Background - _ -> PixelRGB8 (ci ar) (ci ag) (ci ab) --collission -> git color +render w h s index = PixelRGB8 (ci cr) (ci cg) (ci cb) where - (V3 ar ag ab) = materialAmbience $ getMaterial coll - (Background (V3 br bg bb)) = sceneBackground s - pcolls = map fromJust $ filter isJust $ (intersect ray) <$> (sceneObjects s) - (Collision pos _ coll) = foldl1 min pcolls - ray = camRay x y (sceneCamera s) + (V3 cr cg cb) = + case raytrace ray s of + Nothing -> bgColor $ sceneBackground s + Just c@(Collision pos _ _ obj) -> + -- ambient lighting + ((*) <$> (ambColor . ambientLight $ s) <*> (materialAmbience . getMaterial $ obj)) + -- + diffuse lighting + ^+^ (foldl1 (^+^) $ (diffuse c s) <$> sceneLights s) + -- + reflections - TODO + ray = camRay x y (sceneCamera s) y = fromIntegral $ index `mod` w x = fromIntegral $ index `div` w - ci = floor . (*255) + ci = floor . (clamp 0 255) . (*255) --wrong format: --Ray (eye cam) $ rotCam x y w h (center cam ^-^ eye cam) (up cam) (fovy cam) --cam = sceneCamera s +diffuse :: Collision -> Scene -> Light -> V3 Float +diffuse (Collision pos n _ obj) s (Light lpos color int) = + case blocked of + Nothing -> ill + Just (Collision _ _ dist _) -> if dist < norm lightdir + then + V3 0 0 0 --light is blocked -> no lighting from here. + else + ill + where + ill = (*) (dot n $ normalize lightdir) <$> illumination + illumination = (*) <$> color ^* i <*> materialDiffuse mat + mat = getMaterial obj + blocked = raytrace (Ray pos lightdir) s + lightdir = (lpos ^-^ pos) + i = case int of + Nothing -> 1 + Just a -> a + +clamp :: Ord a => a -> a -> a -> a +clamp min max x + | x < min = min + | x > max = max + | otherwise = x + +raytrace :: Ray -> Scene -> Maybe Collision +raytrace r s = case possibleCollisions of + [] -> Nothing + _ -> Just $ foldl1 min possibleCollisions + where + possibleCollisions :: [Collision] + possibleCollisions = map fromJust $ filter isJust $ (intersect r) <$> (sceneObjects s) + camRay :: Float -> Float -> Camera -> Ray camRay x y c = Ray (eye c) (lowerLeft c ^+^ x *^ xDir c ^+^ y *^ yDir c ^-^ eye c) @@ -52,7 +89,7 @@ rotateDegAx phi axis = rotate q intersect :: Ray -> Collidable -> Maybe Collision intersect (Ray ro rd) s@(S (Sphere sc sr _)) = if (d > 0 && int > 0) then - Just (Collision (ro ^+^ (rd ^* int)) int s) + Just (Collision pos (normalize $ pos ^-^ sc) int s) else Nothing where @@ -61,6 +98,7 @@ intersect (Ray ro rd) s@(S (Sphere sc sr _)) = if (d > 0 && int > 0) then c = dot oc oc - sr*sr d = b * b - 4 * a * c oc = ro ^-^ sc + pos = ro ^+^ (rd ^* int) int = case ints of [] -> 0 a -> foldl1 min a @@ -77,4 +115,3 @@ rotCam x y w h dir up fovy = rotxy dx = (x - (fromIntegral w) / 2)/(fromIntegral w) dy = (y - (fromIntegral h) / 2)/(fromIntegral h) rad = (*pi).(/180) - diff --git a/src/Scene/Types.hs b/src/Scene/Types.hs index 44f4422..6db08a0 100644 --- a/src/Scene/Types.hs +++ b/src/Scene/Types.hs @@ -20,10 +20,14 @@ data Camera = Camera type RecursionDepth = Int -data Background = Background Color +data Background = Background + { bgColor :: Color + } deriving (Show, Eq) -data Ambience = Ambience Color +data Ambience = Ambience + { ambColor :: Color + } deriving (Show, Eq) data Light = Light (V3 Float) Color (Maybe Intensity)