1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
module Graphics.Text.Font.Choose.LangSet where
import Data.Set (Set)
import qualified Data.Set as Set
import Graphics.Text.Font.Choose.Strings (thawStrSet, StrSet_)
import Graphics.Text.Font.Choose.CharSet (thawCharSet, CharSet_, CharSet)
import Foreign.Ptr (Ptr)
import Foreign.C.String (CString, withCString, peekCString)
import Control.Exception (bracket)
import Control.Monad (forM)
import System.IO.Unsafe (unsafePerformIO)
type LangSet = Set String
defaultLangs :: IO LangSet
defaultLangs = thawStrSet =<< fcGetDefaultLangs
foreign import ccall "FcGetDefaultLangs" fcGetDefaultLangs :: IO StrSet_
langs :: LangSet
langs = unsafePerformIO (thawStrSet =<< fcGetLangs)
foreign import ccall "FcGetLangs" fcGetLangs :: IO StrSet_
data LangResult = SameLang | DifferentTerritory | DifferentLang deriving Enum
langSetCompare :: LangSet -> LangSet -> LangResult
langSetCompare a b = unsafePerformIO $ withLangSet a $ \a' -> withLangSet b $ \b' ->
(toEnum <$> fcLangSetCompare a' b')
foreign import ccall "FcLangSetCompare" fcLangSetCompare ::
LangSet_ -> LangSet_ -> IO Int
langNormalize :: String -> String
langNormalize lang = unsafePerformIO $ withCString lang (peekCString . fcLangNormalize)
foreign import ccall "FcLangNormalize" fcLangNormalize :: CString -> CString
langCharSet :: String -> CharSet
langCharSet lang = unsafePerformIO $ withCString lang (thawCharSet . fcLangGetCharSet)
foreign import ccall "FcLangGetCharSet" fcLangGetCharSet :: CString -> CharSet_
------
--- Low-level
------
data LangSet'
type LangSet_ = Ptr LangSet'
withNewLangSet :: (LangSet_ -> IO a) -> IO a
withNewLangSet = bracket fcLangSetCreate fcLangSetDestroy
foreign import ccall "FcLangSetCreate" fcLangSetCreate :: IO LangSet_
foreign import ccall "FcLangSetDestroy" fcLangSetDestroy :: LangSet_ -> IO ()
withLangSet :: LangSet -> (LangSet_ -> IO a) -> IO a
withLangSet langs cb = withNewLangSet $ \langs' -> do
forM (Set.elems langs) $ flip withCString $ fcLangSetAdd langs'
cb langs'
foreign import ccall "FcLangSetAdd" fcLangSetAdd :: LangSet_ -> CString -> IO Bool
thawLangSet :: LangSet_ -> IO LangSet
thawLangSet langs' = thawStrSet =<< fcLangSetGetLangs langs'
foreign import ccall "FcLangSetGetLangs" fcLangSetGetLangs :: LangSet_ -> IO StrSet_