M Graphics/Text/Font/Choose/Config.hs => Graphics/Text/Font/Choose/Config.hs +275 -0
@@ 0,0 1,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
D Graphics/Text/Font/Choose/SetName.hs => Graphics/Text/Font/Choose/SetName.hs +0 -0