cleaning and parallelizing

raycharles.cabal

@@ -24,10 +24,11 @@ executable raycharles
                      , linear
                      , matrix
                      , ansi-terminal
-                     , timers
                      , suspend
                      , monad-loops
                      , terminal-size
                      , deepseq
+                     , parallel
   hs-source-dirs:      src
+  ghc-options:         -Wall -threaded
   default-language:    Haskell2010

shell.nix

@@ -5,7 +5,7 @@ let
   inherit (nixpkgs) pkgs;
 
   f = { mkDerivation, ansi-terminal, base, deepseq, linear, matrix
-      , monad-loops, stdenv, suspend, terminal-size, timers
+      , monad-loops, parallel, stdenv, suspend, terminal-size, timers
       }:
       mkDerivation {
         pname = "raycharles";
@@ -14,9 +14,11 @@ let
         isLibrary = false;
         isExecutable = true;
         executableHaskellDepends = [
-          ansi-terminal base deepseq linear matrix monad-loops suspend
-          terminal-size timers
+          ansi-terminal base deepseq linear matrix monad-loops parallel
+          suspend terminal-size timers
         ];
+        enableLibraryProfiling = true;
+        enableExecutableProfiling = true;
         description = "A simple raytracer on the Console";
         license = stdenv.lib.licenses.bsd3;
       };

src/Main.hs

@@ -9,10 +9,9 @@ import Data.Maybe
 import Control.Monad
 import Control.Monad.Loops
 import Control.Concurrent
-import Control.Concurrent.Timer
 import Control.Concurrent.Suspend.Lifted
-import Control.Concurrent.MVar
 import Control.DeepSeq
+import Control.Parallel.Strategies
 
 import System.IO
 import System.Console.ANSI as CA
@@ -46,22 +45,22 @@ main = do
   c <- newMVar Nothing
   whileM_ (not <$> stop <$> readMVar state) $ do
     CA.clearScreen
-    takeMVar c
+    _ <- takeMVar c
     char <- getKey
     putMVar c char
     modifyMVar_ state (\s -> if (not (stop s))
       then
-        withMVar c (\char -> handleInput char s)
+        withMVar c (\mvchar -> handleInput mvchar s)
       else
         return s)
     outputs <- withMVar state draw
     withMVar state (\s -> when (not (stop s)) $ do
-      let output = L.intercalate "\n"
+      let foutput = L.intercalate "\n"
             ( outputs
             ++ [show char]
             ++ [show (pos s) ++ " " ++ show (rot s)]
             )
-      deepseq output (putStr output)
+      deepseq foutput (putStr foutput)
       )
     -- threadDelay msdelay
   showCursor
@@ -87,21 +86,21 @@ handleInput (Just char) state = do
   return nstate
 
 draw :: State -> IO [String]
-draw state@(State pos@(V2 x y) rot _ _) = do
-  (Just (Window h w)) <- TS.size
+draw (State ppos prot _ _) = do
+  (Just (Window h w)) <- TS.size :: IO (Maybe (Window Int))
   let dims@(dw, dh) = (min 160 w, min 60 h) -- if w >= h then (w, w `div` 2) else (w, h)
-      output = map
-        (\mh -> map (\mw -> drawPixel dims (mw, mh)) [1 .. fromIntegral dw])
+      out = parMap rpar
+        (\mh -> map(\mw -> drawPixel dims (mw, mh)) [1 .. fromIntegral dw])
         [1 .. fromIntegral dh - 2]
-  return output
+  return out
   where
     drawPixel (w, h) (ddw, ddh) =
       let rayLength = castRay (fromIntegral w) (fromIntegral h) ddw ddh
       in getPixel (fromMaybe 11 rayLength)
     castRay w h ddw ddh =
       let iter = [0, 0.01 .. 10]
-          collPos a = (pos + (V2 0 (a * cos (- fov / 2 + ddh * fov / h))
-            `rotVec` (rot - fov / 2 + ddw * fov / w)))
+          collPos a = (ppos + (V2 0 (a * cos (- fov / 2 + ddh * fov / h))
+            `rotVec` (prot - fov / 2 + ddw * fov / w)))
       in foldl (\acc a ->
           if isNothing acc
           then
@@ -125,6 +124,7 @@ doesCollide (V2 x y) =
     Just '#' -> True
     _        -> False
 
+rotVec :: Floating a => V2 a -> a -> V2 a
 rotVec (V2 x y) rad = V2 nx ny
   where
     nx = x * cos rad + y * sin rad