vectorized and inlined
This commit is contained in:
parent
8c585767ec
commit
51fecc5b7c
2 changed files with 40 additions and 13 deletions
|
@ -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
|
||||||
|
|
48
src/Main.hs
48
src/Main.hs
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue