From df959ade6e6c1c5e75746307bee080ff19e9eaaf Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Mon, 19 Dec 2022 14:48:56 +1300 Subject: [PATCH] Document FcPattern language bindings. --- Graphics/Text/Font/Choose.hs | 6 ++++-- Graphics/Text/Font/Choose/Pattern.hs | 31 ++++++++++++++++++++++++++++ 2 files changed, 35 insertions(+), 2 deletions(-) diff --git a/Graphics/Text/Font/Choose.hs b/Graphics/Text/Font/Choose.hs index 049d01b..9a1b105 100644 --- a/Graphics/Text/Font/Choose.hs +++ b/Graphics/Text/Font/Choose.hs @@ -21,7 +21,8 @@ module Graphics.Text.Font.Choose(CharSet, FontSet, ObjectSet, Pattern(..), Bindi LangSet, defaultLangs, langs, langSetCompare, langNormalize, langCharSet, - equalSubset, normalizePattern, filter, defaultSubstitute, nameParse, nameUnparse, format + equalSubset, normalizePattern, filter, defaultSubstitute, nameParse, nameUnparse, format, + setValue, setValues, unset, getValues, getValues', getValue, getValue', getValue0 ) where import Prelude hiding (init, filter) @@ -49,7 +50,8 @@ 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, defaultSubstitute, nameParse, nameUnparse, format) + normalizePattern, filter, defaultSubstitute, nameParse, nameUnparse, format, + setValue, setValues, unset, getValues, getValues', getValue, getValue', getValue0) import Graphics.Text.Font.Choose.Range (Range(..), iRange) import Graphics.Text.Font.Choose.Strings (StrSet, StrList) import Graphics.Text.Font.Choose.Value (Value(..)) diff --git a/Graphics/Text/Font/Choose/Pattern.hs b/Graphics/Text/Font/Choose/Pattern.hs index 337874b..2227859 100644 --- a/Graphics/Text/Font/Choose/Pattern.hs +++ b/Graphics/Text/Font/Choose/Pattern.hs @@ -34,7 +34,14 @@ import Stylist (PropertyParser(..)) import Data.Scientific (toRealFloat) import Data.List (intercalate) +-- | An `Pattern`` holds a set of names with associated value lists; +-- each name refers to a property of a font. +-- `Pattern`s are used as inputs to the matching code as well as +-- holding information about specific fonts. +-- Each property can hold one or more values; +-- conventionally all of the same type, although the interface doesn't demand that. type Pattern = [(String, [(Binding, Value)])] +-- | How important is it to match this property of the Pattern. data Binding = Strong | Weak | Same deriving (Eq, Ord, Enum, Show, Generic) instance Hashable Binding where @@ -42,34 +49,49 @@ instance Hashable Binding where hash Weak = 1 hash Same = 2 +-- | Replaces the values under the given "key" in given "pattern" +-- with given "binding" & "value". setValue :: ToValue x => String -> Binding -> x -> Pattern -> Pattern setValue key b value pat = (key, [(b, toValue value)]):unset key pat +-- | Replaces the values under the given "key" in given "pattern" +-- with given "binding" & "value"s. setValues :: ToValue x => String -> Binding -> [x] -> Pattern -> Pattern setValues key b values pat = (key, [(b, toValue v) | v <- values]):unset key pat +-- | Retrieves all values in the given pattern under a given key. getValues :: String -> Pattern -> [Value] getValues key pat | Just ret <- lookup key pat = map snd ret | otherwise = [] +-- | Retrieves all values under a given key & coerces to desired `Maybe` type. getValues' key pat = mapMaybe fromValue $ getValues key pat +-- | Retrieves first value in the given pattern under a given key. getValue :: String -> Pattern -> Value getValue key pat | Just ((_, ret):_) <- lookup key pat = ret | otherwise = ValueVoid +-- Retrieves first value under a given key & coerces to desired `Maybe` type. getValue' :: ToValue x => String -> Pattern -> Maybe x getValue' key pat = fromValue $ getValue key pat +-- Retrieves first value under a given key & coerces to desired type throw +-- or throw `ErrTypeMismatch` getValue0 :: ToValue x => String -> Pattern -> x getValue0 key pat = fromValue' $ getValue key pat +-- | Deletes all entries in the given pattern under a given key. unset key mapping = [(key', val') | (key', val') <- mapping, key' /= key] +-- | Restructures a `Pattern` so each key repeats at most once. normalizePattern :: Pattern -> Pattern normalizePattern pat = [(key, [val | (key', vals) <- pat, key' == key, val <- vals]) | key <- nub $ map fst pat] +-- | Returns whether pa and pb have exactly the same values for all of the objects in os. equalSubset :: Pattern -> Pattern -> ObjectSet -> Bool equalSubset a b objs = unsafePerformIO $ withPattern a $ \a' -> withPattern b $ \b' -> withObjectSet objs $ fcPatternEqualSubset a' b' foreign import ccall "FcPatternEqualSubset" fcPatternEqualSubset :: Pattern_ -> Pattern_ -> ObjectSet_ -> IO Bool +-- | Returns a new pattern that only has those objects from p that are in os. +-- If os is NULL, a duplicate of p is returned. filter :: Pattern -> ObjectSet -> Pattern filter pat objs = unsafePerformIO $ withPattern pat $ \pat' -> withObjectSet objs $ \objs' -> @@ -77,6 +99,11 @@ filter pat objs = foreign import ccall "FcPatternFilter" fcPatternFilter :: Pattern_ -> ObjectSet_ -> IO Pattern_ +-- | Supplies default values for underspecified font patterns: +-- * Patterns without a specified style or weight are set to Medium +-- * Patterns without a specified style or slant are set to Roman +-- * Patterns without a specified pixel size are given one computed from any +-- specified point size (default 12), dpi (default 75) and scale (default 1). defaultSubstitute :: Pattern -> Pattern defaultSubstitute pat = unsafePerformIO $ withPattern pat $ \pat' -> do ret <- fcDefaultSubstitute pat' @@ -84,16 +111,20 @@ defaultSubstitute pat = unsafePerformIO $ withPattern pat $ \pat' -> do foreign import ccall "FcDefaultSubstitute" fcDefaultSubstitute :: Pattern_ -> IO () -- Is this correct memory management? +-- | Converts name from the standard text format described above into a pattern. nameParse :: String -> Pattern nameParse name = unsafePerformIO $ withCString name $ \name' -> thawPattern_ $ fcNameParse name' foreign import ccall "FcNameParse" fcNameParse :: CString -> IO Pattern_ +-- | Converts the given pattern into the standard text format described above. nameUnparse :: Pattern -> String nameUnparse pat = unsafePerformIO $ withPattern pat $ \pat' -> bracket (throwNull <$> fcNameUnparse pat') free peekCString foreign import ccall "FcNameUnparse" fcNameUnparse :: Pattern_ -> IO CString +-- | Converts given pattern into text described fy given format specifier. +-- See for details: https://www.freedesktop.org/software/fontconfig/fontconfig-devel/fcpatternformat.html format :: Pattern -> String -> String format pat fmt = unsafePerformIO $ withPattern pat $ \pat' -> withCString fmt $ \fmt' -> do -- 2.30.2