mirror of
https://github.com/ilyakooo0/vty.git
synced 2024-12-01 22:53:37 +03:00
compile fixup
This commit is contained in:
parent
522b740b8a
commit
aa67f22b38
@ -127,7 +127,7 @@ userConfig = do
|
||||
overridePath <- tryJust (guard . isDoesNotExistError) $ getEnv "VTY_CONFIG_FILE"
|
||||
overrideConfig <- either (const $ return def) parseConfigFile overridePath
|
||||
debugLogPath <- tryJust (guard . isDoesNotExistError) $ getEnv "VTY_DEBUG_LOG"
|
||||
let debugLogConfig = either (const $ return def) (def { debugLog = Just debugLogPath })
|
||||
let debugLogConfig = either (const def) (\p -> def { debugLog = Just p }) debugLogPath
|
||||
return $ mconcat [userConfig, overrideConfig, debugLogConfig]
|
||||
|
||||
parseConfigFile :: FilePath -> IO Config
|
||||
|
@ -1,6 +1,7 @@
|
||||
module Graphics.Vty.Inline.Unsafe where
|
||||
|
||||
import Graphics.Vty
|
||||
import Graphics.Vty.Config (userConfig)
|
||||
|
||||
import Data.Default
|
||||
import Data.IORef
|
||||
@ -33,7 +34,8 @@ withOutput f = do
|
||||
mout <- readIORef globalOutput
|
||||
out <- case mout of
|
||||
Nothing -> do
|
||||
out <- outputForCurrentTerminal
|
||||
config <- userConfig
|
||||
out <- outputForCurrentTerminal config
|
||||
writeIORef globalOutput (Just out)
|
||||
return out
|
||||
Just out -> return out
|
||||
|
@ -71,6 +71,13 @@ makeLenses ''InputState
|
||||
|
||||
type InputM a = StateT InputState (ReaderT Input IO) a
|
||||
|
||||
logMsg :: String -> InputM ()
|
||||
logMsg msg = do
|
||||
d <- view inputDebug
|
||||
case d of
|
||||
Nothing -> return ()
|
||||
Just h -> liftIO $ hPutStrLn h msg >> hFlush h
|
||||
|
||||
-- this must be run on an OS thread dedicated to this input handling.
|
||||
-- otherwise the terminal timing read behavior will block the execution of the lightweight threads.
|
||||
loopInputProcessor :: InputM ()
|
||||
@ -85,11 +92,15 @@ addBytesToProcess :: String -> InputM ()
|
||||
addBytesToProcess block = unprocessedBytes <>= block
|
||||
|
||||
emit :: Event -> InputM ()
|
||||
emit event = view eventChannel >>= liftIO . flip writeChan event
|
||||
emit event = do
|
||||
logMsg $ "parsed event: " ++ show event
|
||||
view eventChannel >>= liftIO . flip writeChan event
|
||||
|
||||
-- There should be two versions of this method:
|
||||
-- 1. using VMIN and VTIME when under the threaded runtime
|
||||
-- 2. emulating VMIN and VTIME in userspace when under the non-threaded runtime.
|
||||
-- The timing requirements are assured by the VMIN and VTIME set for the device.
|
||||
--
|
||||
-- Precondition: Under the threaded runtime. Only current use is from a forkOS thread. That case
|
||||
-- satisfies precondition.
|
||||
-- TODO: When under the non-threaded runtime emulate VMIN and VTIME
|
||||
readFromDevice :: InputM String
|
||||
readFromDevice = do
|
||||
newConfig <- view configRef >>= liftIO . readIORef
|
||||
@ -100,11 +111,13 @@ readFromDevice = do
|
||||
appliedConfig .= newConfig
|
||||
bufferPtr <- use $ inputBuffer.ptr
|
||||
maxBytes <- use $ inputBuffer.size
|
||||
liftIO $ do
|
||||
stringRep <- liftIO $ do
|
||||
bytesRead <- fdReadBuf fd bufferPtr (fromIntegral maxBytes)
|
||||
if bytesRead > 0
|
||||
then fmap (map $ chr . fromIntegral) $ peekArray (fromIntegral bytesRead) bufferPtr
|
||||
else return []
|
||||
logMsg $ "input bytes: " ++ show stringRep
|
||||
return stringRep
|
||||
|
||||
applyTimingConfig :: Fd -> Config -> IO ()
|
||||
applyTimingConfig fd config =
|
||||
@ -170,9 +183,10 @@ initInputForFd config classifyTable inFd = do
|
||||
<*> pure (writeIORef stopFlag True)
|
||||
<*> newIORef config
|
||||
<*> pure inFd
|
||||
<*> maybe Nothing (\f -> Just <$> openFile f AppendMode)
|
||||
<*> maybe (return Nothing)
|
||||
(\f -> Just <$> openFile f AppendMode)
|
||||
(debugLog config)
|
||||
logClassifyTable classifyTable
|
||||
logClassifyTable input classifyTable
|
||||
_ <- forkOS $ runInputProcessorLoop classifyTable input stopFlag
|
||||
return input
|
||||
|
||||
|
@ -37,7 +37,7 @@ classifyTableForTerm :: String -> Terminal -> ClassifyTable
|
||||
classifyTableForTerm termName term =
|
||||
concat $ capsClassifyTable term keysFromCapsTable
|
||||
: universalTable
|
||||
: termSpecificTable termName
|
||||
: termSpecificTables termName
|
||||
|
||||
-- | key table applicable to all terminals.
|
||||
--
|
||||
|
@ -7,8 +7,6 @@ module Graphics.Vty.Input.Terminfo.ANSIVT where
|
||||
|
||||
import Graphics.Vty.Input.Events
|
||||
|
||||
import Data.List (isInfixOf, isPrefixOf)
|
||||
|
||||
-- | Encoding for navigation keys.
|
||||
--
|
||||
-- TODO: This is not the same as the input bytes pulled from teh caps table.
|
||||
|
@ -28,6 +28,8 @@ module Graphics.Vty.Output ( module Graphics.Vty.Output
|
||||
|
||||
import Graphics.Vty.Prelude
|
||||
|
||||
import Graphics.Vty.Config
|
||||
|
||||
import Graphics.Vty.Output.Interface
|
||||
import Graphics.Vty.Output.MacOSX as MacOSX
|
||||
import Graphics.Vty.Output.XTermColor as XTermColor
|
||||
|
Loading…
Reference in New Issue
Block a user