4f93146 · vty · git.iko.soy

git.iko.soy/vty

on master help sign in

use vtime and vmin to implement timing.

4f93146Corey O'Connor13 years ago

CHANGELOG+8−5

compare with master

unifiedsplit

@@ -1,13 +1,16 @@

15.0.0

2− * removed the typeclass based terminal and display context interface in favor of a data

3− structure of properties interface.

4 * input handling changes

2 * input handling changes

5 * KASCII is now KChar

3 * KASCII is now KChar

6 * KPN5 is now KCenter

4 * KPN5 is now KCenter

7 * tests exist.

5 * tests exist.

8− * the default amount of time between ESC and a subsequent character that causes VTY to

6+ * terminal timing is now handled by selecting an appropriate VTIME. Previously this was

9− interpret the input as "ESC" then the character, versus some special key, has been

7+ implemented within Vty itself. This reduced complexity in vty but potentially affects

10− increased to 4000 microseconds; 4 milliseconds.

8+ meta key handling.

9+ * The time vty will wait to verify an ESC byte means a single ESC key is the

10+ singleEscPeriod of the Input Config structure.

11+ * The input config can be changed dynamically.

12+ * removed the typeclass based terminal and display context interface in favor of a data

13+ structure of properties interface.

11 * renamed the Terminal interface to Output

14 * renamed the Terminal interface to Output

12 * The default picture for an image now uses the "clear" background. This background fills

15 * The default picture for an image now uses the "clear" background. This background fills

13 background spans with spaces or just ends the line.

16 background spans with spaces or just ends the line.

src/Graphics/Vty.hs+6−5

@@ -43,6 +43,7 @@ import Graphics.Vty.Picture

44import Control.Concurrent

46+import Data.Default

46import Data.IORef

47import Data.IORef

48import qualified System.Console.Terminfo as Terminfo

49import qualified System.Console.Terminfo as Terminfo

@@ -88,15 +89,15 @@ data Vty = Vty

88-- | Set up the state object for using vty. At most one state object should be

89-- | Set up the state object for using vty. At most one state object should be

89-- created at a time.

90-- created at a time.

90mkVty :: IO Vty

91mkVty :: IO Vty

91−mkVty = mkVtyEscDelay defaultEscDelay

92+mkVty = mkVtyEscDelay def

93-- | Set up the state object for using vty. At most one state object should be

94-- | Set up the state object for using vty. At most one state object should be

94-- created at a time. The delay, in microseconds, specifies the period of time to wait for a key

95-- created at a time. The delay, in microseconds, specifies the period of time to wait for a key

95-- following reading ESC from the terminal before considering the ESC key press as a discrete event.

96-- following reading ESC from the terminal before considering the ESC key press as a discrete event.

96-- \todo move input init into terminal interface

97-- \todo move input init into terminal interface

97−mkVtyEscDelay :: Int -> IO Vty

98+mkVtyEscDelay :: Config -> IO Vty

98−mkVtyEscDelay escDelay = do

99+mkVtyEscDelay config = do

99− input <- input_for_current_terminal escDelay

100+ input <- input_for_current_terminal config

100 out <- output_for_current_terminal

101 out <- output_for_current_terminal

101 intMkVty input out

102 intMkVty input out

102

103

@@ -149,7 +150,7 @@ intMkVty input out = do

149 >> readIORef last_pic_ref

150 >> readIORef last_pic_ref

150 >>= maybe ( return () ) ( \pic -> inner_update pic )

151 >>= maybe ( return () ) ( \pic -> inner_update pic )

151

152

152− let gkey = do k <- readChan $ event_channel input

153+ let gkey = do k <- readChan $ _event_channel input

153 case k of

154 case k of

154 (EvResize _ _) -> inner_refresh

155 (EvResize _ _) -> inner_refresh

155 >> display_bounds out

156 >> display_bounds out

src/Graphics/Vty/Input.hs+12−15

@@ -36,7 +36,7 @@ module Graphics.Vty.Input ( Key(..)

36 , Button(..)

37 , Event(..)

38 , Input(..)

39− , defaultEscDelay

39+ , Config(..)

40 , input_for_current_terminal

41 , input_for_name_and_io

42 )

@@ -90,29 +90,26 @@ input_for_current_terminal config = do

90-- - extended functions are disabled. Uh. Whatever these are.

91--

92input_for_name_and_io :: Config -> String -> Fd -> IO Input

93−input_for_name_and_io config term_name term_in = do

93+input_for_name_and_io config term_name term_fd = do

94 terminal <- Terminfo.setupTerm term_name

95− attr <- getTerminalAttributes term_in

