made parallel, added startup-script

raytrace

@@ -1 +0,0 @@
-dist/build/raytrace/raytrace

raytrace.cabal

@@ -50,8 +50,6 @@ executable raytrace
   -- .hs or .lhs file containing the Main module.
   main-is:             Main.hs
 
-  hs-source-dirs:      src
-  
   -- Modules included in this executable, other than Main.
   -- other-modules:       
   
@@ -65,11 +63,15 @@ executable raytrace
                        linear >= 1.10,
                        JuicyPixels >= 3.1,
                        parallel >= 3.2,
-                       vector >= 0.10
+                       vector >= 0.10,
+                       deepseq >= 1.3
   
   -- Directories containing source files.
-  -- hs-source-dirs:      
+  hs-source-dirs:      src
   
   -- Base language which the package is written in.
   default-language:    Haskell2010
   
+  ghc-options: -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3 -fllvm -eventlog
+
+

raytrace.sh

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

scenes/test.sce

@@ -1,24 +0,0 @@
-# camera: eye, center, up, fovy, width, height
-camera 1 3 8  1 1 0  0 1 0  45  500 500
-
-# recursion depth
-depth  5
-
-# background color
-background 0 0 0
-
-# global ambient light
-ambience   0.2 0.2 0.2
-
-# light: position and color
-light  0  50 0   0.3 0.3 0.3
-light  50 50 50  0.3 0.3 0.3
-light -50 50 50  0.3 0.3 0.3
-
-# spheres: center, radius, material
-sphere  0.0 1.0 0.0  1.0  1.0 0.0 0.0  1.0 0.0 0.0  1.0 1.0 1.0  100.0  0.2
-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

src/Main.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, BangPatterns #-}
 module Main where
 
 import Codec.Picture.Png
@@ -6,8 +6,11 @@ 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.Functor
 import Data.Maybe
-
+import Control.Parallel.Strategies
+import Control.DeepSeq
+import System.Environment
 
 import Scene.Parser
 import Scene.Renderer
@@ -71,17 +74,22 @@ validateAndParseScene f = do
                    , sceneObjects = objects
                    }
 
+instance NFData PixelRGB8
+    where
+        rnf (PixelRGB8 r g b) = r `seq` g `seq` b `seq` ()
 
 main :: IO ()
 main = do
-    f <- B.readFile "scenes/test.sce"
+    args <- getArgs
-    case validateAndParseScene f of
+    case args of
-      Left error -> putStrLn $ "Error: " ++ error
+        [] -> putStrLn "please specify a scene to render"
-      Right s -> do
+        (a:_) -> do
-        let (w,h)  = (width . sceneCamera $ s, height . sceneCamera $ s)
+            !f <- B.readFile a
-            imdata = map (render w h s) [0..w*h-1]
+            case validateAndParseScene f of
-            imvec  = fromList imdata
+              Left error -> putStrLn $ "Error: " ++ error
-            im     = generateImage (\x y -> imvec ! (x*w+(h-y-1))) w h
+              Right s -> do
-        print s
+                let (w,h)  = (width . sceneCamera $ s, height . sceneCamera $ s)
-        print (w,h)
+                    !imdata = (render w h s <$> [0..w*h-1]) `using` parListChunk w rdeepseq
-        writePng "out.png" im
+                    imvec  = fromList imdata
+                    im     = generateImage (\x y -> imvec ! (x*w+(h-y-1))) w h
+                writePng "out.png" im

src/Scene/Renderer.hs

@@ -88,7 +88,7 @@ raytrace r s = case possibleCollisions of
                     _  -> Just $ foldl1 min possibleCollisions
                where
                     possibleCollisions :: [Collision]
-                    possibleCollisions = map fromJust $ filter isJust $ (intersect r) <$> (sceneObjects s)
+                    possibleCollisions = map fromJust $ filter isJust $ (intersect r) <$> sceneObjects s
 
 camRay :: Float -> Float -> Camera -> Ray
 camRay x y c = Ray (eye c) (lowerLeft c + x *^ xDir c + y *^ yDir c - eye c)