From a1157e2ec4b80bf4075650c1ad4fb6d25bca84a5 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Fri, 31 Oct 2014 13:22:40 +0100 Subject: [PATCH] minor performace improvements, began adding bounding-boxes for meshes --- raytrace.cabal | 3 +-- raytrace.sh | 2 +- scenes/spheres/spheres.sce | 2 +- src/Main.hs | 16 ++++++++++++---- src/Scene/Renderer.hs | 31 ++++++++++++++++--------------- src/Scene/Types.hs | 32 +++++++++++++++++++++++--------- 6 files changed, 54 insertions(+), 32 deletions(-) diff --git a/raytrace.cabal b/raytrace.cabal index 034554f..7f4971d 100644 --- a/raytrace.cabal +++ b/raytrace.cabal @@ -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 diff --git a/raytrace.sh b/raytrace.sh index ef18d8c..72fa9e1 100755 --- a/raytrace.sh +++ b/raytrace.sh @@ -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 diff --git a/scenes/spheres/spheres.sce b/scenes/spheres/spheres.sce index 5fc4067..4a70eef 100644 --- a/scenes/spheres/spheres.sce +++ b/scenes/spheres/spheres.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 \ No newline at end of file +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 efa6c60..25da04b 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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) diff --git a/src/Scene/Renderer.hs b/src/Scene/Renderer.hs index b7c7dc4..4255f44 100644 --- a/src/Scene/Renderer.hs +++ b/src/Scene/Renderer.hs @@ -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 diff --git a/src/Scene/Types.hs b/src/Scene/Types.hs index 6db08a0..09c35cf 100644 --- a/src/Scene/Types.hs +++ b/src/Scene/Types.hs @@ -1,6 +1,7 @@ module Scene.Types where import Linear (V3) +import qualified Data.Vector as V type Color = V3 Float type Intensity = Float @@ -20,7 +21,7 @@ data Camera = Camera type RecursionDepth = Int -data Background = Background +data Background = Background { bgColor :: Color } deriving (Show, Eq) @@ -41,7 +42,7 @@ data Material = Material , materialReflection :: Float } deriving (Show, Eq) - + data Sphere = Sphere { sphereCenter :: V3 Float @@ -67,13 +68,26 @@ data Mesh = Mesh } deriving (Show, Eq) -data ObjectParser = OpS Sphere - | OpP Plane - | OpM Mesh - | OpC Camera - | OpL Light - | OpR RecursionDepth - | OpA Ambience +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 + | OpC Camera + | OpL Light + | OpR RecursionDepth + | OpA Ambience | OpB Background deriving (Show, Eq)