vectorized and inlined

raycharles.cabal

@@ -29,6 +29,7 @@ executable raycharles
                      , terminal-size
                      , deepseq
                      , parallel
+                     , vector
   hs-source-dirs:      src
   ghc-options:         -Wall -threaded
   default-language:    Haskell2010

src/Main.hs

@@ -3,7 +3,7 @@ module Main where
 import Linear
 
 import Data.Matrix as M
-import Data.List as L
+import qualified Data.Vector as V
 import Data.Maybe
 
 import Control.Monad
@@ -55,11 +55,13 @@ main = do
         return s)
     outputs <- withMVar state draw
     withMVar state (\s -> when (not (stop s)) $ do
-      let foutput = L.intercalate "\n"
-            ( outputs
-            ++ [show char]
-            ++ [show (pos s) ++ " " ++ show (rot s)]
-            )
+      let foutput = V.toList $ V.tail $
+            V.foldl (\acc a -> acc V.++ V.singleton '\n' V.++ a)
+              V.empty
+              ( outputs
+              V.++ V.singleton (V.fromList $ show char)
+              V.++ V.singleton (V.fromList $ show (pos s) ++ " " ++ show (rot s))
+              )
       deepseq foutput (putStr foutput)
       )
     -- threadDelay msdelay
@@ -85,23 +87,27 @@ handleInput (Just char) state = do
         _ -> state
   return nstate
 
-draw :: State -> IO [String]
+draw :: State -> IO (V.Vector (V.Vector Char))
 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)
-      out = parMap rpar
-        (\mh -> map(\mw -> drawPixel dims (mw, mh)) [1 .. fromIntegral dw])
-        [1 .. fromIntegral dh - 2]
+      out = (V.generate (fromIntegral dh - 2)
+        ((\mh ->
+          V.map
+          (\mw -> drawPixel dims (mw, mh))
+          (V.generate (fromIntegral dw) fromIntegral)
+          ) . fromIntegral)
+        ) `using` parVector
   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]
+      let iter = V.generate (1000) ((/ 100) . fromIntegral) :: V.Vector Double
           collPos a = (ppos + (V2 0 (a * cos (- fov / 2 + ddh * fov / h))
             `rotVec` (prot - fov / 2 + ddw * fov / w)))
-      in foldl (\acc a ->
+      in V.foldl (\acc a ->
           if isNothing acc
           then
             if doesCollide (collPos a)
@@ -115,6 +121,24 @@ draw (State ppos prot _ _) = do
       | l <= 6    = '▒'
       | l <= 9    = '░'
       | otherwise = ' '
+    parVector :: NFData a => Strategy (V.Vector a)
+    parVector vec =
+      let vLen = V.length vec
+          half = vLen `div` 2
+          minChunk = 10
+      in  if vLen > minChunk
+          then do
+            let v1 = V.unsafeSlice 0 half vec
+                v2 = V.unsafeSlice half (vLen - half) vec
+            parVector v1
+            parVector v2
+            return vec
+          else
+            evalChunk (vLen-1) >>
+            return vec
+      where
+      evalChunk 0 = rpar (rdeepseq (vec V.! 0)) >> return vec
+      evalChunk i = rpar (rdeepseq (vec V.! i)) >> evalChunk (i-1)
 
 doesCollide :: V2 Double -> Bool
 doesCollide (V2 x y) =
@@ -123,12 +147,14 @@ doesCollide (V2 x y) =
     Nothing  -> True
     Just '#' -> True
     _        -> False
+{-# INLINE doesCollide #-}
 
-rotVec :: Floating a => V2 a -> a -> V2 a
+rotVec :: V2 Double -> Double -> V2 Double
 rotVec (V2 x y) rad = V2 nx ny
   where
     nx = x * cos rad + y * sin rad
     ny = x * sin rad - y * cos rad
+{-# INLINE rotVec #-}
 
 getKey :: IO (Maybe Char)
 getKey = do