~alcinnz/fontconfig-pure

ref: 24a77a5f8850201dfdc3661776cc0e69bc9bc6a0 fontconfig-pure/Graphics/Text/Font/Choose/Config.hs -rw-r--r-- 12.9 KiB
24a77a5f — Adrian Cochrane Get Value & Pattern types compiling correctly. 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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
module Graphics.Text.Font.Choose.Config where

import Graphics.Text.Font.Choose.Strings
import Graphics.Text.Font.Choose.FontSet
import Graphics.Text.Font.Choose.CharSet
import Graphics.Text.Font.Choose.Pattern
import Graphics.Text.Font.Choose.ObjectSet

import Foreign.ForeignPtr
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.C.String (CString, peekCString)
import System.IO.Unsafe (unsafePerformIO)

type Config = ForeignPtr Config'
data Config'
type Config_ = Ptr Config'

configCreate :: IO Config
configCreate = newForeignPtr fcConfigDestroy =<< fcConfigCreate
foreign import ccall "FcConfigCreate" fcConfigCreate :: IO Config_
foreign import ccall "FcConfigDestroy" fcConfigDestroy :: Config_ -> IO ()

configGetCurrent :: IO Config
configGetCurrent = newForeignPtr_ =<< fcConfigGetCurrent
foreign import ccall "FcConfigGetCurrent" fcConfigGetCurrent :: IO Config_

configUptoDate :: Config -> IO Bool
configUptoDate config = withForeignPtr config $ fcConfigUptoDate
foreign import ccall "FcConfigUptoDate" fcConfigUptoDate :: Config_ -> IO Bool

configHome :: IO (Maybe String)
configHome = do
    ret <- fcConfigHome
    if ret == nullPtr then return Nothing else Just <$> peekCString ret
foreign import ccall "FcConfigHome" fcConfigHome :: IO CString

configEnableHome :: Bool -> IO Bool
foreign import ccall "FcConfigEnableHome" configEnableHome :: Bool -> IO Bool

configBuildFonts :: Config -> IO Bool
configBuildFonts config = withForeignPtr config $ fcConfigBuildFonts
configBuildFonts' :: IO Bool
configBuildFonts' = fcConfigBuildFonts nullPtr
foreign import ccall "FcConfigBuildFonts" :: Config_ -> IO Bool

configGetConfigDirs :: Config -> IO StrList
configGetConfigDirs = configStrsFunc fcConfigGetConfigDirs
configGetConfigDirs' :: IO StrList
configGetConfigDirs' = thawStrList =<< fcConfigGetConfigDirs nullPtr
foreign import ccall "FcConfigGetConfigDirs" fcConfigGetConfigDirs :: Config_ -> IO StrList_

configGetFontDirs :: Config -> IO StrList
configGetFontDirs = configStrsFunc fcConfigGetFontDirs
configGetFontDirs' :: IO StrList
configGetFontDirs' = thawStrList =<< fcConfigGetFontDirs nullPtr
foreign import ccall "FcConfigGetFontDirs" fcConfigGetFontDirs :: Config_ -> IO StrList_

configGetConfigFiles :: Config -> IO StrList
configGetConfigFiles = configStrsFunc fcConfigGetConfigFiles
configGetConfigFiles' :: IO StrList
configGetConfigFiles' = thawStrList =<< fcConfigGetConfigFiles nullPtr
foreign import ccall "FcConfigGetConfigFiles" fcConfigGetConfigFiles :: Config_ -> IO StrList_

configGetCacheDirs :: Config -> IO StrList
configGetCacheDirs = configStrsFunc fcConfigGetCacheDirs
configGetCacheDirs' :: IO StrList
configGetCacheDirs' = thawStrList =<< fcConfigGetCacheDirs nullPtr
foreign import ccall "FcConfigGetCacheDirs" fcConfigGetCacheDirs :: Config_ -> IO StrList_

data SetName = SetSystem | SetApplication deriving (Enum)
configGetFonts :: Config -> SetName -> IO FontSet
configGetFonts config set = do
    ret <- withForeignPtr config $ flip fcConfigGetFonts $ fromEnum set
    thawFontSet ret
