From 21f288ec7cd334c64016c5537065660832b0a124 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Fri, 18 Nov 2022 16:44:40 +1300 Subject: [PATCH] Get language bindings for FcConfig type compiling. --- Graphics/Text/Font/Choose/Config.hs | 69 +++++++++++++++++------------ Graphics/Text/Font/Choose/Value.hs | 1 + cbits/pattern.c | 4 ++ fontconfig-pure.cabal | 3 +- 4 files changed, 47 insertions(+), 30 deletions(-) diff --git a/Graphics/Text/Font/Choose/Config.hs b/Graphics/Text/Font/Choose/Config.hs index 763d7df..c15d432 100644 --- a/Graphics/Text/Font/Choose/Config.hs +++ b/Graphics/Text/Font/Choose/Config.hs @@ -5,10 +5,13 @@ 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 Graphics.Text.Font.Choose.Result (throwNull, throwFalse) import Foreign.ForeignPtr -import Foreign.Ptr (Ptr, nullPtr) -import Foreign.C.String (CString, peekCString) +import Foreign.Ptr (Ptr, nullPtr, FunPtr) +import Foreign.Marshal.Alloc (alloca, allocaBytes) +import Foreign.Storable (Storable(..)) +import Foreign.C.String (CString, peekCString, withCString) import System.IO.Unsafe (unsafePerformIO) type Config = ForeignPtr Config' @@ -16,13 +19,18 @@ data Config' type Config_ = Ptr Config' configCreate :: IO Config -configCreate = newForeignPtr fcConfigDestroy =<< fcConfigCreate +configCreate = newForeignPtr fcConfigDestroy =<< throwNull <$> fcConfigCreate foreign import ccall "FcConfigCreate" fcConfigCreate :: IO Config_ -foreign import ccall "FcConfigDestroy" fcConfigDestroy :: Config_ -> IO () +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 = newForeignPtr_ =<< fcConfigGetCurrent -foreign import ccall "FcConfigGetCurrent" fcConfigGetCurrent :: 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 @@ -34,14 +42,13 @@ configHome = do 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 +foreign import ccall "FcConfigBuildFonts" fcConfigBuildFonts :: Config_ -> IO Bool configGetConfigDirs :: Config -> IO StrList configGetConfigDirs = configStrsFunc fcConfigGetConfigDirs @@ -73,8 +80,8 @@ 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_ +configGetFonts' set = thawFontSet_ $ fcConfigGetFonts nullPtr $ fromEnum set +foreign import ccall "FcConfigGetFonts" fcConfigGetFonts :: Config_ -> Int -> IO FontSet_ configGetRescanInterval :: Config -> IO Int configGetRescanInterval = flip withForeignPtr $ fcConfigGetRescanInterval @@ -135,7 +142,7 @@ configSubstitute config p kind = unsafePerformIO $ 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 +configSubstitute' 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 :: @@ -152,22 +159,23 @@ fontMatch' pattern = unsafePerformIO $ withPattern pattern $ \pattern' -> alloca 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_ +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 + if res == 0 then Just <$> thawFontSet ret else return Nothing fontSort' :: Pattern -> Bool -> CharSet -> Maybe FontSet -fontSort' pattern trim csp = unsafePerformIO $ withPattern $ \pattern' -> +fontSort' pattern trim csp = unsafePerformIO $ withPattern pattern $ \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 + if res == 0 then Just <$> thawFontSet ret else return Nothing foreign import ccall "FcFontSort" fcFontSort :: - Config_ -> Pattern_ -> Bool -> CharSet_ -> Ptr Int -> IO Pattern_ + Config_ -> Pattern_ -> Bool -> CharSet_ -> Ptr Int -> IO FontSet_ fontRenderPrepare :: Config -> Pattern -> Pattern -> Pattern fontRenderPrepare config pat font = unsafePerformIO $ withForeignPtr config $ \config' -> @@ -185,13 +193,14 @@ foreign import ccall "FcFontRenderPrepare" fcFontRenderPrepare :: 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' + ret <- fcFontList 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' + ret <- fcFontList nullPtr p' os' thawFontSet ret -foreign import ccall "FcFontList" fcFontList :: Config_ -> Pattern_ -> ObjectSet_ -> IO FontSet_ +foreign import ccall "FcFontList" fcFontList :: + Config_ -> Pattern_ -> ObjectSet_ -> IO FontSet_ configGetFilename :: Config -> String -> String configGetFilename config name = unsafePerformIO $ withForeignPtr config $ \config' -> @@ -199,7 +208,7 @@ configGetFilename config name = unsafePerformIO $ withForeignPtr config $ \confi ret <- fcConfigGetFilename config' name' peekCString ret configGetFilename' :: String -> String -configGetFilename' name = unsafePerformIO $ withCString name $ \name' -> +configGetFilename' name = unsafePerformIO $ withCString name $ \name' -> do ret <- fcConfigGetFilename nullPtr name' peekCString ret foreign import ccall "FcConfigGetFilename" fcConfigGetFilename :: Config_ -> CString -> IO CString @@ -218,7 +227,7 @@ configParseAndLoadFromMemory config buffer complain = withForeignPtr config $ \c withCString buffer $ \buffer' -> fcConfigParseAndLoadFromMemory config' buffer' complain configParseAndLoadFromMemory' :: String -> Bool -> IO Bool -configParseAndLoadFromMemory' buffer complain = withCString buffer $ \buffer' -=> +configParseAndLoadFromMemory' buffer complain = withCString buffer $ \buffer' -> fcConfigParseAndLoadFromMemory nullPtr buffer' complain foreign import ccall "FcConfigParseAndLoadFromMemory" fcConfigParseAndLoadFromMemory :: Config_ -> CString -> Bool -> IO Bool @@ -239,27 +248,29 @@ 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 +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' + 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 + 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 [] + Nothing -> return []} go data ConfigFileInfoIter' -type ConfigFileInfoIter_ = Ptr ConfigFileInfo' +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 :: diff --git a/Graphics/Text/Font/Choose/Value.hs b/Graphics/Text/Font/Choose/Value.hs index ce20729..dbbee5a 100644 --- a/Graphics/Text/Font/Choose/Value.hs +++ b/Graphics/Text/Font/Choose/Value.hs @@ -17,6 +17,7 @@ import Foreign.C.String (withCString, peekCString) import GHC.Generics (Generic) import Data.Hashable (Hashable) +import Graphics.Text.Font.Choose.Result (throwNull) data Value = ValueVoid | ValueInt Int diff --git a/cbits/pattern.c b/cbits/pattern.c index 39cab51..393c6a6 100644 --- a/cbits/pattern.c +++ b/cbits/pattern.c @@ -22,3 +22,7 @@ int size_matrix() { int size_PatternIter() { return sizeof(FcPatternIter); } + +int size_ConfigFileInfoIter() { + return sizeof(FcConfigFileInfoIter); +} diff --git a/fontconfig-pure.cabal b/fontconfig-pure.cabal index 2814804..ab21c07 100644 --- a/fontconfig-pure.cabal +++ b/fontconfig-pure.cabal @@ -55,7 +55,8 @@ library Graphics.Text.Font.Choose.ObjectSet, Graphics.Text.Font.Choose.CharSet, Graphics.Text.Font.Choose.Strings, Graphics.Text.Font.Choose.Range, Graphics.Text.Font.Choose.LangSet, Graphics.Text.Font.Choose.Value, - Graphics.Text.Font.Choose.Pattern, Graphics.Text.Font.Choose.FontSet + Graphics.Text.Font.Choose.Pattern, Graphics.Text.Font.Choose.FontSet, + Graphics.Text.Font.Choose.Config c-sources: cbits/pattern.c -- 2.30.2