From 4f8be66d27719ccf1f4c49659de62d418d1b7e08 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Mon, 1 Dec 2014 12:27:34 +0100 Subject: [PATCH] some kind of image ... --- raytrace.cabal | 3 ++- scenes/cube/cube.sce | 2 +- src/Scene/Parser.hs | 8 +++----- src/Scene/Renderer.hs | 40 ++++++++++++++++++++++++++++++++++++---- 4 files changed, 42 insertions(+), 11 deletions(-) diff --git a/raytrace.cabal b/raytrace.cabal index 4e83db5..8058a77 100644 --- a/raytrace.cabal +++ b/raytrace.cabal @@ -67,7 +67,8 @@ executable raytrace either >= 4.3, containers >= 0.2, mtl >= 2.1, - filepath >= 1.3 + filepath >= 1.3, + lens >= 4.6 -- Directories containing source files. hs-source-dirs: src diff --git a/scenes/cube/cube.sce b/scenes/cube/cube.sce index f14a08b..99bf355 100644 --- a/scenes/cube/cube.sce +++ b/scenes/cube/cube.sce @@ -16,4 +16,4 @@ light 10 0 5 0.2 0.2 1.0 # mesh: filename, FLAT/SMOOTH, material mesh cube.off FLAT 0.5 0.5 0.5 0.5 0.5 0.5 0.0 0.0 0.0 0.0 0.0 -#mesh cube.off PHONG 0.5 0.5 0.5 0.5 0.5 0.5 0.0 0.0 0.0 0.0 0.0 \ No newline at end of file +#mesh cube.off PHONG 0.5 0.5 0.5 0.5 0.5 0.5 0.0 0.0 0.0 0.0 0.0 diff --git a/src/Scene/Parser.hs b/src/Scene/Parser.hs index be9f9af..8c1b06a 100644 --- a/src/Scene/Parser.hs +++ b/src/Scene/Parser.hs @@ -195,13 +195,12 @@ parseMesh' :: Shading -> Material -> Parser ObjectParser parseMesh' s m = do string "OFF" skipSpace - --D.trace "first Line" endOfLine v <- decimal skipSpace f <- decimal skipSpace _ <- decimal --ignored in our OFF-Files - D.trace "second Line" endOfLine + skipSpace verts <- D.trace (show v ++ " verts") $ A8.count v parseVector faces <- D.trace (show f ++ " faces") $ A8.count f parseTriangle -- whatever should be parsed afterwards in OFF.. @@ -210,7 +209,7 @@ parseMesh' s m = do mf = IM.fromList $ P.zip [0..] faces mfn = normal mv <$> mf normal :: IntMap (V3 Float) -> V3 Int -> V3 Float - normal verts (V3 v1 v2 v3) = normalize $ cross (verts ! v1 - verts ! v2) + normal verts (V3 v1 v2 v3) = (*(-1)).normalize $ cross (verts ! v1 - verts ! v2) (verts ! v3 - verts ! v2) -- maybe * (-1) mn = IM.fromList $ P.zip [0..] $ vnormal mfn mf <$> [0..v] @@ -229,8 +228,7 @@ parseMesh' s m = do b = F.foldl' minmax (V3 (-infty) (-infty) (-infty), V3 infty infty infty) mv minmax (maxin,minin) vec = (max <$> maxin <*> vec, min <$> minin <*> vec) infty = 9999999999999 :: Float - - return $ OpI Mesh + return $ OpI Mesh { meshShading = s , meshMaterial = m , meshVertices = mv diff --git a/src/Scene/Renderer.hs b/src/Scene/Renderer.hs index 445de6c..e5ce5cb 100644 --- a/src/Scene/Renderer.hs +++ b/src/Scene/Renderer.hs @@ -11,6 +11,10 @@ import Data.Vector hiding ((++),map, foldl, filter, foldl1) import Data.Word (Word8) import Data.Maybe import Linear +import Control.Lens.Operators +import Data.IntMap as IM +import Prelude as P +import qualified Data.List as L import Scene.Parser import Scene.Types @@ -102,7 +106,7 @@ raytrace r s = case possibleCollisions of _ -> Just $ foldl1 min possibleCollisions where possibleCollisions :: [Collision] - possibleCollisions = map fromJust $ filter isJust $ (intersect r) <$> sceneObjects s + possibleCollisions = P.map fromJust $ P.filter isJust $ (intersect r) <$> sceneObjects s camRay :: Float -> Float -> Camera -> Ray camRay x y c = Ray (eye c) (normalize $ lowerLeft c + x *^ xDir c + y *^ yDir c - eye c) @@ -126,8 +130,8 @@ intersect (Ray ro rd) s@(S (Sphere sc sr _)) = if (d > 0 && int > 0) then pos = ro + (rd ^* int) int = case ints of [] -> 0 - a -> foldl1 min a - ints = filter (uncurry (&&).(&&&) (>epsilon) (not.isNaN)) [(-b-(sqrt d))/(2*a),(-b+(sqrt d))/(2*a)] + a -> P.foldl1 min a + ints = P.filter (uncurry (&&).(&&&) (>epsilon) (not.isNaN)) [(-b-(sqrt d))/(2*a),(-b+(sqrt d))/(2*a)] intersect (Ray ro rd) p@(P (Plane pc pn _)) = if det == 0 || t < epsilon then Nothing else Just $ Collision pos pn t p @@ -136,8 +140,36 @@ intersect (Ray ro rd) p@(P (Plane pc pn _)) = if det == 0 || t < epsilon ! det = dot rd' pn t = (dot (pc - ro) pn)/det rd' = normalize rd -intersect _ _ = error "intersection with unknown object" +intersect (Ray ro rd) m@(M (Mesh s _ v f n fn b)) = case catMaybes . elems $ possHits of + [] -> Nothing + a -> Just . P.head . L.sort $ a + where + possHits = case s of + Flat -> hitsFlat v fn `IM.mapWithKey` f + --Phong -> hitsPhong v n <$> f + _ -> undefined + hitsFlat :: IntMap (V3 Float) -> IntMap (V3 Float) -> Int -> V3 Int -> Maybe Collision + hitsFlat verts norm f (V3 w1 w2 w3) = + if det == 0 || t < epsilon || not det2 + then Nothing + else Just $ Collision pos (norm IM.! f) t m + where + ! det = dot rd' (norm IM.! f) --do we hit the plane + rd' = normalize rd + t = (dot ((verts IM.! w2) - ro) (norm IM.! f))/det --when do we hit the plane + pos = ro + t *^ rd' --where do we hit the plane + v1 = (verts IM.! w1) - (verts IM.! w2) + v2 = (verts IM.! w3) - (verts IM.! w2) + det2v = V3 (normalize v1) (normalize v2) (norm IM.! f) !* (pos - (verts IM.! w2)) + --det2v = case D.trace (show $ det2m !* (pos - (verts IM.! w2))) (inv33 det2m) of + -- Nothing -> V3 1 1 1 + -- Just m -> m !* (pos - (verts IM.! w2)) + -- fromJust is justified as we only make a base-change and all 3 + -- vectors are linear independent. + det2 = det2v ^. _x > 0 && det2v ^. _y > 0 + && det2v ^. _x + det2v ^. _y < 1 + --hitsPhong :: IntMap (V3 Float) -> IntMap (V3 Float) -> V3 Int -> Maybe Collision -- deprecated - wrong calculation of rays. rotCam :: Float -> Float -> Int -> Int -> V3 Float -> V3 Float -> Float -> V3 Float