~alcinnz/fontconfig-pure

ref: a7c384b2408f2a512ecaee9d1287a9bbf5d41290 fontconfig-pure/lib/Graphics/Text/Font/Choose/Config/Accessors.hs -rw-r--r-- 8.4 KiB
a7c384b2 — Adrian Cochrane Improve handling of invalid FontConfig data. 6 months 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
{-# LANGUAGE CApiFFI #-}
module Graphics.Text.Font.Choose.Config.Accessors(
        configCreate, setCurrent, current, uptodate, home, enableHome, buildFonts,
        configDirs, fontDirs, configFiles, cacheDirs, fonts, rescanInterval,
        setRescanInterval, appFontAddFile, appFontAddDir, appFontClear, substituteWithPat,
        fontMatch, fontSort, fontRenderPrepare, fontList, filename, parseAndLoad,
        parseAndLoadFromMemory, sysroot, setSysroot, SetName(..), MatchKind(..)
    ) where

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

import Foreign.Ptr (Ptr, nullPtr)
import Foreign.ForeignPtr (newForeignPtr, withForeignPtr)
import Foreign.C.String (CString, withCString, peekCString)
--import Foreign.C.ConstPtr (ConstPtr)
--import Foreign.C.Types (CChar)

import Graphics.Text.Font.Choose.Result (throwBool, throwNull)
import Graphics.Text.Font.Choose.Internal.FFI (peekCString', fromMessageIO0,
                withMessage, withForeignPtr', fromMessage0, fromMessage)

configCreate :: IO Config
configCreate = newForeignPtr fcConfigDestroy =<< throwNull =<< fcConfigCreate
foreign import capi "fontconfig/fontconfig.h FcConfigCreate" fcConfigCreate :: IO (Ptr Config')

setCurrent :: Config -> IO ()
setCurrent conf = throwBool =<< withForeignPtr conf fcConfigSetCurrent
foreign import capi "fontconfig/fontconfig.h FcConfigSetCurrent" fcConfigSetCurrent :: Ptr Config' -> IO Bool

current :: IO Config
current = newForeignPtr fcConfigDestroy =<< throwNull =<< fcConfigReference nullPtr
foreign import capi "fontconfig/fontconfig.h FcConfigReference" fcConfigReference :: Ptr Config' -> IO (Ptr Config')

uptodate :: Config -> IO Bool
uptodate conf = withForeignPtr conf fcConfigUptoDate
foreign import capi "fontconfig/fontconfig.h FcConfigUptoDate" fcConfigUptoDate :: Ptr Config' -> IO Bool

home :: String
home = peekCString' fcConfigHome
foreign import capi "fontconfig/fontconfig.h FcConfigHome" fcConfigHome :: CString

foreign import capi "fontconfig/fontconfig.h FcConfigEnableHome" enableHome :: Bool -> IO Bool

buildFonts :: Config -> IO ()
buildFonts conf = throwBool =<< withForeignPtr conf fcConfigBuildFonts
foreign import capi "fontconfig/fontconfig.h FcConfigBuildFonts" fcConfigBuildFonts :: Ptr Config' -> IO Bool

configDirs :: Config -> IO [String]
configDirs conf =
    fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetConfigDirs conf' len
foreign import capi "fontconfig-wrap.h" fcConfigGetConfigDirs :: Ptr Config' -> Ptr Int -> IO CString

fontDirs :: Config -> IO [String]
fontDirs conf =
    fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetFontDirs conf' len
foreign import capi "fontconfig-wrap.h" fcConfigGetFontDirs :: Ptr Config' -> Ptr Int -> IO CString

configFiles :: Config -> IO [String]
configFiles conf =
    fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetConfigFiles conf' len
foreign import capi "fontconfig-wrap.h" fcConfigGetConfigFiles :: Ptr Config' -> Ptr Int -> IO CString

cacheDirs :: Config -> IO [String]
cacheDirs conf =
    fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetCacheDirs conf' len
foreign import capi "fontconfig-wrap.h" fcConfigGetCacheDirs :: Ptr Config' -> Ptr Int -> IO CString

data SetName = System | App deriving Eq
fonts :: Config -> SetName -> IO FontSet
fonts conf setname =
    fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetFonts conf' (setname == System) len
foreign import capi "fontconfig-wrap.h" fcConfigGetFonts :: Ptr Config' -> Bool -> Ptr Int -> IO CString

rescanInterval :: Config -> IO Int
rescanInterval = flip withForeignPtr fcConfigGetRescanInterval
foreign import capi "fontconfig/fontconfig.h FcConfigGetRescanInterval" fcConfigGetRescanInterval ::
        Ptr Config' -> IO Int

setRescanInterval :: Config -> Int -> IO ()
setRescanInterval conf period =
    throwBool =<< withForeignPtr conf (flip fcConfigSetRescanInterval period)
foreign import capi "fontconfig/fontconfig.h FcConfigSetRescanInterval" fcConfigSetRescanInterval ::
        Ptr Config' -> Int -> IO Bool

appFontAddFile :: Config -> FilePath -> IO ()
appFontAddFile conf file = throwBool =<< withForeignPtr conf (\conf' ->
        withCString file $ \file' -> fcConfigAppFontAddFile conf' file')
foreign import capi "fontconfig/fontconfig.h FcConfigAppFontAddFile" fcConfigAppFontAddFile ::
        Ptr Config' -> CString -> IO Bool

appFontAddDir :: Config -> FilePath -> IO ()
appFontAddDir conf file = throwBool =<< withForeignPtr conf (\conf' ->
        withCString file $ \file' -> fcConfigAppFontAddDir conf' file')
foreign import capi "fontconfig/fontconfig.h FcConfigAppFontAddDir" fcConfigAppFontAddDir ::
        Ptr Config' -> CString -> IO Bool

appFontClear :: Config -> IO ()
appFontClear = flip withForeignPtr fcConfigAppFontClear
foreign import capi "fontconfig/fontconfig.h FcConfigAppFontClear" fcConfigAppFontClear ::
        Ptr Config' -> IO ()

data MatchKind = MatchPattern | MatchFont deriving Eq
substituteWithPat :: Config -> Pattern -> Maybe Pattern -> MatchKind -> Pattern
substituteWithPat conf p (Just p_pat) kind =
    fromMessage0 $ flip withForeignPtr' conf $ \conf' -> flip withMessage [p, p_pat] $ \msg len -> 
        fcConfigSubstituteWithPat conf' msg len (kind == MatchFont)
substituteWithPat conf p Nothing kind =
    fromMessage0 $ flip withForeignPtr' conf $ \conf' -> flip withMessage [p] $ \msg len ->
        fcConfigSubstituteWithPat conf' msg len (kind == MatchFont)
foreign import capi "fontconfig-wrap.h" fcConfigSubstituteWithPat ::
    Ptr Config' -> CString -> Int -> Bool -> Ptr Int -> CString

fontMatch :: Config -> Pattern -> Maybe Pattern
fontMatch conf pat = fromMessage $ flip withMessage pat $ withForeignPtr' fcFontMatch conf
foreign import capi "fontconfig-wrap.h" fcFontMatch :: Ptr Config' -> CString -> Int -> Ptr Int -> CString

fontSort :: Config -> Pattern -> Bool -> Maybe (FontSet, CharSet')
fontSort conf pat trim = fromMessage $ (flip withMessage pat $ withForeignPtr' fcFontSort conf) trim
foreign import capi "fontconfig-wrap.h" fcFontSort ::
    Ptr Config' -> CString -> Int -> Bool -> Ptr Int -> CString

fontRenderPrepare :: Config -> Pattern -> Pattern -> Pattern
fontRenderPrepare conf pat font = fromMessage0 $ flip withMessage [pat, font] $
        withForeignPtr' fcFontRenderPrepare conf
foreign import capi "fontconfig-wrap.h" fcFontRenderPrepare ::
    Ptr Config' -> CString -> Int -> Ptr Int -> CString

fontList :: Config -> Pattern -> ObjectSet -> FontSet
fontList conf pat os = fromMessage0 $ flip withMessage (pat, os) $ withForeignPtr' fcFontList conf
foreign import capi "fontconfig-wrap.h" fcFontList :: Ptr Config' -> CString -> Int -> Ptr Int -> CString

filename :: Config -> FilePath -> IO FilePath
filename conf path =
    peekCString =<< withForeignPtr conf (\_ -> withCString path $ fcConfigGetFilename)
foreign import capi "fontconfig/fontconfig.h FcConfigFilename" fcConfigGetFilename ::
    CString -> IO CString -- FIXME: Recent docs say it's "Get" now...

parseAndLoad :: Config -> FilePath -> Bool -> IO ()
parseAndLoad conf path complain =
    throwBool =<< withForeignPtr conf (\conf' -> withCString path $ \path' ->
        fcConfigParseAndLoad conf' path' complain)
foreign import capi "fontconfig/fontconfig.h FcConfigParseAndLoad" fcConfigParseAndLoad ::
    Ptr Config' -> CString -> Bool -> IO Bool
parseAndLoadFromMemory :: Config -> FilePath -> Bool -> IO ()
parseAndLoadFromMemory conf buf complain =
    throwBool =<< withForeignPtr conf (\conf' -> withCString buf $ \buf' ->
        fcConfigParseAndLoadFromMemory conf' buf' complain)
foreign import capi "fontconfig/fontconfig.h FcConfigParseAndLoadFromMemory"
    fcConfigParseAndLoadFromMemory :: Ptr Config' -> CString -> Bool -> IO Bool

sysroot :: Config -> IO String
sysroot conf = peekCString =<< withForeignPtr conf fcConfigGetSysRoot
-- FIXME: Upgrade GHC so I can use const pointers!
foreign import ccall "fontconfig/fontconfig.h FcConfigGetSysRoot" fcConfigGetSysRoot ::
    Ptr Config' -> IO CString

setSysroot :: Config -> String -> IO ()
setSysroot conf root =
    withForeignPtr conf $ \conf' -> withCString root $ fcConfigSetSysRoot conf'
foreign import capi "fontconfig/fontconfig.h FcConfigSetSysRoot" fcConfigSetSysRoot ::
    Ptr Config' -> CString -> IO ()

-- TODO (maybe): FcConfigFileInfoIterInit, FcConfigFileInfoIterNext, & FcConfigFileInfoIterGet