From 46b2b7fb29e743464e5ff3c81b5435c5340221d4 Mon Sep 17 00:00:00 2001
From: Stefan Dresselhaus <sdressel@techfak.uni-bielefeld.de>
Date: Sat, 25 Oct 2014 13:49:39 +0200
Subject: [PATCH] made parallel, added startup-script

---
 raytrace              |  1 -
 raytrace.cabal        | 10 ++++++----
 raytrace.sh           |  6 ++++++
 scenes/test.sce       | 24 ------------------------
 src/Main.hs           | 34 +++++++++++++++++++++-------------
 src/Scene/Renderer.hs |  2 +-
 6 files changed, 34 insertions(+), 43 deletions(-)
 delete mode 120000 raytrace
 create mode 100755 raytrace.sh
 delete mode 100644 scenes/test.sce

diff --git a/raytrace b/raytrace
deleted file mode 120000
index 207d8c6..0000000
--- a/raytrace
+++ /dev/null
@@ -1 +0,0 @@
-dist/build/raytrace/raytrace
\ No newline at end of file
diff --git a/raytrace.cabal b/raytrace.cabal
index c812032..034554f 100644
--- a/raytrace.cabal
+++ b/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
+
+
diff --git a/raytrace.sh b/raytrace.sh
new file mode 100755
index 0000000..ef18d8c
--- /dev/null
+++ b/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
diff --git a/scenes/test.sce b/scenes/test.sce
deleted file mode 100644
index 4a70eef..0000000
--- a/scenes/test.sce
+++ /dev/null
@@ -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
diff --git a/src/Main.hs b/src/Main.hs
index a69d0d3..efa6c60 100644
--- a/src/Main.hs
+++ b/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"
-    case validateAndParseScene f of
-      Left error -> putStrLn $ "Error: " ++ error
-      Right s -> do
-        let (w,h)  = (width . sceneCamera $ s, height . sceneCamera $ s)
-            imdata = map (render w h s) [0..w*h-1]
-            imvec  = fromList imdata
-            im     = generateImage (\x y -> imvec ! (x*w+(h-y-1))) w h
-        print s
-        print (w,h)
-        writePng "out.png" im
+    args <- getArgs
+    case args of
+        [] -> putStrLn "please specify a scene to render"
+        (a:_) -> do
+            !f <- B.readFile a
+            case validateAndParseScene f of
+              Left error -> putStrLn $ "Error: " ++ error
+              Right s -> do
+                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
+                writePng "out.png" im
diff --git a/src/Scene/Renderer.hs b/src/Scene/Renderer.hs
index 04274ca..6028de9 100644
--- a/src/Scene/Renderer.hs
+++ b/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)