diff --git a/scenes/test.sce b/scenes/test.sce index 4a70eef..a2fbc30 100644 --- a/scenes/test.sce +++ b/scenes/test.sce @@ -21,4 +21,4 @@ sphere -1.0 0.5 2.0 0.5 0.0 1.0 0.0 0.0 1.0 0.0 1.0 1.0 1.0 200.0 0.2 sphere 3.0 2.0 1.5 2.0 0.0 0.0 1.0 0.0 0.0 1.0 1.0 1.0 1.0 50.0 0.2 # planes: center, normal, material -plane 0 0 0 0 1 0 0.2 0.2 0.2 0.2 0.2 0.2 0.0 0.0 0.0 100.0 0.1 +#plane 0 0 0 0 1 0 0.2 0.2 0.2 0.2 0.2 0.2 0.0 0.0 0.0 100.0 0.1 diff --git a/src/Main.hs b/src/Main.hs index e918d27..ca38ef5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,12 +2,15 @@ module Main where import Control.Applicative +import Control.Arrow import Codec.Picture.Png import Codec.Picture.Types import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 -import Data.Vector hiding ((++),map) +import Data.Vector hiding ((++),map, foldl, filter, foldl1) import Data.Word (Word8) +import Data.Maybe +import Linear (V3(..), (^+^), (^*), (^-^), dot, axisAngle, rotate, cross) import Data.Attoparsec @@ -73,18 +76,58 @@ validateAndParseScene f = do } render :: Int -> Int -> Scene -> Int -> PixelRGB8 -render w h s index = trace (show (x,y)) PixelRGB8 255 (fromIntegral x) (fromIntegral y) +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 where - y = index `mod` w - x = index `div` w + (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 = Ray (center cam) $ rotCam x y w h (eye cam) (up cam) (fovy cam) + cam = sceneCamera s + y = fromIntegral $ index `mod` w + x = fromIntegral $ index `div` w + ci = floor . (*255) + +rotCam :: Float -> Float -> Int -> Int -> V3 Float -> V3 Float -> Float -> V3 Float +rotCam x y w h dir up fovy = rotxy + where + rotxy = rotateDegAx (rad $ fovy*dy) (cross up roty) roty + roty = rotateDegAx (rad $ fovy*dx) up dir + dx = (x - (fromIntegral w) / 2)/(fromIntegral w) + dy = (y - (fromIntegral h) / 2)/(fromIntegral h) + rad = (*pi).(/180) + +rotateDegAx :: Float -> V3 Float -> V3 Float -> V3 Float +rotateDegAx phi axis = rotate q + where + q = axisAngle axis phi data Ray = Ray (V3 Float) (V3 Float) data Collision = Collision (V3 Float) Float Collidable + deriving (Eq) + +instance Ord Collision where + compare (Collision _ a _) (Collision _ b _) = compare a b intersect :: Ray -> Collidable -> Maybe Collision -intersect (Ray ro rd) (S (Sphere sc sr _) = undefined -intersect _ = undefined +intersect (Ray ro rd) s@(S (Sphere sc sr _)) = if (d > 0 && int > 0) then + Just (Collision (ro ^+^ (rd ^* int)) int s) + else + Nothing + where + a = dot rd rd + b = 2 * dot rd oc + c = dot oc oc - sr*sr + d = b * b - 4 * a * c + oc = ro ^-^ sc + int = case ints of + [] -> 0 + a -> foldl1 min a + ints = filter (uncurry (&&).(&&&) (>0.00001) (not.isNaN)) [(-b-(sqrt d))/(2*a),(-b+(sqrt d))/(2*a)] +intersect _ _ = undefined main :: IO () main = do diff --git a/src/Scene/Types.hs b/src/Scene/Types.hs index b19bff5..1ddc5cf 100644 --- a/src/Scene/Types.hs +++ b/src/Scene/Types.hs @@ -84,3 +84,8 @@ data Scene = Scene , sceneObjects :: [Collidable] } deriving (Show, Eq) + +getMaterial :: Collidable -> Material +getMaterial (S (Sphere _ _ m)) = m +getMaterial (P (Plane _ _ m)) = m +getMaterial (M (Mesh _ _ m)) = m