6 files changed, 59 insertions(+), 27 deletions(-)

M Graphics/Text/Font/Choose.hs
M Graphics/Text/Font/Choose/Config.hs
M Graphics/Text/Font/Choose/FontSet.hs
M Graphics/Text/Font/Choose/Pattern.hs
M Main.hs
M cbits/pattern.c

@@ 10,7 10,7 @@ module Graphics.Text.Font.Choose(CharSet, FontSet, ObjectSet, Pattern(..), Bindi
   configAppFontAddFile, configAppFontAddFile', configAppFontAddDir, configAppFontAddDir',
   MatchKind(..), configSubstituteWithPat, configSubstituteWithPat', fontList, fontList', 
   configSubstitute, configSubstitute', fontMatch, fontMatch', fontSort, fontSort',
-  fontRenderPrepare, fontRenderPrepare', configGetFilename, configGetFilename',
+  fontRenderPrepare, fontRenderPrepare', -- configGetFilename, configGetFilename',
   configParseAndLoad, configParseAndLoad', configGetSysRoot, configGetSysRoot',
   configParseAndLoadFromMemory, configParseAndLoadFromMemory',
   configSetSysRoot, configSetSysRoot', configGetFileInfo, configGetFileInfo',


@@ 21,7 21,8 @@ module Graphics.Text.Font.Choose(CharSet, FontSet, ObjectSet, Pattern(..), Bindi
 
   LangSet, defaultLangs, langs, langSetCompare, langNormalize, langCharSet,
 
-  equalSubset, normalizePattern, filter, substitute, nameParse, nameUnparse, format) where
+  equalSubset, normalizePattern, filter, defaultSubstitute, nameParse, nameUnparse, format
+    ) where
 
 import Prelude hiding (init, filter)
 


@@ 35,7 36,7 @@ import Graphics.Text.Font.Choose.Config (Config, configCreate,
   configAppFontAddFile, configAppFontAddFile', configAppFontAddDir, configAppFontAddDir',
   MatchKind(..), configSubstituteWithPat, configSubstituteWithPat', fontList, fontList', 
   configSubstitute, configSubstitute', fontMatch, fontMatch', fontSort, fontSort',
-  fontRenderPrepare, fontRenderPrepare', configGetFilename, configGetFilename',
+  fontRenderPrepare, fontRenderPrepare', -- configGetFilename, configGetFilename',
   configParseAndLoad, configParseAndLoad', configGetSysRoot, configGetSysRoot',
   configParseAndLoadFromMemory, configParseAndLoadFromMemory',
   configSetSysRoot, configSetSysRoot', configGetFileInfo, configGetFileInfo')


@@ 48,7 49,7 @@ import Graphics.Text.Font.Choose.LangSet (LangSet, defaultLangs, langs,
     langSetCompare, langNormalize, langCharSet)
 import Graphics.Text.Font.Choose.ObjectSet (ObjectSet)
 import Graphics.Text.Font.Choose.Pattern (Pattern(..), Binding(..), equalSubset,
-    normalizePattern, filter, substitute, nameParse, nameUnparse, format)
+    normalizePattern, filter, defaultSubstitute, nameParse, nameUnparse, format)
 import Graphics.Text.Font.Choose.Range (Range(..), iRange)
 import Graphics.Text.Font.Choose.Strings (StrSet, StrList)
 import Graphics.Text.Font.Choose.Value (Value(..))

@@ 170,16 170,22 @@ fontMatch' pattern = unsafePerformIO $ withPattern pattern $ \pattern' -> alloca
 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
+fontSort :: Config -> Pattern -> Bool -> Maybe (FontSet, CharSet)
+fontSort config pattern trim = unsafePerformIO $ withForeignPtr config $ \config' ->
+    withPattern pattern $ \pattern' -> withNewCharSet $ \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
+        throwPtr res' $ do
+            x <- thawFontSet_ $ pure $ throwNull ret
+            y <- thawCharSet $ throwNull csp'
+            return (x, y)
+fontSort' :: Pattern -> Bool -> Maybe (FontSet, CharSet)
+fontSort' pattern trim = unsafePerformIO $ withPattern pattern $ \pattern' ->
+    withNewCharSet $ \csp' -> alloca $ \res' -> do
         ret <- fcFontSort nullPtr pattern' trim csp' res'
-        throwPtr res' $ thawFontSet_ $ pure ret
+        throwPtr res' $ do
+            x <- thawFontSet_ $ pure $ throwNull ret
+            y <- thawCharSet $ throwNull csp'
+            return (x, y)
 foreign import ccall "FcFontSort" fcFontSort ::
     Config_ -> Pattern_ -> Bool -> CharSet_ -> Ptr Int -> IO FontSet_
 


@@ 208,7 214,7 @@ fontList' p os = unsafePerformIO $ withPattern p $ \p' -> withObjectSet os $ \os
 foreign import ccall "FcFontList" fcFontList ::
     Config_ -> Pattern_ -> ObjectSet_ -> IO FontSet_
 
-configGetFilename :: Config -> String -> String
+{-configGetFilename :: Config -> String -> String
 configGetFilename config name = unsafePerformIO $ withForeignPtr config $ \config' ->
     withCString name $ \name' -> do
         ret <- fcConfigGetFilename config' name'


@@ 218,7 224,7 @@ 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
+peekCString' txt = bracket (pure $ throwNull txt) free peekCString-}
 
 configParseAndLoad :: Config -> String -> Bool -> IO Bool
 configParseAndLoad config name complain = withForeignPtr config $ \config' ->

@@ 5,9 5,9 @@ import Graphics.Text.Font.Choose.Pattern
 import Graphics.Text.Font.Choose.Result (throwFalse, throwNull)
 
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
-import Foreign.Storable (pokeElemOff, sizeOf, peek)
+import Foreign.Storable (pokeElemOff, sizeOf)
 import Foreign.Marshal.Alloc (allocaBytes)
-import Foreign.Marshal.Array (advancePtr)
+import Foreign.Marshal.Array (peekArray)
 import Control.Monad (forM)
 import Control.Exception (bracket)
 


@@ 16,7 16,7 @@ type FontSet = [Pattern]
 ------
 --- Low-level
 ------
-type FontSet' = Int
+data FontSet'
 type FontSet_ = Ptr FontSet'
 
 withNewFontSet :: (FontSet_ -> IO a) -> IO a


@@ 44,10 44,15 @@ withFontSets' (fonts:fontss) i fontss' cb = withFontSet fonts $ \fonts' -> do
 
 thawFontSet :: FontSet_ -> IO FontSet
 thawFontSet fonts' = do
-    n <- peek fonts'
-    array <- peek $ castPtr $ advancePtr fonts' 2
+    n <- get_fontSet_nfont fonts'
+    array <- get_fontSet_fonts fonts'
     if n == 0 || array == nullPtr
     then return []
-    else forM [0..pred n] $ \i -> thawPattern =<< peek (advancePtr array i)
+    else do
+        list <- peekArray n array
+        forM list (thawPattern . throwNull)
+foreign import ccall "get_fontSet_nfont" get_fontSet_nfont :: FontSet_ -> IO Int
+foreign import ccall "get_fontSet_fonts" get_fontSet_fonts :: FontSet_ -> IO (Ptr Pattern_)
+
 thawFontSet_ :: IO FontSet_ -> IO FontSet
 thawFontSet_ cb = bracket (throwNull <$> cb) fcFontSetDestroy thawFontSet

@@ 1,6 1,6 @@
 {-# LANGUAGE DeriveGeneric #-}
 module Graphics.Text.Font.Choose.Pattern (Pattern(..), Binding(..), equalSubset,
-    normalizePattern, filter, substitute, nameParse, nameUnparse, format,
+    normalizePattern, filter, defaultSubstitute, nameParse, nameUnparse, format,
     Pattern_, withPattern, thawPattern, thawPattern_, patternAsPointer) where
 
 import Prelude hiding (filter)


@@ 48,8 48,8 @@ filter pat objs =
 foreign import ccall "FcPatternFilter" fcPatternFilter ::
     Pattern_ -> ObjectSet_ -> IO Pattern_
 
-substitute :: Pattern -> Pattern
-substitute pat = unsafePerformIO $ withPattern pat $ \pat' -> do
+defaultSubstitute :: Pattern -> Pattern
+defaultSubstitute pat = unsafePerformIO $ withPattern pat $ \pat' -> do
     ret <- fcDefaultSubstitute pat'
     thawPattern pat'
 foreign import ccall "FcDefaultSubstitute" fcDefaultSubstitute :: Pattern_ -> IO ()


@@ 131,7 131,8 @@ thawPattern' pat' iter' = do
                 binding <- peek binding'
                 val' <- thawValue val'
                 return $ case val' of
-                    Just val -> Just (toEnum binding, val)
+                    Just val | binding >= 0 && binding <= 2 -> Just (toEnum binding, val)
+                    Just val -> Just (Same, val)
                     Nothing -> Nothing
     return (obj, catMaybes $ map join values)
 foreign import ccall "FcPatternIterGetObject" fcPatternIterGetObject ::

@@ 4,12 4,23 @@ module Main where
 import "fontconfig-pure" Graphics.Text.Font.Choose as Font
 
 import System.Environment (getArgs)
+import Control.Monad (forM)
 
 main :: IO ()
 main = do
     args <- getArgs
-    let (name, objects) = case args of {
-        [] -> ("serif", []);
-        name:objects -> (name, objects)}
+    let (all, name, objects) = case args of {
+        [] -> (False, "serif", []);
+        "!":name:objects -> (True, name, objects);
+        name:objects -> (False, name, objects)}
     let query = nameParse name
     print query
+    let query' = defaultSubstitute $ configSubstitute' query MatchPattern
+    print query'
+
+    case fontSort' query' all of
+        Just (res, charset) -> do
+            print charset
+            forM res $ \res' -> print $ fontRenderPrepare' query' res'
+            return ()
+        Nothing -> putStrLn "No results!"

@@ 26,3 26,11 @@ int size_PatternIter() {
 int size_ConfigFileInfoIter() {
     return sizeof(FcConfigFileInfoIter);
 }
+
+int get_fontSet_nfont(FcFontSet *fonts) {
+    return fonts->nfont;
+}
+
+FcPattern **get_fontSet_fonts(FcFontSet *fonts) {
+    return fonts->fonts;
+}