some kind of image ...

This commit is contained in:
Nicole Dresselhaus 2014-12-01 12:27:34 +01:00
parent 46ae09671b
commit 4f8be66d27
4 changed files with 42 additions and 11 deletions

View File

@ -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

View File

@ -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,7 +228,6 @@ 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
{ meshShading = s
, meshMaterial = m

View File

@ -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