configGetFonts' :: SetName -> IO FontSet
configGetFonts' set = thawFontSet =<< fcConfigGetFonts nullPtr $ fromEnum set
foreign import ccall "FcConfigGetFonts" fcConfigGetFonts -> Config_ -> Int -> IO FontSet_

configGetRescanInterval :: Config -> IO Int
configGetRescanInterval = flip withForeignPtr $ fcConfigGetRescanInterval
configGetRescanInterval' :: IO Int
configGetRescanInterval' = fcConfigGetRescanInterval nullPtr
foreign import ccall "FcConfigGetRescanInterval" fcConfigGetRescanInterval ::
    Config_ -> IO Int

configSetRescanInterval :: Config -> Int -> IO Bool
configSetRescanInterval config val =
    withForeignPtr config $ flip fcConfigSetRescanInterval val
configSetRescanInterval' :: Int -> IO Bool
configSetRescanInterval' = fcConfigSetRescanInterval nullPtr
foreign import ccall "FcConfigSetRescanInterval" fcConfigSetRescanInterval ::
    Config_ -> Int -> IO Bool

configAppFontAddFile :: Config -> String -> IO Bool
configAppFontAddFile config file =
    withForeignPtr config $ \config' -> withCString file $ \file' ->
        fcConfigAppFontAddFile config' file'
configAppFontAddFile' :: String -> IO Bool
configAppFontAddFile' = flip withCString $ fcConfigAppFontAddFile nullPtr
foreign import ccall "FcConfigAppFontAddFile" fcConfigAppFontAddFile ::
    Config_ -> CString -> IO Bool

configAppFontAddDir :: Config -> String -> IO Bool
configAppFontAddDir config file =
    withForeignPtr config $ \config' -> withCString file $ fcConfigAppFontAddDir config'
configAppFontAddDir' :: String -> IO Bool
configAppFontAddDir' = flip withCString $ fcConfigAppFontAddDir nullPtr
foreign import ccall "FcConfigAppFontAddDir" fcConfigAppFontAddDir ::
    Config_ -> CString -> IO Bool

configAppFontClear :: Config -> IO Bool
configAppFontClear = flip withForeignPtr fcConfigAppFontClear
configAppFontClear' :: IO Bool
configAppFontClear' = fcConfigAppFontClear nullPtr
foreign import ccall "FcConfigAppFontClear" fcConfigAppFontClear :: Config_ -> IO Bool

data MatchKind = MatchPattern | MatchFont | MatchScan deriving Enum
configSubstituteWithPat :: Config -> Pattern -> Pattern -> MatchKind -> Maybe Pattern
configSubstituteWithPat config p p_pat kind = unsafePerformIO $
    withForeignPtr config $ \config' -> withPattern p $ \p' ->
        withPattern p_pat $ \p_pat' -> do
            ok <- fcConfigSubstituteWithPat config' p' p_pat' $ fromEnum kind
            if ok then Just <$> thawPattern p' else return Nothing
configSubstituteWithPat' :: Pattern -> Pattern -> MatchKind -> Maybe Pattern
configSubstituteWithPat' p p_pat kind = unsafePerformIO $
    withPattern p $ \p' -> withPattern p_pat $ \p_pat' -> do
        ok <- fcConfigSubstituteWithPat nullPtr p' p_pat' $ fromEnum kind
        if ok then Just <$> thawPattern p' else return Nothing
foreign import ccall "FcConfigSubstituteWithPat" fcConfigSubstituteWithPat ::
    Config_ -> Pattern_ -> Pattern_ -> Int -> IO Bool

configSubstitute :: Config -> Pattern -> MatchKind -> Maybe Pattern
configSubstitute config p kind = unsafePerformIO $
    withForeignPtr config $ \config' -> withPattern p $ \p' -> do
        ok <- fcConfigSubstitute config' p' $ fromEnum kind
        if ok then Just <$> thawPattern p' else return Nothing