95+ attr <- getTerminalAttributes term_fd

96 let attr' = foldl withoutMode attr [ StartStopOutput, KeyboardInterrupts

97 , EnableEcho, ProcessInput, ExtendedFunctions

98 ]

99− setTerminalAttributes term_in attr' Immediately

99+ setTerminalAttributes term_fd attr' Immediately

100− set_term_timing term_in

101 let classify_table = classify_table_for_term term_name terminal

100 let classify_table = classify_table_for_term term_name terminal

102− config_ref <- newIORef config

101+ apply_timing_config term_fd config

103− (eventChannel, shutdown_event_processing) <- initInputForFd config_ref classify_table term_in

102+ input <- newIORef config >>= \ref -> initInputForFd ref classify_table term_fd

104 let pokeIO = Catch $ do

103 let pokeIO = Catch $ do

105 let e = error "(getsize in input layer)"

104 let e = error "(getsize in input layer)"

106− setTerminalAttributes term_in attr' Immediately

105+ setTerminalAttributes term_fd attr' Immediately

107− writeChan eventChannel (EvResize e e)

106+ writeChan (_event_channel input) (EvResize e e)

108 _ <- installHandler windowChange pokeIO Nothing

107 _ <- installHandler windowChange pokeIO Nothing

109 _ <- installHandler continueProcess pokeIO Nothing

108 _ <- installHandler continueProcess pokeIO Nothing

110− return $ Input

109+ return $ input

111− { event_channel = eventChannel

112− , shutdown_input = do

110+ { shutdown_input = do

113− shutdown_event_processing

111+ shutdown_input input

114 _ <- installHandler windowChange Ignore Nothing

112 _ <- installHandler windowChange Ignore Nothing

115 _ <- installHandler continueProcess Ignore Nothing

113 _ <- installHandler continueProcess Ignore Nothing

116− setTerminalAttributes term_in attr Immediately

114+ setTerminalAttributes term_fd attr Immediately

117− , config_ref = config_ref

118 }

115 }

src/Graphics/Vty/Input/Internal.hs+31−124

@@ -16,7 +16,7 @@ import Control.Lens

16import Control.Exception (try, IOException)

17import Control.Monad (when, void, mzero)

18import Control.Monad.IO.Class (liftIO)

19−import Control.Monad.Trans.State (StateT(..))

19+import Control.Monad.Trans.State (StateT(..), evalStateT)

20import Control.Monad.Trans.Reader (ReaderT(..))

22import Data.Char

@@ -28,7 +28,7 @@ import Data.Maybe ( mapMaybe )

28import qualified Data.Set as S( fromList, member )

29import Data.Word

31−import Foreign ( alloca, poke, peek, peekArray, Ptr )

31+import Foreign ( allocaArray, peekArray, Ptr )

32import Foreign.C.Types (CInt(..))

