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)