2 files changed, 21 insertions(+), 15 deletions(-)

M Graphics/Text/Font/Choose/FontSet.hs
M fontconfig-pure.cabal

@@ 4,7 4,7 @@ module Graphics.Text.Font.Choose.FontSet where
 import Graphics.Text.Font.Choose.Pattern
 --import Graphics.Text.Font.Choose.Config
 import Graphics.Text.Font.Choose.ObjectSet
-import Graphics.Text.Font.Choose.Result (throwFalse)
+import Graphics.Text.Font.Choose.Result (throwFalse, throwNull)
 
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
 import Foreign.Storable (pokeElemOff, sizeOf, peek)


@@ 16,11 16,14 @@ import Control.Exception (bracket)
 type FontSet = [Pattern]
 
 {-fontSetList :: Config -> [FontSet] -> Pattern -> ObjectSet
-fontSetList config fontss pattern objs = withConfig config $ \config' ->
-    withFontSets fontss $ \fontss' -> withPattern $ \pattern' ->
-        withObjectSet objs $ \objs' -> do
-            ret <- fcFontSetList config' fontss' n pattern' objs'
-            thawFontSet ret
+fontSetList config fontss pattern objs = unsafePerformIO $ withConfig config $ \config' ->
+    withFontSets fontss $ \fontss' n -> withPattern $ \pattern' ->
+        withObjectSet objs $ \objs' ->
+            thawFontSet_ $ fcFontSetList config' fontss' n pattern' objs'
+fontSetList' :: [FontSet] -> Pattern -> ObjectSet
+fontSetList' fontss pattern objs = unsafePerformIO $ withFontSets fontss $ \fontss' n ->
+    withPattern $ \pattern' -> withObjectSet objs $ \objs' ->
+        thawFontSet_ $ fcFontSetList nullPtr fontss' n pattern' objs'
 foreign import ccall "FcFontSetList" fcFontSetList ::
     Config_ -> Ptr FontSet_ -> Int -> Pattern_ -> ObjectSet_ -> IO FontSet_
 


@@ 28,19 31,18 @@ fontSetMatch :: Config -> [FontSet] -> Pattern -> Maybe Pattern
 fontSetMatch config fontss pattern = withConfig config $ \config' ->
     withFontSets fontss $ \fontss' -> withPattern $ \pattern' ->  alloca $ \res' -> do
         ret <- fcFontSetMatch config' fontss' n pattern' res'
-        res <- peek res'
-        -- FIXME Is this correct success code?
-        if res == 0 then Just <$> thawPattern ret else return Nothing
+        throwPtr res' $ thawPattern_ $ pure ret
+foreign import ccall "FcFontSetMatch" fcFontSetMatch ::
+    Config_ -> Ptr FontSet_ -> Int -> Pattern_ -> IO Pattern_
 
 fontSetSort :: Config -> [FontSet] -> Pattern -> Bool -> CharSet -> Maybe FontSet
 fontSetSort config fontss pattern trim csp cb = withConfig config $ \config' ->
         withFontSets fontss $ \fontss' withPattern $ \pattern' ->
             withCharSet csp $ \csp' -> alloca $ \res' -> do
                 ret' <- fcFontSetSort config' fontss' n pattern' trim csp' res'
-                res <- peek res'
-                ret <- if res == 0 then Just <$> thawFontSet ret' else return Nothing
-                fcFontSetDestroy ret'
-                return ret-}
+                throwPtr res' $ thawFontSet_ $ pure ret'
+foreign import ccall "FcFontSetSort" fcFontSetSort ::
+    Config_ -> Ptr FontSet_ -> Int -> Pattern_ -> Bool -> CharSet_ -> Ptr Int -> IO FontSet_ -}
 
 ------
 --- Low-level


@@ 61,10 63,10 @@ withFontSet fonts cb = withNewFontSet $ \fonts' -> do
     cb fonts'
 foreign import ccall "FcFontSetAdd" fcFontSetAdd :: FontSet_ -> Pattern_ -> IO Bool
 
-withFontSets :: [FontSet] -> (Ptr FontSet_ -> IO a) -> IO a
+withFontSets :: [FontSet] -> (Ptr FontSet_ -> Int -> IO a) -> IO a
 withFontSets fontss cb = let n = length fontss in
     allocaBytes (sizeOf (undefined :: FontSet_) * n) $ \fontss' ->
-        withFontSets' fontss 0 fontss' $ cb fontss'
+        withFontSets' fontss 0 fontss' $ cb fontss' n
 withFontSets' :: [FontSet] -> Int -> Ptr FontSet_ -> IO a -> IO a
 withFontSets' [] _ _ cb = cb
 withFontSets' (fonts:fontss) i fontss' cb = withFontSet fonts $ \fonts' -> do


@@ 78,3 80,5 @@ thawFontSet fonts' = do
     if n == 0 || array == nullPtr
     then return []
     else forM [0..pred n] $ \i -> thawPattern =<< peek (advancePtr array i)
+thawFontSet_ :: IO FontSet_ -> IO FontSet
+thawFontSet_ cb = bracket (throwNull <$> cb) fcFontSetDestroy thawFontSet

@@ 70,6 70,8 @@ library
                         linear >= 1.0.1 && <2, freetype2 >= 0.2 && < 0.3,
                         hashable >= 1.3 && <2
 
+  pkgconfig-depends:    fontconfig
+
   -- Directories containing source files.
   -- hs-source-dirs: