compile fixup

This commit is contained in:
Corey O'Connor 2014-05-26 21:46:33 -07:00
parent 522b740b8a
commit aa67f22b38
6 changed files with 29 additions and 13 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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.
--

View File

@ -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.

View File

@ -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