some more optimization
This commit is contained in:
parent
56425c2396
commit
3f9841522c
1 changed files with 39 additions and 10 deletions
49
src/Main.hs
49
src/Main.hs
|
@ -18,7 +18,7 @@ import System.IO
|
||||||
import System.Console.ANSI as CA
|
import System.Console.ANSI as CA
|
||||||
import System.Console.Terminal.Size as TS
|
import System.Console.Terminal.Size as TS
|
||||||
|
|
||||||
import Debug.Trace as T
|
-- import Debug.Trace as T
|
||||||
|
|
||||||
import qualified Map
|
import qualified Map
|
||||||
import Types
|
import Types
|
||||||
|
@ -43,24 +43,27 @@ main = do
|
||||||
hSetBuffering stdin NoBuffering
|
hSetBuffering stdin NoBuffering
|
||||||
hideCursor
|
hideCursor
|
||||||
state <- newMVar (State (V2 10 3) 0 False "")
|
state <- newMVar (State (V2 10 3) 0 False "")
|
||||||
c <- newMVar ' '
|
c <- newMVar Nothing
|
||||||
putStrLn "starting loop, press button"
|
|
||||||
whileM_ (not <$> stop <$> readMVar state) $ do
|
whileM_ (not <$> stop <$> readMVar state) $ do
|
||||||
CA.clearScreen
|
CA.clearScreen
|
||||||
takeMVar c
|
takeMVar c
|
||||||
char <- getChar
|
char <- getKey
|
||||||
putMVar c char
|
putMVar c char
|
||||||
modifyMVar_ state (\s -> if (not (stop s))
|
modifyMVar_ state (\s -> if (not (stop s))
|
||||||
then
|
then
|
||||||
withMVar c (\char -> handleInput (Just char) s)
|
withMVar c (\char -> handleInput char s)
|
||||||
else
|
else
|
||||||
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 output = L.intercalate "\n" outputs
|
let output = L.intercalate "\n"
|
||||||
|
( outputs
|
||||||
|
++ [show char]
|
||||||
|
++ [show (pos s) ++ " " ++ show (rot s)]
|
||||||
|
)
|
||||||
deepseq output (putStr output)
|
deepseq output (putStr output)
|
||||||
putStrLn ("\n" ++ [char] ++ "\n" ++ show (pos s) ++ " " ++ show (rot s)))
|
)
|
||||||
threadDelay msdelay
|
-- threadDelay msdelay
|
||||||
showCursor
|
showCursor
|
||||||
|
|
||||||
handleInput :: Maybe Char -> State -> IO State
|
handleInput :: Maybe Char -> State -> IO State
|
||||||
|
@ -86,7 +89,7 @@ handleInput (Just char) state = do
|
||||||
draw :: State -> IO [String]
|
draw :: State -> IO [String]
|
||||||
draw state@(State pos@(V2 x y) rot _ _) = do
|
draw state@(State pos@(V2 x y) rot _ _) = do
|
||||||
(Just (Window h w)) <- TS.size
|
(Just (Window h w)) <- TS.size
|
||||||
let dims@(dw, dh) = (w, 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)
|
||||||
output = map
|
output = map
|
||||||
(\mh -> map (\mw -> drawPixel dims (mw, mh)) [1 .. fromIntegral dw])
|
(\mh -> map (\mw -> drawPixel dims (mw, mh)) [1 .. fromIntegral dw])
|
||||||
[1 .. fromIntegral dh - 2]
|
[1 .. fromIntegral dh - 2]
|
||||||
|
@ -96,7 +99,7 @@ draw state@(State pos@(V2 x y) rot _ _) = do
|
||||||
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.02 .. 10]
|
let iter = [0, 0.05 .. 10]
|
||||||
collPos a = (pos + (V2 0 (a * cos (- fov / 2 + ddh * fov / h))
|
collPos a = (pos + (V2 0 (a * cos (- fov / 2 + ddh * fov / h))
|
||||||
`rotVec` (rot - fov / 2 + ddw * fov / w)))
|
`rotVec` (rot - fov / 2 + ddw * fov / w)))
|
||||||
in foldl (\acc a ->
|
in foldl (\acc a ->
|
||||||
|
@ -126,3 +129,29 @@ 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
|
||||||
|
|
||||||
|
getKey :: IO (Maybe Char)
|
||||||
|
getKey = do
|
||||||
|
charMVar <- newEmptyMVar
|
||||||
|
tid <- forkIO (forkGetChar charMVar)
|
||||||
|
threadDelay (msdelay `div` 5)
|
||||||
|
empty <- isEmptyMVar charMVar
|
||||||
|
if (not empty)
|
||||||
|
then do
|
||||||
|
killThread tid
|
||||||
|
Just <$> takeMVar charMVar
|
||||||
|
else do
|
||||||
|
killThread tid
|
||||||
|
return Nothing
|
||||||
|
where
|
||||||
|
forkGetChar mvar = do
|
||||||
|
hSetEcho stdin False
|
||||||
|
cs <- (: []) <$> hGetChar stdin
|
||||||
|
-- cs <- whileM
|
||||||
|
-- (not <$> hIsEOF stdin)
|
||||||
|
-- (hGetChar stdin)
|
||||||
|
hSetEcho stdin True
|
||||||
|
-- putStrLn cs
|
||||||
|
when (not (null cs)) $ do
|
||||||
|
_ <- putMVar mvar (head cs)
|
||||||
|
return ()
|
||||||
|
|
Loading…
Reference in a new issue