9704f66 · vty · git.iko.soy

git.iko.soy/vty

on master help sign in

remove abstractions over vmin and vtime and correct input classifier

9704f66Corey O'Connor12 years ago

CHANGELOG+67−63

compare with master

unifiedsplit

@@ -1,67 +1,71 @@

1+5.1.0

2+ - vmin and vtime can be specified however the application requires. See Graphics.Vty.Config.

3+ - fixed the processing of input when vmin is set > 1.

15.0.0

55.0.0

2− * The naming convention now matches:

6+ - The naming convention now matches:

3− * http://www.haskell.org/haskellwiki/Programming_guidelines#Naming_Conventions

7+ - http://www.haskell.org/haskellwiki/Programming_guidelines#Naming_Conventions

4− * all projects using vty for input must be compiled with -threaded. Please notify vty author if

8+ - all projects using vty for input must be compiled with -threaded. Please notify vty author if

5− this is not acceptable.

9+ this is not acceptable.

6− * mkVtyEscDelay has been removed. Use "mkVty def". Which initialized vty with the default

10+ - mkVtyEscDelay has been removed. Use "mkVty def". Which initialized vty with the default

7− configuration.

11+ configuration.

8− * input handling changes

12+ - input handling changes

9− * KASCII is now KChar

13+ - KASCII is now KChar

10− * KPN5 is now KCenter

14+ - KPN5 is now KCenter

11− * tests exist.

15+ - tests exist.

12− * Applications can add to the input tables by setting inputMap of the Config.

16+ - Applications can add to the input tables by setting inputMap of the Config.

13− See Graphics.Vty.Config

17+ See Graphics.Vty.Config

14− * Users can define input table extensions that will apply to all vty applications.

18+ - Users can define input table extensions that will apply to all vty applications.

15− See Graphics.Vty.Config

19+ See Graphics.Vty.Config

16− * terminal timing is now handled by selecting an appropriate VTIME. Previously this was

20+ - terminal timing is now handled by selecting an appropriate VTIME. Previously this was

17− implemented within Vty itself. This reduced complexity in vty but provides a different

21+ implemented within Vty itself. This reduced complexity in vty but provides a different meta

18− meta key behavior and implies a requirement on -threaded.

22+ key behavior and implies a requirement on -threaded.

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

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

20− singleEscPeriod of the Input Config structure.

24+ singleEscPeriod of the Input Config structure.

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

25+ - removed the typeclass based terminal and display context interface in favor of a data

22− structure of properties interface.

26+ structure of properties interface.

23− * renamed the Terminal interface to Output

27+ - renamed the Terminal interface to Output

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

28+ - The default picture for an image now uses the "clear" background. This background fills

25− background spans with spaces or just ends the line.

29+ background spans with spaces or just ends the line.

26− * Previously the background defaulted to the space character. This causes issues copying

30+ - Previously the background defaulted to the space character. This causes issues copying

27− text from a text editor. The text would end up with extra spaces at the end of the line.

31+ text from a text editor. The text would end up with extra spaces at the end of the line.

28− * Layer support

32+ - Layer support

29− * Each layer is an image.

33+ - Each layer is an image.

30− * The layers for a picture are a list of images.

34+ - The layers for a picture are a list of images.

31− * The first image is the top-most layer. The images are ordered from top to bottom.

35+ - The first image is the top-most layer. The images are ordered from top to bottom.

32− * The transparent areas for a layer are the backgroundFill areas. backgroundFill is

36+ - The transparent areas for a layer are the backgroundFill areas. backgroundFill is

33− added to pad images when images of different sizes are joined.

37+ added to pad images when images of different sizes are joined.

34− * If the background is clear there is no background layer.

38+ - If the background is clear there is no background layer.

35− * If there is a background character then the bottom layer is the background layer.

39+ - If there is a background character then the bottom layer is the background layer.

36− * emptyPicture is a Picture with no layers and no cursor

40+ - emptyPicture is a Picture with no layers and no cursor

37− * addToTop and addToBottom add a layer to the top and bottom of the given Picture.

41+ - addToTop and addToBottom add a layer to the top and bottom of the given Picture.

38− * compatibility improvements:

42+ - compatibility improvements:

39− * terminfo based terminals with no cursor support are silently accepted. The cursor

43+ - terminfo based terminals with no cursor support are silently accepted. The cursor

40− visibility changes in the Picture will have no effect.

44+ visibility changes in the Picture will have no effect.

41− * alternate (setf/setb) color maps supported. Though colors beyond the first 8 are just a

45+ - alternate (setf/setb) color maps supported. Though colors beyond the first 8 are just a

42− guess.

46+ guess.

43− * added "rgbColor" for easy support of RGB specified colors.

47+ - added "rgbColor" for easy support of RGB specified colors.

44− * Both applications and users can add to the mapping used to translate from input bytes to

