~alcinnz/fontconfig-pure

ref: 21f288ec7cd334c64016c5537065660832b0a124 fontconfig-pure/Graphics/Text/Font/Choose/LangSet.hs -rw-r--r-- 3.1 KiB
21f288ec — Adrian Cochrane Get language bindings for FcConfig type compiling. 2 years ago 
                                                                                
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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
module Graphics.Text.Font.Choose.LangSet (LangSet, defaultLangs, langs,
    langSetCompare, langNormalize, langCharSet,
    LangSet_, withLangSet, thawLangSet) where

import Data.Set (Set)
import qualified Data.Set as Set
import Graphics.Text.Font.Choose.Strings (thawStrSet, thawStrSet_, StrSet_)
import Graphics.Text.Font.Choose.CharSet (thawCharSet, CharSet_, CharSet)
import Graphics.Text.Font.Choose.Result (throwNull, throwFalse)

import Foreign.Ptr (Ptr)
import Foreign.C.String (CString, withCString, peekCString)
import Foreign.Marshal.Alloc (free)
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, Eq, Read, Show)
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

langSetContains :: LangSet -> LangSet -> Bool
langSetContains a b = unsafePerformIO $ withLangSet a $ \a' -> withLangSet b $
    fcLangSetContains a'
foreign import ccall "FcLangSetContains" fcLangSetContains ::
    LangSet_ -> LangSet_ -> IO Bool

langSetHasLang :: LangSet -> String -> LangResult
langSetHasLang a b = unsafePerformIO $ withLangSet a $ \a' -> withCString b $ \b' ->
    (toEnum <$> fcLangSetHasLang a' b')
foreign import ccall "FcLangSetHasLang" fcLangSetHasLang :: LangSet_ -> CString -> IO Int

langNormalize :: String -> String
langNormalize "" = ""
langNormalize lang = unsafePerformIO $ withCString lang (peekCString_ . fcLangNormalize)
foreign import ccall "FcLangNormalize" fcLangNormalize :: CString -> CString
peekCString_ str' = do
    str <- peekCString $ throwNull str'
    free str'
    return str

langCharSet :: String -> CharSet
langCharSet lang = unsafePerformIO $
    withCString lang (thawCharSet . throwNull . fcLangGetCharSet)
foreign import ccall "FcLangGetCharSet" fcLangGetCharSet :: CString -> CharSet_

------
--- Low-level
------

data LangSet'
type LangSet_ = Ptr LangSet'

withNewLangSet :: (LangSet_ -> IO a) -> IO a
withNewLangSet = bracket (throwNull <$> 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 $ \lang' ->
        throwFalse <$> fcLangSetAdd langs' lang'
    cb langs'
foreign import ccall "FcLangSetAdd" fcLangSetAdd :: LangSet_ -> CString -> IO Bool

thawLangSet :: LangSet_ -> IO LangSet
thawLangSet = thawStrSet_ . fcLangSetGetLangs
foreign import ccall "FcLangSetGetLangs" fcLangSetGetLangs :: LangSet_ -> IO StrSet_