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

minor performace improvements, began adding bounding-boxes for meshes

Browse Source
This commit is contained in:
Nicole Dresselhaus 2014-10-31 13:22:40 +01:00
parent 0ed69c96bf
commit a1157e2ec4
6 changed files with 54 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
raytrace.cabal
View File

@ -45,7 +45,6 @@ build-type: Simple
-- Constraint on the version of Cabal needed to build this package.
cabal-version: >=1.10
executable raytrace
-- .hs or .lhs file containing the Main module.
main-is: Main.hs
@ -73,5 +72,5 @@ executable raytrace
default-language: Haskell2010
ghc-options: -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3 -fllvm -eventlog
-- ghc-options: -Odph -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3 -fllvm -prof -auto-all

2
raytrace.sh
View File

@ -2,5 +2,5 @@ if [ -z $1 ]
then
echo "please specify scene"
else
dist/build/raytrace/raytrace $1 +RTS -s -N8 && eog out.png
dist/build/raytrace/raytrace $1 +RTS -s -N8 $2 && eog out.png
fi

16
src/Main.hs
View File

@ -5,7 +5,9 @@ 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.Vector.Storable hiding ((++),map, foldl, filter, foldl1)
import Linear (V3(..))
import Data.Word (Word8)
import Data.Functor
import Data.Maybe
import Control.Parallel.Strategies
@ -84,12 +86,18 @@ main = do
case args of
[] -> putStrLn "please specify a scene to render"
(a:_) -> do
putStrLn $ "reading and parsing "++ show a
!f <- B.readFile a
case validateAndParseScene f of
Left error -> putStrLn $ "Error: " ++ error
Right s -> do
putStrLn "redering..."
let (w,h) = (width . sceneCamera $ s, height . sceneCamera $ s)
!imdata = (render w h s <$> [0..w*h-1]) `using` parListChunk w rdeepseq
imvec = fromList imdata
im = generateImage (\x y -> imvec ! (x*w+(h-y-1))) w h
imvec = fromList ((render w h s <$> [0..w*h-1]) `using` parListChunk w rseq)
im = generateImage (v3ToPixel w imvec) w h
writePng "out.png" im
v3ToPixel :: Int -> Vector (V3 Word8) -> Int -> Int -> PixelRGB8
v3ToPixel w vec x y = PixelRGB8 r g b
where
V3 r g b = vec ! (x*w+y)

31
src/Scene/Renderer.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings, BangPatterns #-}
module Scene.Renderer (render) where
import Control.Applicative
@ -29,13 +29,13 @@ instance Ord Collision where
epsilon :: Float
epsilon = 0.00001
render :: Int -> Int -> Scene -> Int -> PixelRGB8
render w h s index = PixelRGB8 (ci cr) (ci cg) (ci cb)
render :: Int -> Int -> Scene -> Int -> V3 Word8
render w h s index = V3 (ci cr) (ci cg) (ci cb)
where
(V3 cr cg cb) = getColorFromRay (sceneRecursions s) ray s
ray@(Ray co _) = camRay x y (sceneCamera s)
y = fromIntegral $ index `mod` w
y = fromIntegral $ h - (index `mod` w) - 1
x = fromIntegral $ index `div` w
ci = floor . (clamp 0 255) . (*255)
--wrong format:
@ -53,13 +53,14 @@ getColorFromRay refLeft ray@(Ray raypos raydir) s = clamp 0 1 <$> color
-- + diffuse/spec lighting
+ (foldl1 (+) $ (diffuseAndSpec c s raypos) <$> sceneLights s)
-- + reflect
+ reflection ^* (materialReflection . getMaterial $ obj)
+ reflection
where
reflection = if refLeft == 0 || (materialReflection . getMaterial) obj == 0 then
! reflection = if refLeft == 0 || (materialReflection . getMaterial) obj == 0 then
V3 0 0 0
else
getColorFromRay (refLeft-1) (Ray (cpos + (cnor ^* (2 * epsilon))) refldir) s
reflcolor ^* (materialReflection . getMaterial $ obj)
where
reflcolor = getColorFromRay (refLeft-1) (Ray (cpos + (cnor ^* (2 * epsilon))) refldir) s
refldir = normalize ((eye3 - 2 *!! outer cnor cnor) !* raydir)
-- | Collision-Information, Scene, view-position, light
@ -73,18 +74,18 @@ diffuseAndSpec (Collision pos n _ obj) s co (Light lpos color int) =
else
diff + spec
where
spec = if dot n (normalize lightdir) < 0 || dot r v < 0
spec = if dot n ld < 0 || dot r v < 0
then V3 0 0 0
else i * (dot r v ** materialShinyness mat) *^ color * materialSpec mat
r = (dot n ld * 2 *^ n) - ld
ld = normalize lightdir
! ld = normalize lightdir
v = normalize $ co - pos
diff = if dot n (normalize lightdir) < 0
diff = if dot n ld < 0
then V3 0 0 0
else i * dot n (normalize lightdir) *^ color * materialDiffuse mat
else i * dot n ld *^ color * materialDiffuse mat
mat = getMaterial obj
blocked = raytrace (Ray pos lightdir) s
lightdir = (lpos - pos)
! blocked = raytrace (Ray pos lightdir) s
! lightdir = (lpos - pos)
i = case int of
Nothing -> 1
Just a -> a
@ -120,7 +121,7 @@ intersect (Ray ro rd) s@(S (Sphere sc sr _)) = if (d > 0 && int > 0) then
a = dot rd rd
b = 2 * dot rd oc
c = dot oc oc - sr*sr
d = b * b - 4 * a * c
! d = b * b - 4 * a * c
oc = ro - sc
pos = ro + (rd ^* int)
int = case ints of
@ -132,7 +133,7 @@ intersect (Ray ro rd) p@(P (Plane pc pn _)) = if det == 0 || t < epsilon
else Just $ Collision pos pn t p
where
pos = ro + t *^ rd'
det = dot rd' pn
! det = dot rd' pn
t = (dot (pc - ro) pn)/det
rd' = normalize rd
intersect _ _ = undefined

14
src/Scene/Types.hs
View File

@ -1,6 +1,7 @@
module Scene.Types where
import Linear (V3)
import qualified Data.Vector as V
type Color = V3 Float
type Intensity = Float
@ -67,6 +68,19 @@ data Mesh = Mesh
}
deriving (Show, Eq)
data BoundingBox = BoundingBox
{ boundX :: (Float, Float)
, boundY :: (Float, Float)
, boundZ :: (Float, Float)
}
data MeshObj = MeshObj
{ meshVertices :: V.Vector (V3 Float)
, meshFaces :: V.Vector (V3 Float)
, meshNormals :: V.Vector (V3 Float)
, meshBounds :: BoundingBox
}
data ObjectParser = OpS Sphere
| OpP Plane
| OpM Mesh