@@ -0,0 +1,52 @@
1+{-# LANGUAGE TupleSections #-}
2+module Graphics.Vty.UnicodeWidthTable.Query
3+ ( buildUnicodeWidthTable
4+ )
5+where
6+
7+import Control.Monad (forM)
8+import Data.Char (generalCategory, GeneralCategory(..))
9+import Data.Maybe (catMaybes)
10+import System.Console.ANSI (getCursorPosition)
11+import Text.Printf (printf)
12+
13+import Graphics.Vty.UnicodeWidthTable.Types
14+
15+shouldConsider :: Char -> Bool
16+shouldConsider c =
17+ case generalCategory c of
18+ Control -> False
19+ NotAssigned -> False
20+ Surrogate -> False
21+ _ -> True
22+
23+charWidth :: Char -> IO Int
24+charWidth c = do
25+ printf "\r"
26+ putChar c
27+ Just (_, col) <- getCursorPosition
28+ return col
29+
30+mkRanges :: [(Char, Int)] -> [WidthTableRange]
31+mkRanges pairs =
32+ let convertedPairs = convert <$> pairs
33+ convert (c, i) = (fromIntegral $ fromEnum c, fromIntegral i)
34+ go Nothing finishedRanges [] = finishedRanges
35+ go (Just r) finishedRanges [] = r:finishedRanges
36+ go Nothing finishedRanges ((c, width):rest) =
37+ go (Just $ WidthTableRange c 1 width) finishedRanges rest
38+ go (Just r@(WidthTableRange prevCh sz prevWidth)) finishedRanges ((c, width):rest) =
39+ if c == prevCh + sz && prevWidth == width
40+ then go (Just (WidthTableRange prevCh (sz + 1) prevWidth)) finishedRanges rest
41+ else go (Just (WidthTableRange c 1 width)) (r:finishedRanges) rest
42+ in go Nothing [] convertedPairs
43+
44+buildUnicodeWidthTable :: IO UnicodeWidthTable
45+buildUnicodeWidthTable = do
46+ pairs <- fmap catMaybes $ forM ['\0'..'\x2FFFF'] $ \i ->
47+ if shouldConsider i
48+ then (Just . (i,)) <$> charWidth i
49+ else return Nothing
50+
51+ return UnicodeWidthTable { unicodeWidthTableRanges = reverse $ mkRanges pairs
52+ }