another great speed optimization
This commit is contained in:
nek0
parent
5c0346e3fb
commit
54406980dd
3 changed files with 131 additions and 60 deletions
|
|
@ -5,7 +5,7 @@ let
|
|||
inherit (nixpkgs) pkgs;
|
||||
|
||||
f = { mkDerivation, ansi-terminal, base, deepseq, linear, matrix
|
||||
, monad-loops, parallel, stdenv, suspend, terminal-size, timers
|
||||
, monad-loops, parallel, stdenv, suspend, terminal-size, vector
|
||||
}:
|
||||
mkDerivation {
|
||||
pname = "raycharles";
|
||||
|
|
@ -15,10 +15,8 @@ let
|
|||
isExecutable = true;
|
||||
executableHaskellDepends = [
|
||||
ansi-terminal base deepseq linear matrix monad-loops parallel
|
||||
suspend terminal-size timers
|
||||
suspend terminal-size vector
|
||||
];
|
||||
enableLibraryProfiling = true;
|
||||
enableExecutableProfiling = true;
|
||||
description = "A simple raytracer on the Console";
|
||||
license = stdenv.lib.licenses.bsd3;
|
||||
};
|
||||
|
|
|
|||
101
src/Main.hs
101
src/Main.hs
|
|
@ -1,6 +1,6 @@
|
|||
module Main where
|
||||
|
||||
import Linear
|
||||
import Linear as L
|
||||
|
||||
import Data.Matrix as M
|
||||
import qualified Data.Vector as V
|
||||
|
|
@ -40,6 +40,7 @@ fov = pi / 2
|
|||
main :: IO ()
|
||||
main = do
|
||||
hSetBuffering stdin NoBuffering
|
||||
hSetEcho stdin False
|
||||
hideCursor
|
||||
state <- newMVar (State (V2 10 3) 0 False "")
|
||||
c <- newMVar Nothing
|
||||
|
|
@ -55,8 +56,8 @@ main = do
|
|||
return s)
|
||||
outputs <- withMVar state draw
|
||||
withMVar state (\s -> when (not (stop s)) $ do
|
||||
let foutput = V.toList $ V.tail $
|
||||
V.foldl (\acc a -> acc V.++ V.singleton '\n' V.++ a)
|
||||
let foutput = V.toList $
|
||||
V.foldl (\acc a -> acc V.++ a V.++ V.singleton '\n')
|
||||
V.empty
|
||||
( outputs
|
||||
V.++ V.singleton (V.fromList $ show char)
|
||||
|
|
@ -65,6 +66,7 @@ main = do
|
|||
deepseq foutput (putStr foutput)
|
||||
)
|
||||
-- threadDelay msdelay
|
||||
hSetEcho stdin True
|
||||
showCursor
|
||||
|
||||
handleInput :: Maybe Char -> State -> IO State
|
||||
|
|
@ -90,20 +92,32 @@ handleInput (Just char) state = do
|
|||
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 = (V.generate (fromIntegral dh - 2)
|
||||
let dims@(dw, dh) = (min 160 w, min 60 (h - 4)) -- if w >= h then (w, w `div` 2) else (w, h)
|
||||
out = (V.generate (fromIntegral dh)
|
||||
((\mh ->
|
||||
V.map
|
||||
(\mw -> drawPixel dims (mw, mh))
|
||||
(\mw -> drawPixel prot ppos 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
|
||||
|
||||
drawPixel :: Double -> V2 Double -> (Int, Int) -> (Double, Double) -> Char
|
||||
drawPixel prot ppos (w, h) (ddw, ddh) =
|
||||
let rayLength = castRay2
|
||||
prot
|
||||
ppos
|
||||
(fromIntegral w, fromIntegral h)
|
||||
(ddw, ddh)
|
||||
in getPixel (fromMaybe 11 rayLength)
|
||||
castRay w h ddw ddh =
|
||||
|
||||
castRay
|
||||
:: Double
|
||||
-> V2 Double
|
||||
-> (Double, Double)
|
||||
-> (Double, Double)
|
||||
-> Maybe Double
|
||||
castRay prot ppos (w, h) (ddw, ddh) =
|
||||
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)))
|
||||
|
|
@ -115,12 +129,73 @@ draw (State ppos prot _ _) = do
|
|||
else acc
|
||||
else acc
|
||||
) Nothing iter
|
||||
{-# INLINE castRay #-}
|
||||
|
||||
castRay2
|
||||
:: Double
|
||||
-> V2 Double
|
||||
-> (Double, Double)
|
||||
-> (Double, Double)
|
||||
-> Maybe Double
|
||||
castRay2 prot ppos@(V2 ux uy) (w, h) (ddw, ddh) =
|
||||
let v@(V2 vx vy) = V2 0 1 `rotVec` (prot + (- fov / 2 + ddw * fov / w))
|
||||
stepx = signum vx
|
||||
stepy = signum vy
|
||||
tmaxx = (((fromIntegral :: Int -> Double) . floor) ux + stepx - ux) / vx
|
||||
tmaxy = (((fromIntegral :: Int -> Double) . floor) uy + stepy - uy) / vy
|
||||
tdeltax = stepx / vx
|
||||
tdeltay = stepy / vy
|
||||
tiles = (ux, uy) : buildTileList (tmaxx, tmaxy) (tdeltax, tdeltay) (stepx, stepy) (ux, uy) ppos
|
||||
in fmap (/ cos (- fov / 2 + ddh * fov / h)) (getRayColl ppos v tiles)
|
||||
{-# INLINE castRay2 #-}
|
||||
|
||||
getRayColl
|
||||
:: V2 Double
|
||||
-> V2 Double
|
||||
-> [(Double, Double)]
|
||||
-> Maybe Double
|
||||
getRayColl _ _ [] = Nothing
|
||||
getRayColl _ _ (_:[]) = Nothing
|
||||
getRayColl ppos@(V2 ux uy) v@(V2 vx vy) ((ptix, _):tile@(tix, tiy):ts) =
|
||||
case safeGet (floor tix) (floor tiy) Map.map of
|
||||
Just '#' ->
|
||||
let t = if (floor ptix :: Int) == (floor tix :: Int)
|
||||
then (((fromIntegral :: Int -> Double) . floor) tiy - uy) / vy
|
||||
else (((fromIntegral :: Int -> Double) . floor) tix - ux) / vx -- floor tix = ux + t * vx
|
||||
vec = (* t) <$> v
|
||||
in Just (sqrt $ vec `L.dot` vec)
|
||||
_ -> getRayColl ppos v (tile:ts)
|
||||
{-# INLINE getRayColl #-}
|
||||
|
||||
buildTileList
|
||||
:: (Double, Double)
|
||||
-> (Double, Double)
|
||||
-> (Double, Double)
|
||||
-> (Double, Double)
|
||||
-> V2 Double
|
||||
-> [(Double, Double)]
|
||||
buildTileList (tmaxx, tmaxy) delta@(tdeltax, tdeltay) rstep@(stepx, stepy) (x, y) ppos =
|
||||
if distance ppos (V2 x y) <= 9
|
||||
then if tmaxx < tmaxy
|
||||
then
|
||||
let ntmaxx = tmaxx + tdeltax
|
||||
nx = x + stepx
|
||||
in (nx, y) : buildTileList (ntmaxx, tmaxy) delta rstep (nx, y) ppos
|
||||
else
|
||||
let ntmaxy = tmaxy + tdeltay
|
||||
ny = y + stepy
|
||||
in (x, ny) : buildTileList (tmaxx, ntmaxy) delta rstep (x, ny) ppos
|
||||
else []
|
||||
{-# INLINE buildTileList #-}
|
||||
|
||||
getPixel :: Double -> Char
|
||||
getPixel l
|
||||
| l <= 3 = '█'
|
||||
| l <= 4.5 = '▓'
|
||||
| l <= 6 = '▒'
|
||||
| l <= 9 = '░'
|
||||
| otherwise = ' '
|
||||
|
||||
parVector :: NFData a => Strategy (V.Vector a)
|
||||
parVector vec =
|
||||
let vLen = V.length vec
|
||||
|
|
@ -130,8 +205,8 @@ draw (State ppos prot _ _) = do
|
|||
then do
|
||||
let v1 = V.unsafeSlice 0 half vec
|
||||
v2 = V.unsafeSlice half (vLen - half) vec
|
||||
parVector v1
|
||||
parVector v2
|
||||
void $ parVector v1
|
||||
void $ parVector v2
|
||||
return vec
|
||||
else
|
||||
evalChunk (vLen-1) >>
|
||||
|
|
@ -171,9 +246,7 @@ getKey = do
|
|||
return Nothing
|
||||
where
|
||||
forkGetChar mvar = do
|
||||
hSetEcho stdin False
|
||||
cs <- (: []) <$> hGetChar stdin
|
||||
hSetEcho stdin True
|
||||
when (not (null cs)) $ do
|
||||
_ <- putMVar mvar (head cs)
|
||||
return ()
|
||||
|
|
|
|||
18
src/Map.hs
18
src/Map.hs
|
|
@ -5,18 +5,18 @@ import Data.Matrix as M
|
|||
map :: Matrix Char
|
||||
map = fromLists
|
||||
[ ['#', '#', '#', '#', '#', '#', '#', '#', '#', '#', '#', '#', '#']
|
||||
, ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#', '#', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#', '#', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', '#', '#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', '#', '#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', ' ', ' ', ' ', '#', '#', '#', ' ', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', ' ', ' ', ' ', '#', '#', '#', ' ', ' ', '#', '#']
|
||||
, ['#', ' ', ' ', ' ', ' ', ' ', '#', '#', '#', ' ', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', ' ', ' ', ' ', '#', '#', '#', ' ', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', '#', '#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', '#', '#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#', '#', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#', '#', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#']
|
||||
, ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#']
|
||||
, ['#', '#', '#', '#', '#', '#', '#', '#', '#', '#', '#', '#', '#']
|
||||
]
|
||||
|
|
|
|||
Loading…
Reference in a new issue