From 77762b284a375f7e9a862e31e68d7a4417278d5b Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Mon, 14 Nov 2022 22:16:08 +1300 Subject: [PATCH] Draft bindings for FcConfig! --- Graphics/Text/Font/Choose/Config.hs | 275 +++++++++++++++++++++++++++ Graphics/Text/Font/Choose/SetName.hs | 0 2 files changed, 275 insertions(+) delete mode 100644 Graphics/Text/Font/Choose/SetName.hs diff --git a/Graphics/Text/Font/Choose/Config.hs b/Graphics/Text/Font/Choose/Config.hs index e69de29..763d7df 100644 --- a/Graphics/Text/Font/Choose/Config.hs +++ b/Graphics/Text/Font/Choose/Config.hs @@ -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 diff --git a/Graphics/Text/Font/Choose/SetName.hs b/Graphics/Text/Font/Choose/SetName.hs deleted file mode 100644 index e69de29..0000000 -- 2.30.2