fontconfig-pure 0.2.0.1 → 0.3.0.0

raw patch · 6 files changed

+80/−42 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• Graphics/Text/Font/Choose.hs +3/−2
• Graphics/Text/Font/Choose/CharSet.hs +39/−27
• cbits/charsetiter.c +31/−0
• cbits/pattern.c +0/−11
• fontconfig-pure.cabal +2/−2

@@ -1,5 +1,10 @@ # Revision history for fontconfig-pure +## 0.3.0.0 -- 2023-10-01++* Addressing segfaults & mainloops.+* Switched underlying CharSet collection to IntSet for efficiency.+ ## 0.1.0.0 -- YYYY-mm-dd  * First version. Released on an unsuspecting world.

@@ -1,5 +1,5 @@-module Graphics.Text.Font.Choose(CharSet, FontSet, ObjectSet, Pattern(..), Binding(..),-  Range(..), iRange, StrSet, StrList, Value(..), FontFaceParser(..),+module Graphics.Text.Font.Choose(CharSet, chr, ord, FontSet, ObjectSet, Pattern(..),+  Binding(..), Range(..), iRange, StrSet, StrList, Value(..), FontFaceParser(..),    Config, configCreate,   configSetCurrent, configGetCurrent, configUptoDate, configHome, configEnableHome,@@ -26,6 +26,7 @@     ) where  import Prelude hiding (init, filter)+import Data.Char (chr, ord) -- For use with CharSet  import Graphics.Text.Font.Choose.CharSet (CharSet) import Graphics.Text.Font.Choose.Config (Config, configCreate,

@@ -1,11 +1,13 @@ module Graphics.Text.Font.Choose.CharSet where -import Data.Set (Set, union)-import qualified Data.Set as Set+import Data.IntSet (IntSet, union)+import qualified Data.IntSet as IntSet import Graphics.Text.Font.Choose.Result (throwNull, throwFalse)+import System.IO.Unsafe (unsafeInterleaveIO)  import Data.Word (Word32) import Foreign.Ptr+import Foreign.ForeignPtr (newForeignPtr, withForeignPtr) import Control.Exception (bracket) import Control.Monad (forM) import Foreign.Marshal.Alloc (alloca)@@ -15,29 +17,33 @@ import Numeric (readHex)  -- | An FcCharSet is a set of Unicode chars.-type CharSet = Set Char+type CharSet = IntSet -parseChar :: String -> Char+parseChar :: String -> Int parseChar str | ((x, _):_) <- readHex str = toEnum x+replaceWild :: Char -> String -> String replaceWild ch ('?':rest) = ch:replaceWild ch rest replaceWild ch (c:cs) = c:replaceWild ch cs replaceWild _ "" = ""+parseWild :: Char -> String -> Int parseWild ch str = parseChar $ replaceWild ch str -- | Utility for parsing "unicode-range" @font-face property.+parseCharSet :: String -> Maybe CharSet parseCharSet ('U':rest) = parseCharSet ('u':rest) -- lowercase initial "u" parseCharSet ('u':'+':cs)     | (start@(_:_), '-':ends) <- span isHexDigit cs,         (end@(_:_), rest) <- span isHexDigit ends, Just set <- parseCharSet' rest =-            Just $ Set.union set $ Set.fromList [parseChar start..parseChar end]+            Just $ union set $ IntSet.fromList [parseChar start..parseChar end]     | (codepoint@(_:_), rest) <- span isHexDigit cs, Just set <- parseCharSet' rest =-        Just $ flip Set.insert set $ parseChar codepoint+        Just $ flip IntSet.insert set $ parseChar codepoint     | (codepoint@(_:_), rest) <- span (\c -> isHexDigit c || c == '?') cs,         Just set <- parseCharSet' rest =-            Just $ Set.union set $ Set.fromList [+            Just $ IntSet.union set $ IntSet.fromList [                 parseWild '0' codepoint..parseWild 'f' codepoint] parseCharSet _ = Nothing+parseCharSet' :: String -> Maybe CharSet parseCharSet' (',':rest) = parseCharSet rest-parseCharSet' "" = Just Set.empty+parseCharSet' "" = Just IntSet.empty parseCharSet' _ = Nothing  ------@@ -54,30 +60,36 @@  withCharSet :: CharSet -> (CharSet_ -> IO a) -> IO a withCharSet chars cb = withNewCharSet $ \chars' -> do-    forM (Set.elems chars) $ \ch' ->-        throwFalse <$> (fcCharSetAddChar chars' $ fromIntegral $ ord ch')+    forM (IntSet.elems chars) $ \ch' ->+        throwFalse <$> (fcCharSetAddChar chars' $ fromIntegral ch')     cb chars' foreign import ccall "FcCharSetAddChar" fcCharSetAddChar :: CharSet_ -> Word32 -> IO Bool  thawCharSet :: CharSet_ -> IO CharSet thawCharSet chars'-    | chars' == nullPtr = return Set.empty-    | otherwise = allocaArray fcCHARSET_MAP_SIZE $ \iter' -> alloca $ \next' -> do-        first <- fcCharSetFirstPage chars' iter' next'-        let go = do-                ch <- fcCharSetNextPage chars' iter' next'-                if ch == maxBound then return []-                else do-                    chs <- go-                    return (ch:chs)-        if first == maxBound then return Set.empty else do-            rest <- go-            return $ Set.fromList $ map (unsafeChr . fromIntegral) (first:rest)-foreign import ccall "my_FcCharSetFirstPage" fcCharSetFirstPage ::-    CharSet_ -> Ptr Word32 -> Ptr Word32 -> IO Word32-foreign import ccall "my_FcCharSetNextPage" fcCharSetNextPage ::-    CharSet_ -> Ptr Word32 -> Ptr Word32 -> IO Word32-foreign import ccall "my_FcCHARSET_MAP_SIZE" fcCHARSET_MAP_SIZE :: Int+    | chars' == nullPtr = return IntSet.empty+    | otherwise = do+        iter' <- throwNull <$> fcCharSetIterCreate chars'+        iter <- newForeignPtr (fcCharSetIterDestroy) iter'+        x <- withForeignPtr iter fcCharSetIterStart+        let go x' | fcCharSetIterDone x' = return []+                | otherwise = unsafeInterleaveIO $ do+                    y <- withForeignPtr iter fcCharSetIterNext+                    xs <- go y+                    return (x':xs)+        ret <- go x+        return $ IntSet.fromList $ map (fromIntegral) ret+data CharSetIter'+type CharSetIter_ = Ptr CharSetIter'+foreign import ccall "my_FcCharSetIterCreate" fcCharSetIterCreate ::+    CharSet_ -> IO CharSetIter_+foreign import ccall "&my_FcCharSetIterDestroy" fcCharSetIterDestroy ::+    FunPtr (CharSetIter_ -> IO ())+foreign import ccall "my_FcCharSetIterStart" fcCharSetIterStart ::+    CharSetIter_ -> IO Word32+foreign import ccall "my_FcCharSetIterNext" fcCharSetIterNext ::+    CharSetIter_ -> IO Word32+foreign import ccall "my_FcCharSetIterDone" fcCharSetIterDone :: Word32 -> Bool  thawCharSet_ :: IO CharSet_ -> IO CharSet thawCharSet_ cb = bracket (throwNull <$> cb) fcCharSetDestroy thawCharSet

@@ -0,0 +1,31 @@+#include <fontconfig/fontconfig.h>+#include <stdlib.h>++struct my_FcCharSetIter {+    FcCharSet *charset;+    FcChar32 map[FC_CHARSET_MAP_SIZE];+    FcChar32 next;+};++struct my_FcCharSetIter *my_FcCharSetIterCreate(FcCharSet *a) {+    struct my_FcCharSetIter *self = malloc(sizeof(struct my_FcCharSetIter));+    self->charset = FcCharSetCopy(a);+    return self;+}++void my_FcCharSetIterDestroy(struct my_FcCharSetIter *self) {+    FcCharSetDestroy(self->charset);+    free(self);+}++FcChar32 my_FcCharSetIterStart(struct my_FcCharSetIter *self) {+    return FcCharSetFirstPage(self->charset, self->map, &self->next);+}++FcChar32 my_FcCharSetIterNext(struct my_FcCharSetIter *self) {+    return FcCharSetNextPage(self->charset, self->map, &self->next);+}++FcBool my_FcCharSetIterDone(FcChar32 chr) {+    return chr == FC_CHARSET_DONE;+}

@@ -1,17 +1,6 @@ #include <fontconfig/fontconfig.h> #include <stddef.h> -int my_FcCHARSET_MAP_SIZE() {-    return FC_CHARSET_MAP_SIZE;-}--FcChar32 my_FcCharSetFirstPage(const FcCharSet *a, FcChar32 *map, FcChar32 *next) {-    return FcCharSetFirstPage(a, map, next);-}-FcChar32 my_FcCharSetNextPage(const FcCharSet *a, FcChar32 *map, FcChar32 *next) {-    return FcCharSetNextPage(a, map, next);-}- FcBool my_FcPatternAdd(FcPattern *p, const char *object,         FcBool binding, FcBool append, FcValue *value) {     if (binding) {

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.2.0.1+version:             0.3.0.0  -- A short (one-line) description of the package. synopsis:            Pure-functional language bindings to FontConfig@@ -62,7 +62,7 @@                 Graphics.Text.Font.Choose.Config, Graphics.Text.Font.Choose.Init,                 Graphics.Text.Font.Choose.Weight -  c-sources:    cbits/pattern.c+  c-sources:    cbits/pattern.c, cbits/charsetiter.c    -- LANGUAGE extensions used by modules in this package.   -- other-extensions: