Drezil/htrace
1
1
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

camera works correctly, picture upside down

Browse Source
This commit is contained in:
Nicole Dresselhaus 2014-10-24 21:18:22 +02:00
parent 494c03f988
commit 1ee771cf98
4 changed files with 106 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
src/Main.hs
View File

@ -1,20 +1,16 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Main where module Main where
import Control.Applicative
import Control.Arrow
import Codec.Picture.Png import Codec.Picture.Png
import Codec.Picture.Types import Codec.Picture.Types
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Char8 as B8
import Data.Vector hiding ((++),map, foldl, filter, foldl1) import Data.Vector hiding ((++),map, foldl, filter, foldl1)
import Data.Word (Word8)
import Data.Maybe import Data.Maybe
import Linear (V3(..), (^+^), (^*), (^-^), dot, axisAngle, rotate, cross)
import Data.Attoparsec
import Scene.Parser import Scene.Parser
import Scene.Renderer
import Scene.Types import Scene.Types
import Debug.Trace import Debug.Trace
@ -75,59 +71,6 @@ validateAndParseScene f = do
, sceneObjects = objects , sceneObjects = objects
} }
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
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 = Ray (eye cam) $ rotCam x y w h (center 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@(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 :: IO ()
main = do main = do

20
src/Scene/Parser.hs
View File

@ -1,12 +1,12 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Scene.Parser where module Scene.Parser (parseScene) where
import Control.Applicative import Control.Applicative
import Data.Attoparsec.ByteString.Char8 import Data.Attoparsec.ByteString.Char8
import Data.Functor import Data.Functor
import Data.ByteString as B import Data.ByteString as B
import Data.ByteString.Char8 as B8 import Data.ByteString.Char8 as B8
import Linear.V3 import Linear
import Scene.Types import Scene.Types
@ -89,6 +89,17 @@ parseCamera = do
skipSpace skipSpace
height' <- decimal height' <- decimal
endOfLine endOfLine
let xDir' = (normalize $ cross (center' ^-^ eye') up') ^* (im_width / w)
yDir' = (normalize $ cross xDir' view) ^* (im_height / h)
lowerLeft' = center' ^-^ (0.5 * w *^ xDir')
^-^ (0.5 * h *^ yDir')
im_height = 2*dist* tan (0.5*(frtr fovy')/180*pi)
im_width = w/h * im_height
view = (center' ^-^ eye')
dist = norm view
w = fromIntegral width'
h = fromIntegral height'
frtr = fromRational . toRational
return $ OpC $ Camera return $ OpC $ Camera
{ eye = eye' { eye = eye'
, center = center' , center = center'
@ -96,7 +107,12 @@ parseCamera = do
, fovy = (fromRational . toRational) fovy' , fovy = (fromRational . toRational) fovy'
, width = width' , width = width'
, height = height' , height = height'
, lowerLeft = lowerLeft'
, xDir = xDir'
, yDir = yDir'
} }
where
parsePlane :: Parser ObjectParser parsePlane :: Parser ObjectParser
parsePlane = do parsePlane = do

78
src/Scene/Renderer.hs Normal file
View File

@ -0,0 +1,78 @@
{-# LANGUAGE OverloadedStrings #-}
module Scene.Renderer (render) 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, foldl, filter, foldl1)
import Data.Word (Word8)
import Data.Maybe
import Linear
import Scene.Parser
import Scene.Types
import Debug.Trace
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
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
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) --Ray (eye cam) $ rotCam x y w h (center cam ^-^ eye cam) (up cam) (fovy cam)
cam = sceneCamera s
y = fromIntegral $ index `mod` w
x = fromIntegral $ index `div` w
ci = floor . (*255)
camRay :: Float -> Float -> Camera -> Ray
camRay x y c = Ray (eye c) (lowerLeft c ^+^ x *^ xDir c ^+^ y *^ yDir c ^-^ eye c)
rotateDegAx :: Float -> V3 Float -> V3 Float -> V3 Float
rotateDegAx phi axis = rotate q
where
q = axisAngle axis phi
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)
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
-- deprecated - wrong calculation of rays.
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*(-1)) up dir
dx = (x - (fromIntegral w) / 2)/(fromIntegral w)
dy = (y - (fromIntegral h) / 2)/(fromIntegral h)
rad = (*pi).(/180)

15
src/Scene/Types.hs
View File

@ -6,12 +6,15 @@ type Color = V3 Float
type Intensity = Float type Intensity = Float
data Camera = Camera data Camera = Camera
{ eye :: V3 Float { eye :: V3 Float
, center :: V3 Float , center :: V3 Float
, up :: V3 Float , up :: V3 Float
, fovy :: Float , fovy :: Float
, width :: Int , width :: Int
, height :: Int , height :: Int
, lowerLeft :: V3 Float
, xDir :: V3 Float
, yDir :: V3 Float
} }
deriving (Show, Eq) deriving (Show, Eq)