@@ -6,7 +6,10 @@
6-- TODO: measure and rewrite if required.
6-- TODO: measure and rewrite if required.
7-- TODO: The ClassifyMap interface requires this code to always assure later entries override
7-- TODO: The ClassifyMap interface requires this code to always assure later entries override
9−module Graphics.Vty.Input.Classify where
9+module Graphics.Vty.Input.Classify
11import Graphics.Vty.Input.Events
14import Graphics.Vty.Input.Events
@@ -53,28 +56,22 @@ compile table = cl' where
53 -- TODO: debug log
56 -- TODO: debug log
54 [] -> Invalid
57 [] -> Invalid
56−classify, classifyTab :: ClassifyMap -> [Char] -> KClass
59+classify :: ClassifyMap -> [Char] -> KClass
58−-- As soon as
61+ let fallbackClassifier = compile table
59−classify _table s@(c:_) | ord c >= 0xC2
62+ in \s -> case s of
60− = if utf8Length (ord c) > length s then Prefix else classifyUtf8 s -- beginning of an utf8 sequence
63+ (c:_) | ord c >= 0xC2 && utf8Length (ord c) > length s -> Prefix -- beginning of an utf8 sequence
61−classify table other
64+ (c:_) | ord c >= 0xC2 -> classifyUtf8 s -- As soon as
62− = classifyTab table other
65+ _ -> fallbackClassifier s
64classifyUtf8 :: [Char] -> KClass
67classifyUtf8 :: [Char] -> KClass
65classifyUtf8 s = case decode ((map (fromIntegral . ord) s) :: [Word8]) of
68classifyUtf8 s = case decode ((map (fromIntegral . ord) s) :: [Word8]) of
66 Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) []
69 Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) []
67 _ -> Invalid -- something bad happened; just ignore and continue.
70 _ -> Invalid -- something bad happened; just ignore and continue.
69−classifyTab table = compile table
71−first :: (a -> b) -> (a,c) -> (b,c)
72−first f (x,y) = (f x, y)
74utf8Length :: (Num t, Ord a, Num a) => a -> t
72utf8Length :: (Num t, Ord a, Num a) => a -> t
75utf8Length c
73utf8Length c
76 | c < 0x80 = 1
74 | c < 0x80 = 1
77 | c < 0xE0 = 2
75 | c < 0xE0 = 2
78 | c < 0xF0 = 3
76 | c < 0xF0 = 3
79 | otherwise = 4
77 | otherwise = 4