switch terminal handling library to vty

This commit is contained in:
nek0 2020-04-25 14:59:22 +02:00
parent 8103104941
commit 824ca45298
4 changed files with 72 additions and 51 deletions

View File

@ -23,13 +23,14 @@ executable raycharles
build-depends: base >=4.11 && <5 build-depends: base >=4.11 && <5
, linear , linear
, matrix , matrix
, ansi-terminal -- , ansi-terminal
-- , terminal-size
, suspend , suspend
, monad-loops , monad-loops
, terminal-size
, deepseq , deepseq
, parallel , parallel
, vector , vector
, vty
hs-source-dirs: src hs-source-dirs: src
ghc-options: -Wall -threaded ghc-options: -Wall -threaded
default-language: Haskell2010 default-language: Haskell2010

View File

@ -4,8 +4,8 @@ let
inherit (nixpkgs) pkgs; inherit (nixpkgs) pkgs;
f = { mkDerivation, ansi-terminal, base, deepseq, linear, matrix f = { mkDerivation, base, deepseq, linear, matrix, monad-loops
, monad-loops, parallel, stdenv, suspend, terminal-size, vector , parallel, stdenv, suspend, vector, vty
}: }:
mkDerivation { mkDerivation {
pname = "raycharles"; pname = "raycharles";
@ -14,8 +14,7 @@ let
isLibrary = false; isLibrary = false;
isExecutable = true; isExecutable = true;
executableHaskellDepends = [ executableHaskellDepends = [
ansi-terminal base deepseq linear matrix monad-loops parallel base deepseq linear matrix monad-loops parallel suspend vector vty
suspend terminal-size vector
]; ];
description = "A simple raytracer on the Console"; description = "A simple raytracer on the Console";
license = stdenv.lib.licenses.bsd3; license = stdenv.lib.licenses.bsd3;

View File

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

View File

@ -1,10 +1,12 @@
module Types where module Types where
import Linear import Linear
import Graphics.Vty (Vty)
data State = State data State = State
{ pos :: V2 Double { pos :: V2 Double
, rot :: Double , rot :: Double
, stop :: Bool , stop :: Bool
, output :: String , output :: String
, vty :: Vty
} }