on master help sign in
remove abstractions over vmin and vtime and correct input classifier
commit9704f66a4979c898a336b311b8d725cf99eb2b16 authorCorey O'Connor <coreyoconnor@gmail.com> dateFri 6 Jun 2014, 09:09 (12 years ago) parent3e8c75e
7 files changed+115−94
CHANGELOG+67−63 Demo.hs+3−1 src/Graphics/Vty/Config.hs+20−13 src/Graphics/Vty/Input/Classify.hs+4−4 src/Graphics/Vty/Input/Loop.hs+18−9 test/VerifyConfig.hs+2−3 vty.cabal+1−1
CHANGELOG+67−63
@@ -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.
4+
155.0.0
2− * The naming convention now matches:
3− * 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
5− this is not acceptable.
6− * mkVtyEscDelay has been removed. Use "mkVty def". Which initialized vty with the default
7− configuration.
8− * input handling changes
9− * KASCII is now KChar
10− * KPN5 is now KCenter
11− * tests exist.
12− * Applications can add to the input tables by setting inputMap of the Config.
13− See Graphics.Vty.Config
14− * Users can define input table extensions that will apply to all vty applications.
15− See Graphics.Vty.Config
16− * 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
18− meta 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
20− singleEscPeriod of the Input Config structure.
21− * removed the typeclass based terminal and display context interface in favor of a data
22− structure of properties interface.
23− * renamed the Terminal interface to Output
24− * The default picture for an image now uses the "clear" background. This background fills
25− background spans with spaces or just ends the line.
26− * 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.
28− * Layer support
29− * Each layer is an image.
30− * 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.
32− * The transparent areas for a layer are the backgroundFill areas. backgroundFill is
33− added to pad images when images of different sizes are joined.
34− * 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.
36− * 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.
38− * compatibility improvements:
39− * terminfo based terminals with no cursor support are silently accepted. The cursor
40− 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
42− guess.
43− * 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
45− events.
46− * 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
48− * Or use "debugLog <path>" config directive
49− * Or set 'debugLog' property of the Config provided to mkVty.
50− * examples moved to vty-examples package. See test directory for cabal file.
51− * vty-interactive-terminal-test
52− * interactive test. Useful for building a bug report for vty's author.
53− * test/interactive_terminal_test.hs
54− * vty-event-echo
55− * view a input event log for vty. Example of interacting with user.
56− * test/EventEcho.hs
57− * vty-rouge
58− * The start of a rouge-like game. Example of layers and image build operations.
59− * test/Rouge.hs
60− * vty-benchmark
61− * 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
63− automated tests.
64− * test/benchmark.hs
6+ - The naming convention now matches:
7+ - http://www.haskell.org/haskellwiki/Programming_guidelines#Naming_Conventions
8+ - all projects using vty for input must be compiled with -threaded. Please notify vty author if
9+ this is not acceptable.
10+ - mkVtyEscDelay has been removed. Use "mkVty def". Which initialized vty with the default
11+ configuration.
12+ - input handling changes
13+ - KASCII is now KChar
14+ - KPN5 is now KCenter
15+ - tests exist.
16+ - Applications can add to the input tables by setting inputMap of the Config.
17+ See Graphics.Vty.Config
18+ - Users can define input table extensions that will apply to all vty applications.
19+ See Graphics.Vty.Config
20+ - terminal timing is now handled by selecting an appropriate VTIME. Previously this was
21+ implemented within Vty itself. This reduced complexity in vty but provides a different meta
22+ key behavior and implies a requirement on -threaded.
23+ - The time vty will wait to verify an ESC byte means a single ESC key is the
24+ singleEscPeriod of the Input Config structure.
25+ - removed the typeclass based terminal and display context interface in favor of a data
26+ structure of properties interface.
27+ - renamed the Terminal interface to Output
28+ - The default picture for an image now uses the "clear" background. This background fills
29+ background spans with spaces or just ends the line.
30+ - Previously the background defaulted to the space character. This causes issues copying
31+ text from a text editor. The text would end up with extra spaces at the end of the line.
32+ - Layer support
33+ - Each layer is an image.
34+ - The layers for a picture are a list of images.
35+ - The first image is the top-most layer. The images are ordered from top to bottom.
36+ - The transparent areas for a layer are the backgroundFill areas. backgroundFill is
37+ added to pad images when images of different sizes are joined.
38+ - If the background is clear there is no background layer.
39+ - If there is a background character then the bottom layer is the background layer.
40+ - emptyPicture is a Picture with no layers and no cursor
41+ - addToTop and addToBottom add a layer to the top and bottom of the given Picture.
42+ - compatibility improvements:
43+ - terminfo based terminals with no cursor support are silently accepted. The cursor
44+ visibility changes in the Picture will have no effect.
45+ - alternate (setf/setb) color maps supported. Though colors beyond the first 8 are just a
46+ guess.
47+ - added "rgbColor" for easy support of RGB specified colors.
48+ - Both applications and users can add to the mapping used to translate from input bytes to
49+ events.
50+ - Additional information about input and output process can be appended to a debug log
51+ - Set environment variable VTY_DEBUG_LOG to path of debug log
52+ - Or use "debugLog <path>" config directive
53+ - Or set 'debugLog' property of the Config provided to mkVty.
54+ - examples moved to vty-examples package. See test directory for cabal file.
55+ - vty-interactive-terminal-test
56+ - interactive test. Useful for building a bug report for vty's author.
57+ - test/interactive_terminal_test.hs
58+ - vty-event-echo
59+ - view a input event log for vty. Example of interacting with user.
60+ - test/EventEcho.hs
61+ - vty-rouge
62+ - The start of a rouge-like game. Example of layers and image build operations.
63+ - test/Rouge.hs
64+ - vty-benchmark
65+ - benchmarks vty. A series of tests that push random pictures to the terminal. The
66+ random pictures are generated using QuickCheck. The same generators used in the
67+ automated tests.
68+ - test/benchmark.hs
6569
66704.7.0.0
6771 * API changes:
Demo.hs+3−1
@@ -16,7 +16,9 @@ eventBufferSize = 1000
1616type App = RWST Vty () (Seq String) IO
1717
1818main = 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 } )
2022 _ <- execRWST (vtyInteract False) vty Seq.empty
2123 shutdown vty
2224
src/Graphics/Vty/Config.hs+20−13
@@ -93,7 +93,8 @@ import qualified Text.Parsec.Token as P
9393type InputMap = [(Maybe String, String, Event)]
9494
9595data Config = Config
96− { specifiedEscPeriod :: Maybe Int -- < See 'singleEscPeriod'
96+ { vmin :: Maybe Int -- < See 'derivedVmin'
97+ , vtime :: Maybe Int -- < See 'derivedVtime'
9798 -- | Debug information is appended to this file if not Nothing.
9899 , debugLog :: Maybe FilePath
99100 -- | The (input byte, output event) pairs extend the internal input table of VTY and the table
@@ -103,26 +104,32 @@ data Config = Config
103104 , inputMap :: InputMap
104105 } deriving (Show, Eq)
105106
106−-- | AKA VTIME. The default is 100000 microseconds or 0.1 seconds. Set using the
107−-- 'specifiedEscPeriod' field of 'Config'
108−singleEscPeriod :: Config -> Int
109−singleEscPeriod = maybe 100000 id . specifiedEscPeriod
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.
113+-- Set using the 'vmin' field of 'Config'
114+derivedVmin :: Config -> Int
115+derivedVmin = maybe 1 id . vmin
110116
111117instance Default Config where
112118 def = mempty
113119
114120instance Monoid Config where
115121 mempty = Config
116− { specifiedEscPeriod = Nothing
117− , debugLog = mempty
118− , inputMap = mempty
122+ { vmin = Nothing
123+ , vtime = Nothing
124+ , debugLog = mempty
125+ , inputMap = mempty
119126 }
120127 mappend c0 c1 = Config
121− -- latter config takes priority in specifiedEscPeriod
122− { specifiedEscPeriod = specifiedEscPeriod c1 <|> specifiedEscPeriod c0
123− -- latter config takes priority in debugInputLog
124− , debugLog = debugLog c1 <|> debugLog c0
125− , inputMap = inputMap c0 <> inputMap c1
128+ -- latter config takes priority in vmin, vtime, debugInputLog
129+ { vmin = vmin c1 <|> vmin c0
130+ , vtime = vtime c1 <|> vtime c0
131+ , debugLog = debugLog c1 <|> debugLog c0
132+ , inputMap = inputMap c0 <> inputMap c1
126133 }
127134
128135type ConfigParser s a = ParsecT s () (Writer Config) a
src/Graphics/Vty/Input/Classify.hs+4−4
@@ -33,11 +33,11 @@ compile table = cl' where
3333 eventForInput = M.fromList table
3434 cl' [] = Prefix
3535 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
3638 Just e -> Valid e []
3739 Nothing -> case S.member inputBlock prefixSet of
3840 True -> Prefix
39− -- if the inputBlock is exactly what is expected for an event then consume the whole
40− -- block and return the event
4141 -- look up progressively smaller tails of the input block until an event is found
4242 -- The assumption is that the event that consumes the most input bytes should be
4343 -- produced.
@@ -45,8 +45,8 @@ compile table = cl' where
4545 -- H: There will always be one match. The prefixSet contains, by definition, all
4646 -- prefixes of an event.
4747 False ->
48− let inputTails = init $ tail $ tails inputBlock
49− in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputTails of
48+ let inputPrefixes = reverse $ tail $ inits inputBlock
49+ in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputPrefixes of
5050 (s,e) : _ -> Valid e (drop (length s) inputBlock)
5151 -- neither a prefix or a full event.
5252 -- TODO: debug log
src/Graphics/Vty/Input/Loop.hs+18−9
@@ -8,6 +8,8 @@
88--
99-- This is an example of an algorithm where code coverage could be high, even 100%, but the
1010-- behavior is still under tested. I should collect more of these examples...
11+--
12+-- reference: http://www.unixwiz.net/techtips/termios-vmin-vtime.html
1113module Graphics.Vty.Input.Loop where
1214
1315import Graphics.Vty.Config
@@ -30,7 +32,7 @@ import Foreign ( allocaArray, peekArray, Ptr )
3032import Foreign.C.Types (CInt(..))
3133
3234import System.IO
33−import System.Posix.IO (fdReadBuf)
35+import System.Posix.IO (fdReadBuf, setFdOption, FdOption(..))
3436import System.Posix.Terminal
3537import System.Posix.Types (Fd(..))
3638
@@ -108,6 +110,7 @@ readFromDevice = do
108110 oldConfig <- use appliedConfig
109111 fd <- view inputFd
110112 when (newConfig /= oldConfig) $ do
113+ logMsg $ "new config: " ++ show newConfig
111114 liftIO $ applyTimingConfig fd newConfig
112115 appliedConfig .= newConfig
113116 bufferPtr <- use $ inputBuffer.ptr
@@ -117,13 +120,12 @@ readFromDevice = do
117120 if bytesRead > 0
118121 then fmap (map $ chr . fromIntegral) $ peekArray (fromIntegral bytesRead) bufferPtr
119122 else return []
120− logMsg $ "input bytes: " ++ show stringRep
123+ when (not $ null stringRep) $ logMsg $ "input bytes: " ++ show stringRep
121124 return stringRep
122125
123126applyTimingConfig :: Fd -> Config -> IO ()
124−applyTimingConfig fd config =
125− let vtime = min 255 $ singleEscPeriod config `div` 100000
126− in setTermTiming fd 1 vtime
127+applyTimingConfig fd config = setTermTiming fd (derivedVmin config)
128+ (derivedVtime config `div` 100)
127129
128130parseEvent :: InputM Event
129131parseEvent = do
@@ -131,6 +133,8 @@ parseEvent = do
131133 b <- use unprocessedBytes
132134 case c b of
133135 Valid e remaining -> do
136+ logMsg $ "valid parse: " ++ show e
137+ logMsg $ "remaining: " ++ show remaining
134138 unprocessedBytes .= remaining
135139 return e
136140 _ -> mzero
@@ -139,7 +143,9 @@ dropInvalid :: InputM ()
139143dropInvalid = do
140144 c <- use classifier
141145 b <- use unprocessedBytes
142− when (c b == Invalid) $ unprocessedBytes .= []
146+ when (c b == Invalid) $ do
147+ logMsg "dropping input bytes"
148+ unprocessedBytes .= []
143149
144150stopIfRequested :: InputM ()
145151stopIfRequested = do
@@ -166,10 +172,12 @@ attributeControl fd = do
166172 unsetAttrs = setTerminalAttributes fd original Immediately
167173 return (setAttrs,unsetAttrs)
168174
169−logClassifyMap :: Input -> String -> ClassifyMap -> IO()
170−logClassifyMap input termName classifyTable = case _inputDebug input of
175+logInitialInputState :: Input -> String -> ClassifyMap -> IO()
176+logInitialInputState input termName classifyTable = case _inputDebug input of
171177 Nothing -> return ()
172178 Just h -> do
179+ config <- readIORef $ _configRef input
180+ hPrintf h "initial (vmin,vtime): %s\n" (show (vmin config, vtime config))
173181 forM_ classifyTable $ \i -> case i of
174182 (inBytes, EvKey k mods) -> hPrintf h "map %s %s %s %s\n" (show termName)
175183 (show inBytes)
@@ -179,6 +187,7 @@ logClassifyMap input termName classifyTable = case _inputDebug input of
179187
180188initInputForFd :: Config -> String -> ClassifyMap -> Fd -> IO Input
181189initInputForFd config termName classifyTable inFd = do
190+ setFdOption inFd NonBlockingRead False
182191 applyTimingConfig inFd config
183192 stopFlag <- newIORef False
184193 input <- Input <$> newChan
@@ -188,7 +197,7 @@ initInputForFd config termName classifyTable inFd = do
188197 <*> maybe (return Nothing)
189198 (\f -> Just <$> openFile f AppendMode)
190199 (debugLog config)
191− logClassifyMap input termName classifyTable
200+ logInitialInputState input termName classifyTable
192201 _ <- forkOS $ runInputProcessorLoop classifyTable input stopFlag
193202 return input
194203
test/VerifyConfig.hs+2−3
@@ -30,9 +30,8 @@ debugLog "/tmp/vty-debug.txt"
3030|]
3131
3232exampleConfigConfig :: Config
33−exampleConfigConfig = Config
34− { specifiedEscPeriod = def
35− , debugLog = Just "/tmp/vty-debug.txt"
33+exampleConfigConfig = def
34+ { debugLog = Just "/tmp/vty-debug.txt"
3635 , inputMap = [ (Nothing, "\ESC[B", EvKey KUp [])
3736 , (Nothing, "\ESC[1;3B", EvKey KDown [MAlt])
3837 , (Just "xterm", "\ESC[1;3B", EvKey KDown [MAlt])
vty.cabal+1−1
@@ -1,5 +1,5 @@
11name: vty
2−version: 5.0.2
2+version: 5.1.0
33license: BSD3
44license-file: LICENSE
55author: AUTHORS