configSubstitute' :: Pattern -> MatchKind -> Maybe Pattern
configSubsitute' p kind = unsafePerformIO $ withPattern p $ \p' -> do
    ok <- fcConfigSubstitute nullPtr p' $ fromEnum kind
    if ok then Just <$> thawPattern p' else return Nothing
foreign import ccall "FcConfigSubstitute" fcConfigSubstitute ::
    Config_ -> Pattern_ -> Int -> IO Bool

fontMatch :: Config -> Pattern -> Maybe Pattern
fontMatch config pattern = unsafePerformIO $ withForeignPtr config $ \config' ->
    withPattern pattern $ \pattern' -> alloca $ \res' -> do
        ret <- fcFontMatch config' pattern' res'
        res <- peek res'
        if res == 0 then Just <$> thawPattern ret else return Nothing
fontMatch' :: Pattern -> Maybe Pattern
fontMatch' pattern = unsafePerformIO $ withPattern pattern $ \pattern' -> alloca $ \res' -> do
    ret <- fcFontMatch nullPtr pattern' res'
    res <- peek res'
    if res == 0 then Just <$> thawPattern ret else return Nothing
foreign import ccall "FcFontMatch" fcFontMatch :: Config_ -> Pattern_ -> Ptr Int -> IO Pattern_

fontSort :: Config -> Pattern -> Bool -> CharSet -> Maybe FontSet
fontSort config pattern trim csp = unsafePerformIO $ withForeignPtr config $ \config' ->
    withPattern pattern $ \pattern' -> withCharSet csp $ \csp' -> alloca $ \res' -> do
        ret <- fcFontSort config' pattern' trim csp' res'
        res <- peek res'
        if res == 0 then Just <$> thawPattern ret else return Nothing
fontSort' :: Pattern -> Bool -> CharSet -> Maybe FontSet
fontSort' pattern trim csp = unsafePerformIO $ withPattern $ \pattern' ->
    withCharSet csp $ \csp' -> alloca $ \res' -> do
        ret <- fcFontSort nullPtr pattern' trim csp' res'
        res <- peek res'
        if res == 0 then Just <$> thawPattern ret else return Nothing
foreign import ccall "FcFontSort" fcFontSort ::
    Config_ -> Pattern_ -> Bool -> CharSet_ -> Ptr Int -> IO Pattern_

fontRenderPrepare :: Config -> Pattern -> Pattern -> Pattern
fontRenderPrepare config pat font = unsafePerformIO $ withForeignPtr config $ \config' ->
    withPattern pat $ \pat' -> withPattern font $ \font' -> do
        ret <- fcFontRenderPrepare config' pat' font'
        thawPattern ret
fontRenderPrepare' :: Pattern -> Pattern -> Pattern
fontRenderPrepare' pat font = unsafePerformIO $ withPattern pat $ \pat' ->
    withPattern font $ \font' -> do
        ret <- fcFontRenderPrepare nullPtr pat' font'
        thawPattern ret
foreign import ccall "FcFontRenderPrepare" fcFontRenderPrepare ::
    Config_ -> Pattern_ -> Pattern_ -> IO Pattern_

fontList :: Config -> Pattern -> ObjectSet -> FontSet
fontList config p os = unsafePerformIO $ withForeignPtr config $ \config' ->
    withPattern p $ \p' -> withObjectSet os $ \os' -> do
        ret <- fontList config' p' os'
        thawFontSet ret
fontList' :: Pattern -> ObjectSet -> FontSet
fontList' p os = unsafePerformIO $ withPattern p $ \p' -> withObjectSet os $ \os' -> do
    ret <- fontList nullPtr p' os'
    thawFontSet ret
foreign import ccall "FcFontList" fcFontList :: Config_ -> Pattern_ -> ObjectSet_ -> IO FontSet_

configGetFilename :: Config -> String -> String
configGetFilename config name = unsafePerformIO $ withForeignPtr config $ \config' ->
    withCString name $ \name' -> do
        ret <- fcConfigGetFilename config' name'
        peekCString ret
