vectorized and inlined

This commit is contained in:
nek0 2018-10-26 04:18:06 +02:00
parent 8c585767ec
commit 51fecc5b7c
2 changed files with 40 additions and 13 deletions

View file

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

View file

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