48+ - Both applications and users can add to the mapping used to translate from input bytes to

45− events.

49+ events.

46− * Additional information about input and output process can be appended to a debug log

50+ - Additional information about input and output process can be appended to a debug log

47− * Set environment variable VTY_DEBUG_LOG to path of debug log

51+ - Set environment variable VTY_DEBUG_LOG to path of debug log

48− * Or use "debugLog <path>" config directive

52+ - Or use "debugLog <path>" config directive

49− * Or set 'debugLog' property of the Config provided to mkVty.

53+ - Or set 'debugLog' property of the Config provided to mkVty.

50− * examples moved to vty-examples package. See test directory for cabal file.

54+ - examples moved to vty-examples package. See test directory for cabal file.

51− * vty-interactive-terminal-test

55+ - vty-interactive-terminal-test

52− * interactive test. Useful for building a bug report for vty's author.

56+ - interactive test. Useful for building a bug report for vty's author.

53− * test/interactive_terminal_test.hs

57+ - test/interactive_terminal_test.hs

54− * vty-event-echo

58+ - vty-event-echo

55− * view a input event log for vty. Example of interacting with user.

59+ - view a input event log for vty. Example of interacting with user.

56− * test/EventEcho.hs

60+ - test/EventEcho.hs

57− * vty-rouge

61+ - vty-rouge

58− * The start of a rouge-like game. Example of layers and image build operations.

62+ - The start of a rouge-like game. Example of layers and image build operations.

59− * test/Rouge.hs

63+ - test/Rouge.hs

60− * vty-benchmark

64+ - vty-benchmark

61− * benchmarks vty. A series of tests that push random pictures to the terminal. The

65+ - benchmarks vty. A series of tests that push random pictures to the terminal. The

62− random pictures are generated using QuickCheck. The same generators used in the

66+ random pictures are generated using QuickCheck. The same generators used in the

63− automated tests.

67+ automated tests.

64− * test/benchmark.hs

68+ - test/benchmark.hs

664.7.0.0

704.7.0.0

67 * API changes:

71 * API changes:

Demo.hs+3−1

@@ -16,7 +16,9 @@ eventBufferSize = 1000

16type App = RWST Vty () (Seq String) IO

18main = do

19− vty <- mkVty def

19+ vty <- if True -- change to false for emacs-like input processing

20+ then mkVty def

21+ else mkVty (def { vmin = Just 2, vtime = Just 100 } )

20 _ <- execRWST (vtyInteract False) vty Seq.empty

22 _ <- execRWST (vtyInteract False) vty Seq.empty

21 shutdown vty

23 shutdown vty

src/Graphics/Vty/Config.hs+20−13

@@ -93,7 +93,8 @@ import qualified Text.Parsec.Token as P

93type InputMap = [(Maybe String, String, Event)]

95data Config = Config

96− { specifiedEscPeriod :: Maybe Int -- < See 'singleEscPeriod'

96+ { vmin :: Maybe Int -- < See 'derivedVmin'

97+ , vtime :: Maybe Int -- < See 'derivedVtime'

97 -- | Debug information is appended to this file if not Nothing.

98 -- | Debug information is appended to this file if not Nothing.

98 , debugLog :: Maybe FilePath

99 , debugLog :: Maybe FilePath

99 -- | The (input byte, output event) pairs extend the internal input table of VTY and the table

100 -- | The (input byte, output event) pairs extend the internal input table of VTY and the table

@@ -103,26 +104,32 @@ data Config = Config

103 , inputMap :: InputMap

104 , inputMap :: InputMap

104 } deriving (Show, Eq)

105 } deriving (Show, Eq)

105

106

106−-- | AKA VTIME. The default is 100000 microseconds or 0.1 seconds. Set using the

107+-- | The default is 100 milliseconds, 0.1 seconds.

108+-- Set using the 'vtime' field of 'Config'

109+derivedVtime :: Config -> Int

110+derivedVtime = maybe 100 id . vtime

111+

112+-- | The default is 1 character.

107−-- 'specifiedEscPeriod' field of 'Config'

113+-- Set using the 'vmin' field of 'Config'

108−singleEscPeriod :: Config -> Int

114+derivedVmin :: Config -> Int

109−singleEscPeriod = maybe 100000 id . specifiedEscPeriod

115+derivedVmin = maybe 1 id . vmin

110

116

111instance Default Config where

117instance Default Config where

112 def = mempty

118 def = mempty

113

119

114instance Monoid Config where

120instance Monoid Config where

115 mempty = Config

121 mempty = Config

116− { specifiedEscPeriod = Nothing

122+ { vmin = Nothing

123+ , vtime = Nothing

117− , debugLog = mempty

124+ , debugLog = mempty

118− , inputMap = mempty

125+ , inputMap = mempty

119 }

126 }

