minor performace improvements, began adding bounding-boxes for meshes

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
 

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

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

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 ((render w h s <$> [0..w*h-1]) `using` parListChunk w rseq)
-                    imvec  = fromList imdata
+                    im     = generateImage (v3ToPixel w imvec) w h
-                    im     = generateImage (\x y -> imvec ! (x*w+(h-y-1))) 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)

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 :: Int -> Int -> Scene -> Int -> V3 Word8
-render w h s index = PixelRGB8 (ci cr) (ci cg) (ci cb)
+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
+            ! blocked = raytrace (Ray pos lightdir) s
-            lightdir = (lpos - pos)
+            ! 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

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 
+data BoundingBox = BoundingBox
-                  | OpP Plane 
+            { boundX         :: (Float, Float)
-                  | OpM Mesh 
+            , boundY         :: (Float, Float)
-                  | OpC Camera 
+            , boundZ         :: (Float, Float)
-                  | OpL Light 
+            }
-                  | OpR RecursionDepth 
+
-                  | OpA Ambience 
+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)