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, FunPtr)
import Foreign.Marshal.Alloc (alloca, allocaBytes, free)
import Foreign.Storable (Storable(..))
import Foreign.C.String (CString, peekCString, withCString)
import System.IO.Unsafe (unsafePerformIO)
import Control.Exception (bracket)
import Graphics.Text.Font.Choose.Result (throwNull, throwFalse, throwPtr)
type Config = ForeignPtr Config'
data Config'
type Config_ = Ptr Config'
configCreate :: IO Config
configCreate = newForeignPtr fcConfigDestroy =<< throwNull <$> fcConfigCreate
foreign import ccall "FcConfigCreate" fcConfigCreate :: IO Config_
ptr2config = newForeignPtr fcConfigDestroy
foreign import ccall "&FcConfigDestroy" fcConfigDestroy :: FunPtr (Config_ -> IO ())
configSetCurrent :: Config -> IO ()
configSetCurrent config = throwFalse =<< (withForeignPtr config $ fcConfigSetCurrent)
foreign import ccall "FcConfigSetCurrent" fcConfigSetCurrent :: Config_ -> IO Bool
configGetCurrent :: IO Config
configGetCurrent = (throwNull <$> fcConfigReference nullPtr) >>=
newForeignPtr fcConfigDestroy
foreign import ccall "FcConfigReference" fcConfigReference :: Config_ -> 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
foreign import ccall "FcConfigEnableHome" configEnableHome :: Bool -> IO Bool
configBuildFonts :: Config -> IO ()
configBuildFonts config = throwFalse =<< (withForeignPtr config $ fcConfigBuildFonts)
configBuildFonts' :: IO ()
configBuildFonts' = throwFalse =<< fcConfigBuildFonts nullPtr
foreign import ccall "FcConfigBuildFonts" 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, Eq, Show, Read)
configGetFonts :: Config -> SetName -> IO FontSet
configGetFonts config set = do
ret <- withForeignPtr config $ flip fcConfigGetFonts $ fromEnum set
thawFontSet $ throwNull ret
configGetFonts' :: SetName -> IO FontSet
configGetFonts' set = do
ret <- fcConfigGetFonts nullPtr $ fromEnum set
thawFontSet $ throwNull ret
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 ()
configSetRescanInterval config val =
throwFalse =<< (withForeignPtr config $ flip fcConfigSetRescanInterval val)
configSetRescanInterval' :: Int -> IO ()
configSetRescanInterval' v = throwFalse =<< fcConfigSetRescanInterval nullPtr v
foreign import ccall "FcConfigSetRescanInterval" fcConfigSetRescanInterval ::
Config_ -> Int -> IO Bool
configAppFontAddFile :: Config -> String -> IO ()
configAppFontAddFile config file = throwFalse =<<
(withForeignPtr config $ \config' -> withCString file $ \file' ->
fcConfigAppFontAddFile config' file')
configAppFontAddFile' :: String -> IO ()
configAppFontAddFile' file =
throwFalse =<< (withCString file $ fcConfigAppFontAddFile nullPtr)
foreign import ccall "FcConfigAppFontAddFile" fcConfigAppFontAddFile ::
Config_ -> CString -> IO Bool
configAppFontAddDir :: Config -> String -> IO ()
configAppFontAddDir config file = throwFalse =<<
(withForeignPtr config $ \config' -> withCString file $ fcConfigAppFontAddDir config')
configAppFontAddDir' :: String -> IO ()
configAppFontAddDir' v = throwFalse =<< (withCString v $ fcConfigAppFontAddDir nullPtr)
foreign import ccall "FcConfigAppFontAddDir" fcConfigAppFontAddDir ::
Config_ -> CString -> IO Bool
configAppFontClear :: Config -> IO ()
configAppFontClear config = throwFalse =<< withForeignPtr config fcConfigAppFontClear
configAppFontClear' :: IO ()
configAppFontClear' = throwFalse =<< fcConfigAppFontClear nullPtr
foreign import ccall "FcConfigAppFontClear" fcConfigAppFontClear :: Config_ -> IO Bool
data MatchKind = MatchPattern | MatchFont | MatchScan deriving Enum
configSubstituteWithPat :: Config -> Pattern -> Pattern -> MatchKind -> 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
throwFalse ok
thawPattern p'
configSubstituteWithPat' :: Pattern -> Pattern -> MatchKind -> Pattern
configSubstituteWithPat' p p_pat kind = unsafePerformIO $
withPattern p $ \p' -> withPattern p_pat $ \p_pat' -> do
ok <- fcConfigSubstituteWithPat nullPtr p' p_pat' $ fromEnum kind
throwFalse ok
thawPattern p'
foreign import ccall "FcConfigSubstituteWithPat" fcConfigSubstituteWithPat ::
Config_ -> Pattern_ -> Pattern_ -> Int -> IO Bool
configSubstitute :: Config -> Pattern -> MatchKind -> Pattern
configSubstitute config p kind = unsafePerformIO $
withForeignPtr config $ \config' -> withPattern p $ \p' -> do
ok <- fcConfigSubstitute config' p' $ fromEnum kind
throwFalse ok
thawPattern p'
configSubstitute' :: Pattern -> MatchKind -> Pattern
configSubstitute' p kind = unsafePerformIO $ withPattern p $ \p' -> do
ok <- fcConfigSubstitute nullPtr p' $ fromEnum kind
throwFalse ok
thawPattern p'
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'
throwPtr res' $ thawPattern_ $ pure ret
fontMatch' :: Pattern -> Maybe Pattern
fontMatch' pattern = unsafePerformIO $ withPattern pattern $ \pattern' -> alloca $ \res' -> do
ret <- fcFontMatch nullPtr pattern' res'
throwPtr res' $ thawPattern_ $ pure ret
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'
throwPtr res' $ thawFontSet_ $ pure ret
fontSort' :: Pattern -> Bool -> CharSet -> Maybe FontSet
fontSort' pattern trim csp = unsafePerformIO $ withPattern pattern $ \pattern' ->
withCharSet csp $ \csp' -> alloca $ \res' -> do
ret <- fcFontSort nullPtr pattern' trim csp' res'
throwPtr res' $ thawFontSet_ $ pure ret
foreign import ccall "FcFontSort" fcFontSort ::
Config_ -> Pattern_ -> Bool -> CharSet_ -> Ptr Int -> IO FontSet_
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_ $ pure $ throwNull ret
fontRenderPrepare' :: Pattern -> Pattern -> Pattern
fontRenderPrepare' pat font = unsafePerformIO $ withPattern pat $ \pat' ->
withPattern font $ \font' -> do
ret <- fcFontRenderPrepare nullPtr pat' font'
thawPattern_ $ pure 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 <- fcFontList config' p' os'
thawFontSet_ $ pure ret
fontList' :: Pattern -> ObjectSet -> FontSet
fontList' p os = unsafePerformIO $ withPattern p $ \p' -> withObjectSet os $ \os' -> do
ret <- fcFontList nullPtr p' os'
thawFontSet_ $ pure 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' -> do
ret <- fcConfigGetFilename nullPtr name'
peekCString' ret
foreign import ccall "FcConfigGetFilename" fcConfigGetFilename :: Config_ -> CString -> IO CString
peekCString' txt = bracket (pure $ throwNull txt) free peekCString
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 $ throwNull ret
configGetSysRoot' :: IO String
configGetSysRoot' = (peekCString .throwNull) =<< 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' -> allocaBytes configFileInfoIter'Size $ \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'
foreign import ccall "size_ConfigFileInfoIter" configFileInfoIter'Size :: Int
type ConfigFileInfoIter_ = Ptr ConfigFileInfoIter'
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 = thawStrList_ $ withForeignPtr config cb