configGetFilename' :: String -> String
configGetFilename' name = unsafePerformIO $ withCString name $ \name' ->
    ret <- fcConfigGetFilename nullPtr name'
    peekCString ret
foreign import ccall "FcConfigGetFilename" fcConfigGetFilename :: Config_ -> CString -> IO CString

configParseAndLoad :: Config -> String -> Bool -> IO Bool
configParseAndLoad config name complain = withForeignPtr config $ \config' ->
    withCString name $ \name' -> fcConfigParseAndLoad config' name' complain
configParseAndLoad' :: String -> Bool -> IO Bool
configParseAndLoad' name complain =
    withCString name $ \name' -> fcConfigParseAndLoad nullPtr name' complain
foreign import ccall "FcConfigParseAndLoad" fcConfigParseAndLoad ::
    Config_ -> CString -> Bool -> IO Bool

configParseAndLoadFromMemory :: Config -> String -> Bool -> IO Bool
configParseAndLoadFromMemory config buffer complain = withForeignPtr config $ \config' ->
    withCString buffer $ \buffer' ->
        fcConfigParseAndLoadFromMemory config' buffer' complain
configParseAndLoadFromMemory' :: String -> Bool -> IO Bool
configParseAndLoadFromMemory' buffer complain = withCString buffer $ \buffer' -=>
    fcConfigParseAndLoadFromMemory nullPtr buffer' complain
foreign import ccall "FcConfigParseAndLoadFromMemory" fcConfigParseAndLoadFromMemory ::
    Config_ -> CString -> Bool -> IO Bool

configGetSysRoot :: Config -> IO String
configGetSysRoot = flip withForeignPtr $ \config' -> do
    ret <- fcConfigGetSysRoot config'
    peekCString ret
configGetSysRoot' :: IO String
configGetSysRoot' = peekCString =<< fcConfigGetSysRoot nullPtr
foreign import ccall "FcConfigGetSysRoot" fcConfigGetSysRoot :: Config_ -> IO CString

configSetSysRoot :: Config -> String -> IO ()
configSetSysRoot config val = withForeignPtr config $ \config' -> withCString val $
    fcConfigSetSysRoot config'
configSetSysRoot' :: String -> IO ()
configSetSysRoot' val = withCString val $ fcConfigSetSysRoot nullPtr
foreign import ccall "FcConfigSetSysRoot" fcConfigSetSysRoot :: Config_ -> CString -> IO ()

configGetFileInfo :: Config -> IO [(FilePath, String, Bool)]
configGetFileInfo config = withForeignPtr config $ \config' -> alloca $ \iter' -> do
    fcConfigFileInfoIterInit config' iter'
    let readEnt = alloca $ \name' -> alloca $ \description' -> alloca $ \enabled' -> do
        ok <- fcConfigFileInfoIterGet config' iter' name' description' enabled'
        if ok then do
            name <- peekCString =<< peek name'
            description <- peekCString =<< peek description'
            enabled <- peek enabled'
            return $ Just (name, description, enabled)
        else return Nothing
    let go = do
        ent' <- readEnt
        case ent' of
            Just ent -> do
                ok <- fcConfigFileInfoIterNext config' iter'
                ents <- if ok then go else return []
                return (ent : ents)
            Nothing -> return []
    go
data ConfigFileInfoIter'
type ConfigFileInfoIter_ = Ptr ConfigFileInfo'
foreign import ccall "FcConfigFileInfoIterInit" fcConfigFileInfoIterInit ::
    Config_ -> ConfigFileInfoIter_ -> IO ()
foreign import ccall "FcConfigFileInfoIterNext" fcConfigFileInfoIterNext ::
    Config_ -> ConfigFileInfoIter_ -> IO Bool
foreign import ccall "FcConfigFileInfoIterGet" fcConfigFileInfoIterGet ::
    Config_ -> ConfigFileInfoIter_ -> Ptr CString -> Ptr CString -> Ptr Bool -> IO Bool

------

configStrsFunc :: (Config_ -> IO StrList_) -> Config -> IO StrList
configStrsFunc cb config = do
    ret <- withForeignPtr config cb
    thawStrList ret