120 mappend c0 c1 = Config

127 mappend c0 c1 = Config

121− -- latter config takes priority in specifiedEscPeriod

128+ -- latter config takes priority in vmin, vtime, debugInputLog

122− { specifiedEscPeriod = specifiedEscPeriod c1 <|> specifiedEscPeriod c0

129+ { vmin = vmin c1 <|> vmin c0

123− -- latter config takes priority in debugInputLog

130+ , vtime = vtime c1 <|> vtime c0

124− , debugLog = debugLog c1 <|> debugLog c0

131+ , debugLog = debugLog c1 <|> debugLog c0

125− , inputMap = inputMap c0 <> inputMap c1

132+ , inputMap = inputMap c0 <> inputMap c1

126 }

133 }

127

134

128type ConfigParser s a = ParsecT s () (Writer Config) a

135type ConfigParser s a = ParsecT s () (Writer Config) a

src/Graphics/Vty/Input/Classify.hs+4−4

@@ -33,11 +33,11 @@ compile table = cl' where

33 eventForInput = M.fromList table

34 cl' [] = Prefix

35 cl' inputBlock = case M.lookup inputBlock eventForInput of

36+ -- if the inputBlock is exactly what is expected for an event then consume the whole

37+ -- block and return the event

36 Just e -> Valid e []

38 Just e -> Valid e []

37 Nothing -> case S.member inputBlock prefixSet of

39 Nothing -> case S.member inputBlock prefixSet of

38 True -> Prefix

40 True -> Prefix

39− -- if the inputBlock is exactly what is expected for an event then consume the whole

40− -- block and return the event

41 -- look up progressively smaller tails of the input block until an event is found

42 -- The assumption is that the event that consumes the most input bytes should be

43 -- produced.

@@ -45,8 +45,8 @@ compile table = cl' where

45 -- H: There will always be one match. The prefixSet contains, by definition, all

46 -- prefixes of an event.

47 False ->

48− let inputTails = init $ tail $ tails inputBlock

48+ let inputPrefixes = reverse $ tail $ inits inputBlock

49− in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputTails of

49+ in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputPrefixes of

50 (s,e) : _ -> Valid e (drop (length s) inputBlock)

51 -- neither a prefix or a full event.

52 -- TODO: debug log

src/Graphics/Vty/Input/Loop.hs+18−9

@@ -8,6 +8,8 @@

8--

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

10-- behavior is still under tested. I should collect more of these examples...

11+--

12+-- reference: http://www.unixwiz.net/techtips/termios-vmin-vtime.html

11module Graphics.Vty.Input.Loop where

13module Graphics.Vty.Input.Loop where

13import Graphics.Vty.Config

15import Graphics.Vty.Config

@@ -30,7 +32,7 @@ import Foreign ( allocaArray, peekArray, Ptr )

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

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

32import System.IO

34import System.IO

33−import System.Posix.IO (fdReadBuf)

35+import System.Posix.IO (fdReadBuf, setFdOption, FdOption(..))

34import System.Posix.Terminal

36import System.Posix.Terminal

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

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

@@ -108,6 +110,7 @@ readFromDevice = do

108 oldConfig <- use appliedConfig

110 oldConfig <- use appliedConfig

109 fd <- view inputFd

111 fd <- view inputFd

110 when (newConfig /= oldConfig) $ do

112 when (newConfig /= oldConfig) $ do

113+ logMsg $ "new config: " ++ show newConfig

111 liftIO $ applyTimingConfig fd newConfig

114 liftIO $ applyTimingConfig fd newConfig

112 appliedConfig .= newConfig

115 appliedConfig .= newConfig

113 bufferPtr <- use $ inputBuffer.ptr

116 bufferPtr <- use $ inputBuffer.ptr

@@ -117,13 +120,12 @@ readFromDevice = do

117 if bytesRead > 0

120 if bytesRead > 0

118 then fmap (map $ chr . fromIntegral) $ peekArray (fromIntegral bytesRead) bufferPtr

121 then fmap (map $ chr . fromIntegral) $ peekArray (fromIntegral bytesRead) bufferPtr

119 else return []

122 else return []

120− logMsg $ "input bytes: " ++ show stringRep

123+ when (not $ null stringRep) $ logMsg $ "input bytes: " ++ show stringRep

121 return stringRep

124 return stringRep

122

125

123applyTimingConfig :: Fd -> Config -> IO ()

126applyTimingConfig :: Fd -> Config -> IO ()

124−applyTimingConfig fd config =

127+applyTimingConfig fd config = setTermTiming fd (derivedVmin config)

125− let vtime = min 255 $ singleEscPeriod config `div` 100000

128+ (derivedVtime config `div` 100)

126− in setTermTiming fd 1 vtime

127

129

128parseEvent :: InputM Event

130parseEvent :: InputM Event

129parseEvent = do

131parseEvent = do

@@ -131,6 +133,8 @@ parseEvent = do

131 b <- use unprocessedBytes

133 b <- use unprocessedBytes

132 case c b of

134 case c b of

133 Valid e remaining -> do

135 Valid e remaining -> do

136+ logMsg $ "valid parse: " ++ show e

137+ logMsg $ "remaining: " ++ show remaining

134 unprocessedBytes .= remaining

138 unprocessedBytes .= remaining

135 return e

139 return e

136 _ -> mzero

140 _ -> mzero

@@ -139,7 +143,9 @@ dropInvalid :: InputM ()

139dropInvalid = do

143dropInvalid = do

140 c <- use classifier

144 c <- use classifier

141 b <- use unprocessedBytes

145 b <- use unprocessedBytes

146+ when (c b == Invalid) $ do

147+ logMsg "dropping input bytes"

142− when (c b == Invalid) $ unprocessedBytes .= []

148+ unprocessedBytes .= []

143

149

144stopIfRequested :: InputM ()

150stopIfRequested :: InputM ()

145stopIfRequested = do

151stopIfRequested = do

@@ -166,10 +172,12 @@ attributeControl fd = do

166 unsetAttrs = setTerminalAttributes fd original Immediately

172 unsetAttrs = setTerminalAttributes fd original Immediately

167 return (setAttrs,unsetAttrs)

173 return (setAttrs,unsetAttrs)

168

174

169−logClassifyMap :: Input -> String -> ClassifyMap -> IO()

175+logInitialInputState :: Input -> String -> ClassifyMap -> IO()

170−logClassifyMap input termName classifyTable = case _inputDebug input of

176+logInitialInputState input termName classifyTable = case _inputDebug input of

171 Nothing -> return ()

177 Nothing -> return ()

172 Just h -> do

178 Just h -> do

179+ config <- readIORef $ _configRef input

180+ hPrintf h "initial (vmin,vtime): %s\n" (show (vmin config, vtime config))

173 forM_ classifyTable $ \i -> case i of

181 forM_ classifyTable $ \i -> case i of

174 (inBytes, EvKey k mods) -> hPrintf h "map %s %s %s %s\n" (show termName)

182 (inBytes, EvKey k mods) -> hPrintf h "map %s %s %s %s\n" (show termName)

175 (show inBytes)

183 (show inBytes)

@@ -179,6 +187,7 @@ logClassifyMap input termName classifyTable = case _inputDebug input of

179

187

180initInputForFd :: Config -> String -> ClassifyMap -> Fd -> IO Input

188initInputForFd :: Config -> String -> ClassifyMap -> Fd -> IO Input

181initInputForFd config termName classifyTable inFd = do

189initInputForFd config termName classifyTable inFd = do

190+ setFdOption inFd NonBlockingRead False

182 applyTimingConfig inFd config

191 applyTimingConfig inFd config

183 stopFlag <- newIORef False

192 stopFlag <- newIORef False

184 input <- Input <$> newChan

193 input <- Input <$> newChan

@@ -188,7 +197,7 @@ initInputForFd config termName classifyTable inFd = do

188 <*> maybe (return Nothing)

197 <*> maybe (return Nothing)

189 (\f -> Just <$> openFile f AppendMode)

198 (\f -> Just <$> openFile f AppendMode)

190 (debugLog config)

199 (debugLog config)

191− logClassifyMap input termName classifyTable

200+ logInitialInputState input termName classifyTable

192 _ <- forkOS $ runInputProcessorLoop classifyTable input stopFlag

201 _ <- forkOS $ runInputProcessorLoop classifyTable input stopFlag

193 return input

202 return input

194

203

test/VerifyConfig.hs+2−3

@@ -30,9 +30,8 @@ debugLog "/tmp/vty-debug.txt"

30|]

32exampleConfigConfig :: Config

33−exampleConfigConfig = Config

33+exampleConfigConfig = def

34− { specifiedEscPeriod = def

35− , debugLog = Just "/tmp/vty-debug.txt"

34+ { debugLog = Just "/tmp/vty-debug.txt"

36 , inputMap = [ (Nothing, "\ESC[B", EvKey KUp [])

35 , inputMap = [ (Nothing, "\ESC[B", EvKey KUp [])

37 , (Nothing, "\ESC[1;3B", EvKey KDown [MAlt])

36 , (Nothing, "\ESC[1;3B", EvKey KDown [MAlt])

38 , (Just "xterm", "\ESC[1;3B", EvKey KDown [MAlt])

37 , (Just "xterm", "\ESC[1;3B", EvKey KDown [MAlt])

vty.cabal+1−1

@@ -1,5 +1,5 @@

1name: vty

2−version: 5.0.2

2+version: 5.1.0

3license: BSD3

4license-file: LICENSE

5author: AUTHORS