34import System.Posix.IO ( fdReadBuf

@@ -38,16 +38,12 @@ import System.Posix.IO ( fdReadBuf

38import System.Posix.Types (Fd(..))

40data Config = Config

41− { controlSeqPeriod :: Int -- ^ default control sequence period is 10000 microseconds. Which is

42− -- assumed to be well above the sampling rate required to detect a

43− -- keyup for a person typing 200 wpm.

44− , metaComboPeriod :: Int -- ^ The default meta combo period is 100000 microseconds.

41+ { singleEscPeriod :: Int -- ^ The default is 100000 microseconds or 0.1 seconds.

45 } deriving (Show, Eq)

42 } deriving (Show, Eq)

47instance Default Config where

44instance Default Config where

48 def = Config

45 def = Config

49− { controlSeqPeriod = 10000

46+ { singleEscPeriod = 100000

50− , metaComboPeriod = 100000

51 }

47 }

53data Input = Input

49data Input = Input

@@ -95,7 +91,7 @@ loop_input_processor = do

95 read_from_device >>= add_bytes_to_process

91 read_from_device >>= add_bytes_to_process

96 _ <- many $ parse_event >>= emit

92 _ <- many $ parse_event >>= emit

97 drop_invalid

93 drop_invalid

98− stop_requested <|> loop_input_processor

94+ stop_if_requested <|> loop_input_processor

100add_bytes_to_process :: String -> InputM ()

96add_bytes_to_process :: String -> InputM ()

101add_bytes_to_process block = unprocessed_bytes <>= block

97add_bytes_to_process block = unprocessed_bytes <>= block

@@ -109,8 +105,7 @@ read_from_device = do

109 old_config <- use applied_config

105 old_config <- use applied_config

110 fd <- view input_fd

106 fd <- view input_fd

111 when (new_config /= old_config) $ do

107 when (new_config /= old_config) $ do

112− let vtime = min 255 $ metaComboPeriod new_config `div` 100000

108+ liftIO $ apply_timing_config fd new_config

113− liftIO $ set_term_timing fd 0 vtime

114 applied_config .= new_config

109 applied_config .= new_config

115 buffer_ptr <- use $ input_buffer.ptr

110 buffer_ptr <- use $ input_buffer.ptr

116 max_bytes <- use $ input_buffer.size

111 max_bytes <- use $ input_buffer.size

@@ -118,6 +113,11 @@ read_from_device = do

118 bytes_read <- fdReadBuf fd buffer_ptr (fromIntegral max_bytes)

113 bytes_read <- fdReadBuf fd buffer_ptr (fromIntegral max_bytes)

119 fmap (map $ chr . fromIntegral) $ peekArray (fromIntegral bytes_read) buffer_ptr

114 fmap (map $ chr . fromIntegral) $ peekArray (fromIntegral bytes_read) buffer_ptr

120

115

116+apply_timing_config :: Fd -> Config -> IO ()

117+apply_timing_config fd config =

118+ let vtime = min 255 $ singleEscPeriod config `div` 100000

119+ in set_term_timing fd 1 vtime

120+

121parse_event :: InputM Event

122parse_event = do

123 c <- use classifier

@@ -134,68 +134,11 @@ drop_invalid = do

134 b <- use unprocessed_bytes

135 when (c b == Invalid) $ unprocessed_bytes .= []

136

137−stop_requested :: InputM ()

137+stop_if_requested :: InputM ()

138−stop_requested = do

138+stop_if_requested = do

139 True <- (liftIO . readIORef) =<< use stop_request_ref

140 return ()

141

142−#if 0

143−data InputChunk

144− = StopInput

145− | InputChunk String

146− | InputBreak

147−

148−-- The input uses two magic character:

149−--

150−-- * '\xFFFD' for "stop processing"

151−-- * '\xFFFE' for "previous input chunk is complete" Which is used to differentiate a single ESC

152−-- from using ESC as meta or to indicate a control sequence.

153−--

154−-- | Read 'InputChunk' from the input channel, parse into one or more 'Event's, output to event

155−-- channel.

156−--

157−-- Each input chunk is added to the current chunk being processed. The current chunk is processed

158−-- with the provided function to determine events.

159−inputToEventThread :: (String -> KClass) -> Chan InputChunk -> Chan Event -> IO ()

160−inputToEventThread classifier inputChannel eventChannel = loop []

161− where

162− loop current =

163− c <- readChan inputChannel

164− case c of

165− StopInput -> return ()

166− -- the prefix is missing bytes and there are bytes available.

167− InputChunk chunk -> parse_until_prefix (current ++ chunk)

168− >>= loop

169− -- if there are bytes remaining after all events are parsed then the spacing after

170− InputBreak -> parse_until_prefix current

171− >> loop []

172− parse_until_prefix current = case classifier current of

173− Prefix -> return current

174− Invalid -> return []

175− Valid k m remaining -> do

176− writeChan eventChannel (EvKey k m)

177− parse_until_prefix remaining

178−

179− Prefix -> do

180− c <- readChan inputChannel

181− case c of

182− StopInput -> return ()

183− -- the prefix is missing bytes and there are bytes available.

184− InputChunk chunk -> loop (current ++ chunk)

185− -- the prefix is a control sequence that is unknown. Drop and move on to the next

186− MetaShiftChunk chunk -> loop chunk

187− -- drop the entirety of invalid sequences. Probably better to drop only the first

188− -- character. However, the read behavior of terminals (a single read corresponds to the

189− -- bytes of a single event) might mean this results in quicker error recovery from a

190− -- users perspective.

191− Invalid -> do

192− c <- readChan inputChannel

193− case c of

194− EndChunk -> return ()

195− InputChunk chunk -> loop chunk

196− Valid k m remaining -> writeChan eventChannel (EvKey k m) >> loop remaining

197−#endif

198−

199-- This makes a kind of tri. Has space efficiency issues with large input blocks.

142-- This makes a kind of tri. Has space efficiency issues with large input blocks.

200-- Likely building a parser and just applying that would be better.

143-- Likely building a parser and just applying that would be better.

201-- I did not write this so I might just rewrite it for better understanding. Not the best of

144-- I did not write this so I might just rewrite it for better understanding. Not the best of

@@ -249,6 +192,16 @@ utf8Length c

249 | c < 0xF0 = 3

192 | c < 0xF0 = 3

250 | otherwise = 4

193 | otherwise = 4

251

194

195+run_input_processor_loop :: ClassifyTable -> Input -> IORef Bool -> IO ()

196+run_input_processor_loop classify_table input stop_flag = do

197+ let buffer_size = 1024

198+ allocaArray buffer_size $ \(buffer_ptr :: Ptr Word8) -> do

199+ s0 <- InputState [] <$> readIORef (_config_ref input)

200+ <*> pure (InputBuffer buffer_ptr buffer_size)

201+ <*> pure stop_flag

202+ <*> pure (classify classify_table)

203+ runReaderT (evalStateT loop_input_processor s0) input

204+

252-- I gave a quick shot at replacing this code with some that removed the "odd" bits. The "obvious"

205-- I gave a quick shot at replacing this code with some that removed the "odd" bits. The "obvious"

253-- changes all failed testing. This is timing sensitive code.

206-- changes all failed testing. This is timing sensitive code.

254-- I now think I can replace this wil code that makes the time sensitivity explicit. I am waiting

207-- I now think I can replace this wil code that makes the time sensitivity explicit. I am waiting

@@ -257,60 +210,14 @@ utf8Length c

257--

210--

258-- This is an example of an algorithm where code coverage could be high, even 100%, but the

211-- This is an example of an algorithm where code coverage could be high, even 100%, but the

259-- algorithm still under tested. I should collect more of these examples...

212-- algorithm still under tested. I should collect more of these examples...

260−initInputForFd :: IORef Config -> ClassifyTable -> Fd -> IO (Chan Event, IO ())

213+initInputForFd :: IORef Config -> ClassifyTable -> Fd -> IO Input

261initInputForFd config_ref classify_table input_fd = do

214initInputForFd config_ref classify_table input_fd = do

262− eventChannel <- newChan

263−#if 0

264− should_exit <- newIORef False

215+ stop_flag <- newIORef False

265− let -- initial state: read bytes until a ESC. Emit bytes. Go to possible-control-seq state.

216+ input <- Input <$> newChan

266− -- possible-control-seq: read available bytes.

217+ <*> pure (writeIORef stop_flag True)

267− -- If time is < controlSeqPeriod then emit as chunk with ESC prefix.

218+ <*> pure config_ref

268− -- If time is < metaComboPeriod then emit chunk with Meta shift.

219+ <*> pure input_fd

269− -- If time is > metaComboPeriod then emit ESC event then chunk of bytes.

220+ _ <- forkIO $ run_input_processor_loop classify_table input stop_flag

270− inputThread :: IO ()

221+ return input

271− inputThread = do

272− let k = 1024

273− _ <- allocaArray k $ \(input_buffer :: Ptr Word8) -> do

274− let loop = do

275− setFdOption input_fd NonBlockingRead False

276− threadWaitRead input_fd

277− setFdOption input_fd NonBlockingRead True

278− _ <- try readAll :: IO (Either IOException ())

279− when (escDelay == 0) finishAtomicInput

280− loop

281− readAll = do

282− poke input_buffer 0

283− bytes_read <- fdReadBuf input_fd input_buffer 1

284− input_char <- fmap (chr . fromIntegral) $ peek input_buffer

285− when (bytes_read > 0) $ do

286− _ <- tryPutMVar hadInput () -- signal input

287− writeChan inputChannel input_char

288− readAll

289− loop

290− return ()

291− -- If there is no input for some time, this thread puts '\xFFFE' in the

292− -- inputChannel.

293− noInputThread :: IO ()

294− noInputThread = when (escDelay > 0) loop

295− where loop = do

296− takeMVar hadInput -- wait for some input

297− threadDelay escDelay -- microseconds

298− hadNoInput <- isEmptyMVar hadInput -- no input yet?

299− -- TODO(corey): there is a race between here and the inputThread.

300− when hadNoInput finishAtomicInput

301− loop

302− classifier = classify classify_table

303− eventThreadId <- forkIO $ void $ inputToEventThread classifier inputChannel eventChannel

304− inputThreadId <- forkIO $ input_thread

305− noInputThreadId <- forkIO $ noInputThread

306− -- TODO(corey): killThread is a bit risky for my tastes.

307− -- H - somewhat mitigated by sending a magic terminate character?

308− let shutdown_event_processing = do

309− killThread eventThreadId

310− killThread inputThreadId

311−#endif

312− let shutdown_event_processing = return ()

313−

314− return (eventChannel, shutdown_event_processing)

315

222

316foreign import ccall "vty_set_term_timing" set_term_timing :: Fd -> Int -> Int -> IO ()

223foreign import ccall "vty_set_term_timing" set_term_timing :: Fd -> Int -> Int -> IO ()