|
|
|
@ -13,9 +13,11 @@ import Control.Concurrent.Suspend.Lifted
|
|
|
|
|
import Control.DeepSeq
|
|
|
|
|
import Control.Parallel.Strategies
|
|
|
|
|
|
|
|
|
|
import System.IO
|
|
|
|
|
import System.Console.ANSI as CA
|
|
|
|
|
import System.Console.Terminal.Size as TS
|
|
|
|
|
-- import System.IO
|
|
|
|
|
-- import System.Console.ANSI as CA
|
|
|
|
|
-- import System.Console.Terminal.Size as TS
|
|
|
|
|
|
|
|
|
|
import Graphics.Vty
|
|
|
|
|
|
|
|
|
|
-- import Debug.Trace as T
|
|
|
|
|
|
|
|
|
@ -42,21 +44,37 @@ vfov = pi / 2
|
|
|
|
|
|
|
|
|
|
main :: IO ()
|
|
|
|
|
main = do
|
|
|
|
|
hSetBuffering stdin NoBuffering
|
|
|
|
|
hSetEcho stdin False
|
|
|
|
|
hideCursor
|
|
|
|
|
state <- newMVar (State (V2 10 3) 0 False "")
|
|
|
|
|
c <- newMVar Nothing
|
|
|
|
|
-- hSetBuffering stdin NoBuffering
|
|
|
|
|
-- hSetEcho stdin False
|
|
|
|
|
-- hideCursor
|
|
|
|
|
cfg <- standardIOConfig
|
|
|
|
|
vty <- mkVty cfg
|
|
|
|
|
hideCursor (outputIface vty)
|
|
|
|
|
state <- newMVar (State (V2 10 3) 0 False "" vty)
|
|
|
|
|
-- c <- newMVar Nothing
|
|
|
|
|
whileM_ (not <$> stop <$> readMVar state) $ do
|
|
|
|
|
CA.clearScreen
|
|
|
|
|
_ <- takeMVar c
|
|
|
|
|
char <- getKey
|
|
|
|
|
putMVar c char
|
|
|
|
|
modifyMVar_ state (\s -> if (not (stop s))
|
|
|
|
|
then
|
|
|
|
|
withMVar c (\mvchar -> handleInput mvchar s)
|
|
|
|
|
else
|
|
|
|
|
return s)
|
|
|
|
|
-- CA.clearScreen
|
|
|
|
|
-- reserveDisplay (outputIface vty)
|
|
|
|
|
-- _ <- takeMVar c
|
|
|
|
|
-- char <- getKey
|
|
|
|
|
-- putMVar c char
|
|
|
|
|
rev <- nextEventNonblocking vty
|
|
|
|
|
char <- case rev of
|
|
|
|
|
Just (EvKey (KChar c) []) -> do
|
|
|
|
|
modifyMVar_ state (\s -> if (not (stop s))
|
|
|
|
|
then do
|
|
|
|
|
handleInput c s
|
|
|
|
|
else
|
|
|
|
|
return s)
|
|
|
|
|
return (Just c)
|
|
|
|
|
Just (EvKey (KEsc) []) -> do
|
|
|
|
|
modifyMVar_ state (\s ->
|
|
|
|
|
return s
|
|
|
|
|
{ stop = True
|
|
|
|
|
}
|
|
|
|
|
)
|
|
|
|
|
return Nothing
|
|
|
|
|
_ -> return Nothing
|
|
|
|
|
outputs <- withMVar state draw
|
|
|
|
|
withMVar state (\s -> when (not (stop s)) $ do
|
|
|
|
|
let foutput = V.toList $
|
|
|
|
@ -69,12 +87,13 @@ main = do
|
|
|
|
|
deepseq foutput (putStr foutput)
|
|
|
|
|
)
|
|
|
|
|
-- threadDelay msdelay
|
|
|
|
|
hSetEcho stdin True
|
|
|
|
|
showCursor
|
|
|
|
|
-- hSetEcho stdin True
|
|
|
|
|
-- showCursor
|
|
|
|
|
shutdown vty
|
|
|
|
|
|
|
|
|
|
handleInput :: Maybe Char -> State -> IO State
|
|
|
|
|
handleInput Nothing state = return state
|
|
|
|
|
handleInput (Just char) state = do
|
|
|
|
|
handleInput :: Char -> State -> IO State
|
|
|
|
|
-- handleInput Nothing state = return state
|
|
|
|
|
handleInput char state = do
|
|
|
|
|
let npos delta = if not (doesCollide (pos state + delta))
|
|
|
|
|
then pos state + delta
|
|
|
|
|
else pos state
|
|
|
|
@ -87,14 +106,14 @@ handleInput (Just char) state = do
|
|
|
|
|
{ rot = rot state + rotStep }
|
|
|
|
|
'a' -> state
|
|
|
|
|
{ rot = rot state - rotStep }
|
|
|
|
|
'\ESC' -> state
|
|
|
|
|
{ stop = True }
|
|
|
|
|
-- '\ESC' -> state
|
|
|
|
|
-- { stop = True }
|
|
|
|
|
_ -> state
|
|
|
|
|
return nstate
|
|
|
|
|
|
|
|
|
|
draw :: State -> IO (V.Vector (V.Vector Char))
|
|
|
|
|
draw (State ppos prot _ _) = do
|
|
|
|
|
(Just (Window h w)) <- TS.size :: IO (Maybe (Window Int))
|
|
|
|
|
draw (State ppos prot _ _ vty) = do
|
|
|
|
|
(w, h) <- displayBounds (outputIface vty)
|
|
|
|
|
let dims@(dw, dh) = (w, (h - 4))
|
|
|
|
|
out = (V.generate (fromIntegral dh)
|
|
|
|
|
((\mh ->
|
|
|
|
@ -234,22 +253,22 @@ rotVec (V2 x y) rad = V2 nx ny
|
|
|
|
|
ny = x * sin rad - y * cos rad
|
|
|
|
|
{-# INLINE rotVec #-}
|
|
|
|
|
|
|
|
|
|
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
|
|
|
|
|
cs <- (: []) <$> hGetChar stdin
|
|
|
|
|
when (not (null cs)) $ do
|
|
|
|
|
_ <- putMVar mvar (head cs)
|
|
|
|
|
return ()
|
|
|
|
|
-- 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
|
|
|
|
|
-- cs <- (: []) <$> hGetChar stdin
|
|
|
|
|
-- when (not (null cs)) $ do
|
|
|
|
|
-- _ <- putMVar mvar (head cs)
|
|
|
|
|
-- return ()
|
|
|
|
|