@@ -7,11 +7,12 @@
77--
88-- This is an example of an algorithm where code coverage could be high, even 100%, but the
99-- behavior is still under tested. I should collect more of these examples...
10−module Graphics.Vty.Input.Internal where
10+module Graphics.Vty.Input.Loop where
1111
12+import Graphics.Vty.Config
13+import Graphics.Vty.Input.Classify
1214import Graphics.Vty.Input.Events
1315
14−import Codec.Binary.UTF8.Generic (decode)
1516import Control.Applicative
1617import Control.Concurrent
1718import Control.Lens
@@ -21,13 +22,8 @@ import Control.Monad.Trans.State (StateT(..), evalStateT)
2122import Control.Monad.Trans.Reader (ReaderT(..))
2223
2324import Data.Char
24−import Data.Default
2525import Data.IORef
26−import Data.List(tails,inits)
27−import qualified Data.Map as M( fromList, lookup )
28−import Data.Maybe ( mapMaybe )
29−import qualified Data.Set as S( fromList, member )
30−import Data.Word
26+import Data.Word (Word8)
3127
3228import Foreign ( allocaArray, peekArray, Ptr )
3329import Foreign.C.Types (CInt(..))
@@ -36,17 +32,6 @@ import System.Posix.IO (fdReadBuf)
3632import System.Posix.Terminal
3733import System.Posix.Types (Fd(..))
3834
39−data Config = Config
40− { singleEscPeriod :: Int -- ^ AKA VTIME. The default is 100000 microseconds or 0.1 seconds.
41− , debugInputLog :: Maybe FilePath -- ^ Debug information about the input process is appended to the file.
42− } deriving (Show, Eq)
43−
44−instance Default Config where
45− def = Config
46− { singleEscPeriod = 100000
47− , debugInputLog = Nothing
48− }
49−
5035data Input = Input
5136 { -- | Channel of events direct from input processing. Unlike 'nextEvent' this will not refresh
5237 -- the display if the next event is an 'EvResize'.
@@ -62,12 +47,6 @@ data Input = Input
6247
6348makeLenses ''Input
6449
65−data KClass
66− = Valid Event [Char]
67− | Invalid
68− | Prefix
69− deriving(Show, Eq)
70−
7150data InputBuffer = InputBuffer
7251 { _ptr :: Ptr Word8
7352 , _size :: Int
@@ -148,63 +127,6 @@ stopIfRequested = do
148127 True <- (liftIO . readIORef) =<< use stopRequestRef
149128 return ()
150129
151−-- This makes a kind of tri. Has space efficiency issues with large input blocks.
152−-- Likely building a parser and just applying that would be better.
153−-- I did not write this so I might just rewrite it for better understanding. Not the best of
154−-- reasons...
155−-- TODO: measure and rewrite if required.
156−-- TODO: The ClassifyTable interface requires this code to always assure later entries override
157−-- earlier.
158−compile :: ClassifyTable -> [Char] -> KClass
159−compile table = cl' where
160− -- take all prefixes and create a set of these
161− prefixSet = S.fromList $ concatMap (init . inits . fst) $ table
162− eventForInput = M.fromList table
163− cl' [] = Prefix
164− cl' inputBlock = case M.lookup inputBlock eventForInput of
165− Just e -> Valid e []
166− Nothing -> case S.member inputBlock prefixSet of
167− True -> Prefix
168− -- if the inputBlock is exactly what is expected for an event then consume the whole
169− -- block and return the event
170− -- look up progressively smaller tails of the input block until an event is found
171− -- The assumption is that the event that consumes the most input bytes should be
172− -- produced.
173− -- The test verifyFullSynInputToEvent2x verifies this.
174− -- H: There will always be one match. The prefixSet contains, by definition, all
175− -- prefixes of an event.
176− False ->
177− let inputTails = init $ tail $ tails inputBlock
178− in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputTails of
179− (s,e) : _ -> Valid e (drop (length s) inputBlock)
180− -- neither a prefix or a full event. Might be interesting to log.
181− [] -> Invalid
182−
183−classify, classifyTab :: ClassifyTable -> [Char] -> KClass
184−
185−-- As soon as
186−classify _table s@(c:_) | ord c >= 0xC2
187− = if utf8Length (ord c) > length s then Prefix else classifyUtf8 s -- beginning of an utf8 sequence
188−classify table other
189− = classifyTab table other
190−
191−classifyUtf8 :: [Char] -> KClass
192−classifyUtf8 s = case decode ((map (fromIntegral . ord) s) :: [Word8]) of
193− Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) []
194− _ -> Invalid -- something bad happened; just ignore and continue.
195−
196−classifyTab table = compile table
197−
198−first :: (a -> b) -> (a,c) -> (b,c)
199−first f (x,y) = (f x, y)
200−
201−utf8Length :: (Num t, Ord a, Num a) => a -> t
202−utf8Length c
203− | c < 0x80 = 1
204− | c < 0xE0 = 2
205− | c < 0xF0 = 3
206− | otherwise = 4
207−
208130runInputProcessorLoop :: ClassifyTable -> Input -> IORef Bool -> IO ()
209131runInputProcessorLoop classifyTable input stopFlag = do
210132 let bufferSize = 1024