M lib/FreeType/FontConfig.hs => lib/FreeType/FontConfig.hs +24 -3
@@ 1,4 1,5 @@
{-# LANGUAGE CApiFFI, OverloadedStrings #-}
+-- | Convert between FontConfig & FreeType types.
module FreeType.FontConfig(charIndex,
fontCharSet, fontCharSetAndSpacing, fontQuery, fontQueryAll, fontQueryFace,
FTFC_Instance(..), FTFC_Metrics(..), FTFC_Subpixel(..), FTFC_Glyph(..),
@@ 33,33 34,53 @@ import FreeType.Control.Subpixel (FT_LcdFilter, ft_Library_SetLcdFilter)
import FreeType.Core.Types
import FreeType.Exception (FtError(..))
+-- | Maps a Unicode char to a glyph index. This function uses information from
+-- several possible underlying encoding tables to work around broken fonts.
+-- As a result, this function isn't designed to be used in performance sensitive areas;
+-- results from this function are intended to be cached by higher level functions.
foreign import capi "fontconfig-wrap.h fcFreeTypeCharIndex" charIndex :: FT_Face -> Char -> Word
+-- | Scans a FreeType face and returns the set of encoded Unicode chars.
fontCharSet :: FT_Face -> CharSet'
fontCharSet arg = fromMessage0 $ fcFreeTypeCharSet arg
foreign import capi "fontconfig-wrap.h" fcFreeTypeCharSet :: FT_Face -> Ptr Int -> CString
-fontCharSetAndSpacing :: FT_Face -> (Int, CharSet')
-fontCharSetAndSpacing arg = fromMessage0 $ fcFreeTypeCharSetAndSpacing arg
+data Spacing = Mono -- ^ A font where all glyphs have the same width
+ | Dual -- ^ The font has glyphs in precisely two widths
+ | Proportional -- ^ The font has glyphs of many widths
+ | SpacingError -- ^ Unexpected & invalid spacing value.
+ deriving (Read, Show, Eq, Enum, Bounded)
+
+-- | Scans a FreeType face and returns the set of encoded Unicode chars & the computed spacing type.
+fontCharSetAndSpacing :: FT_Face -> (Spacing, CharSet')
+fontCharSetAndSpacing arg = (toEnum spacing, chars)
+ where (spacing, chars) = fromMessage0 $ fcFreeTypeCharSetAndSpacing arg
foreign import capi "fontconfig-wrap.h" fcFreeTypeCharSetAndSpacing ::
FT_Face -> Ptr Int -> CString
+-- | Constructs a pattern representing the 'id'th face in 'file'.
+-- The number of faces in 'file' is returned in 'count'.
fontQuery :: FilePath -> Int -> (Int, Pattern)
fontQuery a b = fromMessage0 $ flip withCString' a $ \a' -> fcFreeTypeQuery a' b
foreign import capi "fontconfig-wrap.h" fcFreeTypeQuery ::
CString -> Int -> Ptr Int -> CString
+-- | Constructs patterns found in 'file', all patterns found in 'file' are added to 'set'.
+-- The number of faces in 'file' is returned in 'count'.
+-- The number of patterns added to 'set' is returned.
fontQueryAll :: FilePath -> (Int, Int, FontSet)
fontQueryAll a = fromMessage0 $ withCString' fcFreeTypeQueryAll a
foreign import capi "fontconfig-wrap.h" fcFreeTypeQueryAll ::
CString -> Ptr Int -> CString
+-- | Constructs a pattern representing 'face'. 'file' and 'id' are used solely
+-- as data for pattern elements (FC_FILE, FC_INDEX and sometimes FC_FAMILY).
fontQueryFace :: FT_Face -> FilePath -> Int -> Pattern
-fontQueryFace a b c = fromMessage0 $ flip withCString' b $ \b' -> fcFreeTypeQueryFace a b' c
+fontQueryFace a b c = fromMessage0 $ flip withCString' b $ \b' -> fcFreeTypeQueryFace a b' $ fromEnum c
foreign import capi "fontconfig-wrap.h" fcFreeTypeQueryFace ::
FT_Face -> CString -> Int -> Ptr Int -> CString
M lib/Graphics/Text/Font/Choose/CharSet.hs => lib/Graphics/Text/Font/Choose/CharSet.hs +1 -0
@@ 62,6 62,7 @@ instance MessagePack CharSet' where
instance Arbitrary CharSet' where
arbitrary = CharSet' <$> IntSet.fromList <$> Prelude.map (succ . abs) <$> arbitrary
+-- | Can this charset be processed by FontConfig?
validCharSet' :: CharSet' -> Bool
validCharSet' (CharSet' self) =
not (IntSet.null self) && all (> 0) (IntSet.toList self)
M lib/Graphics/Text/Font/Choose/Config.hs => lib/Graphics/Text/Font/Choose/Config.hs +19 -3
@@ 1,38 1,54 @@
{-# LANGUAGE CApiFFI #-}
-- | Load system fonts configuration.
-module Graphics.Text.Font.Choose.Config(Config', fini, version,
+module Graphics.Text.Font.Choose.Config(Config, fini, version,
initLoadConfig, initLoadConfigAndFonts, initFonts, reinit, bringUptoDate,
-- For the sake of Graphics.Font.Choose.Config.Accessors
- Config, fcConfigDestroy) where
+ Config', fcConfigDestroy) where
import Foreign.Ptr (Ptr, FunPtr)
import Foreign.ForeignPtr (ForeignPtr, newForeignPtr)
import Graphics.Text.Font.Choose.Result (throwBool, throwNull)
+-- | Internal placeholder underlying `Config`.
data Config'
+-- | holds the internal representation of a configuration.
type Config = ForeignPtr Config'
-
+-- | Loads the default configuration file and returns the resulting configuration. Does not load any font information.
initLoadConfig :: IO Config
initLoadConfig = newForeignPtr fcConfigDestroy =<< throwNull =<< fcInitLoadConfig -- FIXME: What's proper memory-management here?
+-- | Loads the default configuration file and builds information about the available fonts. Returns the resulting configuration.
initLoadConfigAndFonts :: IO Config
initLoadConfigAndFonts = newForeignPtr fcConfigDestroy =<< throwNull =<< fcInitLoadConfigAndFonts -- FIXME: What's proper memory-management here?
+-- | Loads the default configuration file and the fonts referenced therein and sets the default configuration to that result.
+-- Returns whether this process succeeded or not. If the default configuration has already been loaded, this routine does nothing and returns True.
initFonts :: IO ()
initFonts = throwBool =<< fcInit
foreign import capi "fontconfig/fontconfig.h FcFini" fini :: IO ()
+
+-- | Returns the version number of the library.
foreign import capi "fontconfig/fontconfig.h FcGetVersion" version :: Int
+
+-- | Forces the default configuration file to be reloaded and resets the default configuration.
+-- Returns False if the configuration cannot be reloaded (due to configuration file errors,
+-- allocation failures or other issues) and leaves the existing configuration unchanged. Otherwise returns True.
reinit :: IO ()
reinit = throwBool =<< fcInitReinitialize
+
+-- | Checks the rescan interval in the default configuration, checking the configuration
+-- if the interval has passed and reloading the configuration if when any changes are detected.
+-- Returns False if the configuration cannot be reloaded (see `reinit`). Otherwise returns True.
bringUptoDate :: IO ()
bringUptoDate = throwBool =<< fcInitBringUptoDate
foreign import capi "fontconfig/fontconfig.h FcInitLoadConfig" fcInitLoadConfig :: IO (Ptr Config')
foreign import capi "fontconfig/fontconfig.h FcInitLoadConfigAndFonts" fcInitLoadConfigAndFonts :: IO (Ptr Config')
foreign import capi "fontconfig/fontconfig.h FcInit" fcInit :: IO Bool
+-- | Internal ForeignPtr destructor for `Config`.
foreign import capi "fontconfig/fontconfig.h &FcConfigDestroy" fcConfigDestroy :: FunPtr (Ptr Config' -> IO ())
foreign import capi "fontconfig/fontconfig.h FcInitReinitialize" fcInitReinitialize :: IO Bool
M lib/Graphics/Text/Font/Choose/Config/Accessors.hs => lib/Graphics/Text/Font/Choose/Config/Accessors.hs +98 -6
@@ 4,7 4,7 @@
module Graphics.Text.Font.Choose.Config.Accessors(
configCreate, setCurrent, current, uptodate, home, enableHome, buildFonts,
configDirs, fontDirs, configFiles, cacheDirs, fonts, rescanInterval,
- setRescanInterval, appFontAddFile, appFontAddDir, appFontClear, substituteWithPat,
+ setRescanInterval, appFontAddFile, appFontAddDir, appFontClear, substitute,
fontMatch, fontSort, fontRenderPrepare, fontList, filename, parseAndLoad,
parseAndLoadFromMemory, sysroot, setSysroot, SetName(..), MatchKind(..)
) where
@@ 25,128 25,211 @@ import Graphics.Text.Font.Choose.Result (throwBool, throwNull)
import Graphics.Text.Font.Choose.Internal.FFI (peekCString', fromMessageIO0,
withMessage, withForeignPtr', fromMessage0, fromMessage)
+-- | Creates an empty configuration.
configCreate :: IO Config
configCreate = newForeignPtr fcConfigDestroy =<< throwNull =<< fcConfigCreate
foreign import capi "fontconfig/fontconfig.h FcConfigCreate" fcConfigCreate :: IO (Ptr Config')
+-- | Sets the current default configuration to config. Implicitly calls FcConfigBuildFonts
+-- if necessary, and FcConfigReference() to inrease the reference count in config since 2.12.0.
setCurrent :: Config -> IO ()
setCurrent conf = throwBool =<< withForeignPtr conf fcConfigSetCurrent
foreign import capi "fontconfig/fontconfig.h FcConfigSetCurrent" fcConfigSetCurrent :: Ptr Config' -> IO Bool
+-- | Returns the current default configuration.
current :: IO Config
current = newForeignPtr fcConfigDestroy =<< throwNull =<< fcConfigReference nullPtr
foreign import capi "fontconfig/fontconfig.h FcConfigReference" fcConfigReference :: Ptr Config' -> IO (Ptr Config')
+-- | Checks all of the files related to config and returns whether any of them has
+-- been modified since the configuration was created.
uptodate :: Config -> IO Bool
uptodate conf = withForeignPtr conf fcConfigUptoDate
foreign import capi "fontconfig/fontconfig.h FcConfigUptoDate" fcConfigUptoDate :: Ptr Config' -> IO Bool
+-- | Return the current user's home directory, if it is available & if using it is enabled.
home :: String
home = peekCString' fcConfigHome
foreign import capi "fontconfig/fontconfig.h FcConfigHome" fcConfigHome :: CString
+-- | If given True, then Fontconfig will use various files which are specified
+-- relative to the user's home directory (using the ~ notation in the configuration).
+-- When its False, then all use of the home directory in these contexts will be disabled.
+-- The previous setting of the value is returned.
foreign import capi "fontconfig/fontconfig.h FcConfigEnableHome" enableHome :: Bool -> IO Bool
+-- | Builds the set of available fonts for the given configuration.
+-- Note that any changes to the configuration after this call
+-- (through parseAndLoad or parseAndLoadFromMemory) have indeterminate effects.
+-- (On the other hand, application fonts can still be modified through
+-- appFontAddFile, appFontAddDir and appFontClear).
buildFonts :: Config -> IO ()
buildFonts conf = throwBool =<< withForeignPtr conf fcConfigBuildFonts
foreign import capi "fontconfig/fontconfig.h FcConfigBuildFonts" fcConfigBuildFonts :: Ptr Config' -> IO Bool
+-- | Returns the list of font directories specified in the configuration files.
+-- Does not include any subdirectories.
configDirs :: Config -> IO [String]
configDirs conf =
fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetConfigDirs conf' len
foreign import capi "fontconfig-wrap.h" fcConfigGetConfigDirs :: Ptr Config' -> Ptr Int -> IO CString
+-- | Returns the list of font directories. This includes the configured font directories
+-- along with any directories below those in the filesystem.
fontDirs :: Config -> IO [String]
fontDirs conf =
fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetFontDirs conf' len
foreign import capi "fontconfig-wrap.h" fcConfigGetFontDirs :: Ptr Config' -> Ptr Int -> IO CString
+-- | Returns the list of known configuration files used to generate given config.
configFiles :: Config -> IO [String]
configFiles conf =
fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetConfigFiles conf' len
foreign import capi "fontconfig-wrap.h" fcConfigGetConfigFiles :: Ptr Config' -> Ptr Int -> IO CString
+-- | returns a string list containing all of the directories that fontconfig will
+-- search when attempting to load a cache file for a font directory.
cacheDirs :: Config -> IO [String]
cacheDirs conf =
fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetCacheDirs conf' len
foreign import capi "fontconfig-wrap.h" fcConfigGetCacheDirs :: Ptr Config' -> Ptr Int -> IO CString
-data SetName = System | App deriving Eq
+-- | Which set of fonts to retrieve.
+data SetName = System -- ^ Fonts installed into the OS.
+ | App -- ^ Fonts provided by this process.
+ deriving (Read, Show, Eq, Enum)
+-- | Returns one of the two sets of fonts from the configuration as specified by set.
fonts :: Config -> SetName -> IO FontSet
fonts conf setname =
fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetFonts conf' (setname == System) len
foreign import capi "fontconfig-wrap.h" fcConfigGetFonts :: Ptr Config' -> Bool -> Ptr Int -> IO CString
+-- | Returns the interval between automatic checks of the configuration (in seconds) specified
+-- in config. The configuration is checked during a call to FcFontList when this interval has
+-- passed since the last check. An interval setting of zero disables automatic checks.
rescanInterval :: Config -> IO Int
rescanInterval = flip withForeignPtr fcConfigGetRescanInterval
foreign import capi "fontconfig/fontconfig.h FcConfigGetRescanInterval" fcConfigGetRescanInterval ::
Ptr Config' -> IO Int
+-- | Sets the rescan interval. An interval setting of zero disables automatic checks.
setRescanInterval :: Config -> Int -> IO ()
setRescanInterval conf period =
throwBool =<< withForeignPtr conf (flip fcConfigSetRescanInterval period)
foreign import capi "fontconfig/fontconfig.h FcConfigSetRescanInterval" fcConfigSetRescanInterval ::
Ptr Config' -> Int -> IO Bool
+-- | Adds an application-specific font to the configuration.
appFontAddFile :: Config -> FilePath -> IO ()
appFontAddFile conf file = throwBool =<< withForeignPtr conf (\conf' ->
withCString file $ \file' -> fcConfigAppFontAddFile conf' file')
foreign import capi "fontconfig/fontconfig.h FcConfigAppFontAddFile" fcConfigAppFontAddFile ::
Ptr Config' -> CString -> IO Bool
+-- | Scans the specified directory for fonts, adding each one found to the application-specific set of fonts.
appFontAddDir :: Config -> FilePath -> IO ()
appFontAddDir conf file = throwBool =<< withForeignPtr conf (\conf' ->
withCString file $ \file' -> fcConfigAppFontAddDir conf' file')
foreign import capi "fontconfig/fontconfig.h FcConfigAppFontAddDir" fcConfigAppFontAddDir ::
Ptr Config' -> CString -> IO Bool
+-- | Clears the set of application-specific fonts.
appFontClear :: Config -> IO ()
appFontClear = flip withForeignPtr fcConfigAppFontClear
foreign import capi "fontconfig/fontconfig.h FcConfigAppFontClear" fcConfigAppFontClear ::
Ptr Config' -> IO ()
-data MatchKind = MatchPattern | MatchFont deriving Eq
-substituteWithPat :: Config -> Pattern -> Maybe Pattern -> MatchKind -> Pattern
-substituteWithPat conf p (Just p_pat) kind =
+
+-- | Which pattern modifications to apply during `substituteWithPat`.
+data MatchKind = MatchPattern -- ^ Applies pattern operations.
+ | MatchFont -- ^ Applies font operations.
+ deriving (Read, Show, Eq, Enum)
+-- | Performs the sequence of pattern modification operations tagged by `kind`.
+-- If kind is MatchPattern then those tagged as pattern operations are applied,
+-- else if kind is MatchFont those tagged as font operations are applied
+-- & p_pat is used for <test> elements with target=pattern.
+substitute :: Config -> Pattern -> Maybe Pattern -> MatchKind -> Pattern
+substitute conf p (Just p_pat) kind =
fromMessage0 $ flip withForeignPtr' conf $ \conf' -> flip withMessage [p, p_pat] $ \msg len ->
fcConfigSubstituteWithPat conf' msg len (kind == MatchFont)
-substituteWithPat conf p Nothing kind =
+substitute conf p Nothing kind =
fromMessage0 $ flip withForeignPtr' conf $ \conf' -> flip withMessage [p] $ \msg len ->
fcConfigSubstituteWithPat conf' msg len (kind == MatchFont)
foreign import capi "fontconfig-wrap.h" fcConfigSubstituteWithPat ::
Ptr Config' -> CString -> Int -> Bool -> Ptr Int -> CString
+-- | Finds the font in sets most closely matching pattern and returns the result
+-- of fontRenderPrepare for that font and the provided pattern.
fontMatch :: Config -> Pattern -> Maybe Pattern
fontMatch conf pat = fromMessage $ flip withMessage pat $ withForeignPtr' fcFontMatch conf
foreign import capi "fontconfig-wrap.h" fcFontMatch :: Ptr Config' -> CString -> Int -> Ptr Int -> CString
+-- | Returns the list of fonts sorted by closeness to p.
+-- If trim is FcTrue, elements in the list which don't include Unicode coverage
+-- not provided by earlier elements in the list are elided.
+-- The union of Unicode coverage of all of the fonts is returned.
+--
+-- The returned FcFontSet references FcPattern structures which may be shared by the
+-- return value from multiple FcFontSort calls, applications must not modify these patterns.
fontSort :: Config -> Pattern -> Bool -> Maybe (FontSet, CharSet')
fontSort conf pat trim = fromMessage $ (flip withMessage pat $ withForeignPtr' fcFontSort conf) trim
foreign import capi "fontconfig-wrap.h" fcFontSort ::
Ptr Config' -> CString -> Int -> Bool -> Ptr Int -> CString
+-- | Creates a new pattern consisting of elements of font not appearing in pat, elements of pat
+-- not appearing in font and the best matching value from pat for elements appearing in both.
+-- The result is passed to FcConfigSubstituteWithPat with kind FcMatchFont and then returned.
fontRenderPrepare :: Config -> Pattern -> Pattern -> Pattern
fontRenderPrepare conf pat font = fromMessage0 $ flip withMessage [pat, font] $
withForeignPtr' fcFontRenderPrepare conf
foreign import capi "fontconfig-wrap.h" fcFontRenderPrepare ::
Ptr Config' -> CString -> Int -> Ptr Int -> CString
+-- | Selects fonts matching p, creates patterns from those fonts containing only
+-- the given objects and returns the set of unique such patterns.
fontList :: Config -> Pattern -> ObjectSet -> FontSet
fontList conf pat os = fromMessage0 $ flip withMessage (pat, os) $ withForeignPtr' fcFontList conf
foreign import capi "fontconfig-wrap.h" fcFontList :: Ptr Config' -> CString -> Int -> Ptr Int -> CString
+-- | Given the specified external entity name, return the associated filename. This provides
+-- applications a way to convert various configuration file references into filename form.
+--
+-- An empty name indicates that the default configuration file should be used;
+-- which file this references can be overridden with the FONTCONFIG_FILE environment variable.
+-- Next, if the name starts with ~, it refers to a file in the current users home directory.
+-- Otherwise if the name doesn't start with '/', it refers to a file in the default config dir;
+-- the built-in default directory can be overridden with the FONTCONFIG_PATH environment variable.
+--
+-- The result of this function is affected by the FONTCONFIG_SYSROOT environment variable
+-- or equivalent functionality.
filename :: Config -> FilePath -> IO FilePath
filename conf path =
peekCString =<< withForeignPtr conf (\_ -> withCString path $ fcConfigGetFilename)
foreign import capi "fontconfig/fontconfig.h FcConfigFilename" fcConfigGetFilename ::
CString -> IO CString -- FIXME: Recent docs say it's "Get" now...
+-- | Walks the configuration in 'path' and constructs the internal representation in 'conf'.
+-- Any include files referenced from within 'path' will be loaded and parsed.
+-- If 'complain' is False, no warning will be displayed if 'path' does not exist.
+-- Error and warning messages will be output to stderr.
+-- Throws an exception if some error occurred while loading the file, either a parse error,
+-- semantic error or allocation failure. After all configuration files or strings have been loaded,
+-- with FcConfigParseAndLoad inclusive-or FcConfigParseAndLoadFromMemory,
+-- call FcConfigBuildFonts to build the font database.
parseAndLoad :: Config -> FilePath -> Bool -> IO ()
parseAndLoad conf path complain =
throwBool =<< withForeignPtr conf (\conf' -> withCString path $ \path' ->
fcConfigParseAndLoad conf' path' complain)
foreign import capi "fontconfig/fontconfig.h FcConfigParseAndLoad" fcConfigParseAndLoad ::
Ptr Config' -> CString -> Bool -> IO Bool
+-- | Walks the configuration in 'buf' and constructs the internal representation in 'conf'.
+-- Any includes files referenced from within 'buf' will be loaded and dparsed.
+-- If 'complain' is False, no warning will be displayed if 'file' does not exist.
+-- Error and warning messages will be output to stderr.
+-- Throws an exception if fsome error occurred while loading the file, either a parse error,
+-- semantic error or allocation failure. After all configuration files or strings have been loaded,
+-- with FcConfigParseAndLoad inclusive-or FcConfigParseAndLoadFromMemory,
+-- call FcConfigBuildFonts to build the font database.
parseAndLoadFromMemory :: Config -> FilePath -> Bool -> IO ()
parseAndLoadFromMemory conf buf complain =
throwBool =<< withForeignPtr conf (\conf' -> withCString buf $ \buf' ->
@@ 154,12 237,21 @@ parseAndLoadFromMemory conf buf complain =
foreign import capi "fontconfig/fontconfig.h FcConfigParseAndLoadFromMemory"
fcConfigParseAndLoadFromMemory :: Ptr Config' -> CString -> Bool -> IO Bool
+-- | Obtains the system root directory in 'conf' if available.
+-- All files (including file properties in patterns) obtained from this 'conf'
+-- are relative to this system root directory.
sysroot :: Config -> IO String
sysroot conf = peekCString =<< withForeignPtr conf fcConfigGetSysRoot
-- FIXME: Upgrade GHC so I can use const pointers!
foreign import ccall "fontconfig/fontconfig.h FcConfigGetSysRoot" fcConfigGetSysRoot ::
Ptr Config' -> IO CString
+-- | Set 'root' as the system root directory. All file paths used or created with this 'conf'
+-- (including file properties in patterns) will be considered or made relative to this 'root'.
+-- This allows a host to generate caches for targets at build time.
+-- This also allows a cache to be re-targeted to a different base directory if 'FcConfigGetSysRoot'
+-- is used to resolve file paths. When setting this on the current config this causes
+-- changing current config (calls FcConfigSetCurrent()).
setSysroot :: Config -> String -> IO ()
setSysroot conf root =
withForeignPtr conf $ \conf' -> withCString root $ fcConfigSetSysRoot conf'
M lib/Graphics/Text/Font/Choose/FontSet.hs => lib/Graphics/Text/Font/Choose/FontSet.hs +13 -0
@@ 24,11 24,15 @@ import Data.List (intercalate)
import Graphics.Text.Font.Choose.Range (iRange)
import Graphics.Text.Font.Choose.Value (ToValue(..), Value)
+-- | holds a list of patterns; these are used to return the results of listing available fonts.
type FontSet = [Pattern]
+-- | Can the FontSet be processed by FontConfig?
validFontSet :: FontSet -> Bool
validFontSet = all validPattern
+-- | holds a list of patterns; these are used to return the results of listing available fonts.
+-- If the fontset is invalid,
fontSetList :: Config -> [FontSet] -> Pattern -> ObjectSet -> FontSet
fontSetList a b c d | all validFontSet b =
fromMessage0 $ arg d $ arg c $ arg b $ withForeignPtr' fcFontSetList a
@@ 38,6 42,8 @@ foreign import capi "fontconfig-wrap.h" fcFontSetList ::
Ptr Config' -> CString -> Int -> CString -> Int -> CString -> Int ->
Ptr Int -> CString
+-- | Finds the font in sets most closely matching pattern and returns the result
+-- of `fontRenderPrepare` for that font and the provided pattern.
fontSetMatch :: Config -> [FontSet] -> Pattern -> Maybe FontSet
fontSetMatch a b c | all validFontSet b && validPattern c =
fromMessage $ arg c $ arg b $ withForeignPtr' fcFontSetMatch a
@@ 46,6 52,12 @@ fontSetMatch a b c | all validFontSet b && validPattern c =
foreign import capi "fontconfig-wrap.h" fcFontSetMatch ::
Ptr Config' -> CString -> Int -> CString -> Int -> Ptr Int -> CString
+-- | Returns the list of fonts from sets sorted by closeness to pattern.
+-- If True is passed, elements in the list which don't include Unicode coverage
+-- not provided by earlier elements in the list are elided.
+-- The union of Unicode coverage of all of the fonts is returned alongside the fontset.
+
+-- Returns an empty CharSet & Nothing upon error, or invalid inputs.
fontSetSort :: Config -> [FontSet] -> Pattern -> Bool -> (Maybe FontSet, CharSet')
fontSetSort a b c d | all validFontSet b && validPattern c =
fromMessage0 $ flip withForeignPtr' a $ \a' ->
@@ 58,6 70,7 @@ foreign import capi "fontconfig-wrap.h" fcFontSetSort ::
------
--- Utilities
------
+-- | Variation of `withMessage` that's proving to be more concise.
arg :: MessagePack a => a -> (CString -> Int -> b) -> b
arg = flip withMessage
M lib/Graphics/Text/Font/Choose/Internal/FFI.hs => lib/Graphics/Text/Font/Choose/Internal/FFI.hs +18 -3
@@ 7,7 7,7 @@ module Graphics.Text.Font.Choose.Internal.FFI(
import Data.MessagePack (MessagePack(fromObject), pack, unpack, Object(ObjectStr))
import Foreign.C.String (CString, withCString, peekCString)
-import Foreign.Ptr (Ptr)
+import Foreign.Ptr (Ptr, nullPtr)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Storable (Storable(..))
import Foreign.Marshal.Alloc (alloca, free)
@@ 22,6 22,7 @@ import Data.ByteString.Lazy (toStrict, fromStrict, ByteString)
import qualified Data.Text as Txt
import System.IO.Unsafe (unsafePerformIO)
+-- | Decode a MessagePack packet whilst throwing textually-specified exceptions.
unpackWithErr :: MessagePack a => ByteString -> Maybe a
unpackWithErr bs = case unpack bs of
Just (ObjectStr err) |
@@ 29,19 30,25 @@ unpackWithErr bs = case unpack bs of
Just x -> fromObject x
Nothing -> Nothing
+-- | Encode data via MessagePack to pass to an impure C function.
withMessageIO :: MessagePack a => (CString -> Int -> IO b) -> a -> IO b
withMessageIO cb a = unsafeUseAsCStringLen (toStrict $ pack a) (uncurry cb)
+-- | Encode data via MessagePack to pass to a pure C function.
withMessage :: MessagePack a => (CString -> Int -> b) -> a -> b
withMessage inner arg = unsafePerformIO $ withMessageIO (\x -> return . inner x) arg
+-- | Decode data via MessagePack returned from a pure C function.
fromMessage :: MessagePack a => (Ptr Int -> CString) -> Maybe a
fromMessage inner = unpackWithErr $ fromStrict $ unsafePerformIO $ do
unsafePackMallocCStringLen . swap =<< withPtr (throwNull . inner)
+-- | Decode data via MessagePack returned from a pure C function,
+-- throwing exceptions upon failed decodes.
fromMessage0 :: MessagePack a => (Ptr Int -> CString) -> a
fromMessage0 = fromJust . fromMessage
+-- | Decode data via MessagePack returned from an impure C function.
fromMessageIO :: MessagePack a => (Ptr Int -> IO CString) -> IO (Maybe a)
fromMessageIO inner = do
(a, b) <- withPtr $ \ptr -> do
@@ 49,22 56,30 @@ fromMessageIO inner = do
bs <- unsafePackMallocCStringLen (b, a)
return $ unpackWithErr $ fromStrict bs
+-- | Decode data via MessagePack returned from an impure C function,
+-- throwing exceptions upon failed decodes.
fromMessageIO0 :: MessagePack a => (Ptr Int -> IO CString) -> IO a
fromMessageIO0 inner = fromJust <$> fromMessageIO inner
+-- | Pass a string to a pure C function.
withCString' :: (CString -> a) -> String -> a
withCString' inner = unsafePerformIO . flip withCString (return . inner)
+-- | Return a string from a pure C function
peekCString' :: CString -> String
-peekCString' ptr = unsafePerformIO $ do
+peekCString' ptr | ptr /= nullPtr = unsafePerformIO $ do
ret <- peekCString ptr
free ptr
return ret
+ | otherwise = ""
+-- | Unwrap a foreign pointer to pass to a pure C function.
withForeignPtr' :: (Ptr a -> b) -> ForeignPtr a -> b
withForeignPtr' inner arg = unsafePerformIO $ withForeignPtr arg $ return . inner
--- I don't want to pull in all of inline-c for this util!
+-- I don't want to pull in all of inline-c for JUST this util!
+-- | Pass a transient pointer to an impure C function,
+-- for its value to be returned alongside that functions' return value.
withPtr :: (Storable a) => (Ptr a -> IO b) -> IO (a, b)
withPtr f = do
alloca $ \ptr -> do
M lib/Graphics/Text/Font/Choose/LangSet.hs => lib/Graphics/Text/Font/Choose/LangSet.hs +27 -1
@@ 7,6 7,7 @@ module Graphics.Text.Font.Choose.LangSet(
import Data.Set (Set)
import qualified Data.Set as S
+import Data.Hashable (Hashable(..))
import Data.MessagePack (MessagePack(..))
import Test.QuickCheck (Arbitrary(..), elements, listOf)
import Graphics.Text.Font.Choose.StrSet (StrSet(..))
@@ 18,13 19,24 @@ import Graphics.Text.Font.Choose.Internal.FFI (withMessage, fromMessage0, withCS
import Graphics.Text.Font.Choose.Result
import Control.Exception (throw)
+-- | A set of language names (each of which include language and an optional territory).
+-- They are used when selecting fonts to indicate which languages the fonts need to support.
+-- Each font is marked, using language orthography information built into fontconfig,
+-- with the set of supported languages.
type LangSet = Set String
+-- | Wrapper around LangSet adding useful typeclasses
newtype LangSet' = LangSet' { unLangSet :: LangSet } deriving (Eq, Show, Read)
+instance Hashable LangSet' where
+ hashWithSalt salt (LangSet' self) = hashWithSalt salt self
+
+-- | Can the given LangSet be processed by FontConfig?
validLangSet :: LangSet -> Bool
validLangSet x = all validLang x && not (null x)
+-- | Can the given LangSet' be processed by FontConfig?
validLangSet' :: LangSet' -> Bool
validLangSet' = validLangSet . unLangSet
+-- | Can the given language code be processed by FontConfig?
validLang :: String -> Bool
validLang = (`elem` unStrSet langs)
@@ 34,13 46,18 @@ instance MessagePack LangSet' where
instance Arbitrary LangSet' where
arbitrary = LangSet' <$> S.fromList <$> listOf (elements $ S.toList $ unStrSet langs)
-data LangComparison = SameLang | SameTerritory | DifferentLang
+-- | The result of `cmp`.
+data LangComparison = SameLang -- ^ The locales share any language and territory pair
+ | SameTerritory -- ^ The locales share a language but differ in which territory that language is for
+ | DifferentLang -- ^ The locales share no languages in common
+ deriving (Read, Show, Eq, Enum, Bounded)
i2cmp :: Int -> LangComparison
i2cmp 0 = DifferentLang
i2cmp 1 = SameLang
i2cmp 2 = SameTerritory
i2cmp _ = throw ErrOOM
+-- | Compares language coverage for the 2 given LangSets.
cmp :: LangSet' -> LangSet' -> LangComparison
cmp a b | valid a && valid b = i2cmp $ withMessage fcLangSetCompare [a, b]
| otherwise = DifferentLang
@@ 48,6 65,9 @@ cmp a b | valid a && valid b = i2cmp $ withMessage fcLangSetCompare [a, b]
foreign import capi "fontconfig-wrap.h" fcLangSetCompare :: CString -> Int -> Int
+-- | returns True if `a` contains every language in `b`.
+-- `a`` will contain a language from `b` if `a` has exactly the language,
+-- or either the language or `a` has no territory.
has :: LangSet' -> String -> LangComparison
has a b | validLangSet' a && validLang b =
i2cmp $ flip withCString' b $ withMessage fcLangSetHasLang a
@@ 55,21 75,27 @@ has a b | validLangSet' a && validLang b =
foreign import capi "fontconfig-wrap.h" fcLangSetHasLang :: CString -> Int -> CString -> Int
+-- | Returns a string set of the default languages according to the environment variables on the system.
+-- This function looks for them in order of FC_LANG, LC_ALL, LC_CTYPE and LANG then.
+-- If there are no valid values in those environment variables, "en" will be set as fallback.
defaultLangs :: StrSet
defaultLangs = fromMessage0 fcGetDefaultLangs
foreign import capi "fontconfig-wrap.h" fcGetDefaultLangs :: Ptr Int -> CString
+-- | Returns a string set of all languages.
langs :: StrSet
langs = fromMessage0 fcGetLangs
foreign import capi "fontconfig-wrap.h" fcGetLangs :: Ptr Int -> CString
+-- | Returns a string to make lang suitable on fontconfig.
normalize :: String -> String
normalize = peekCString' . withCString' fcLangNormalize
foreign import capi "fontconfig-wrap.h" fcLangNormalize :: CString -> CString
+-- | Returns the CharSet for a language.
langCharSet :: String -> CharSet'
langCharSet a | validLang a = fromMessage0 $ withCString' fcLangGetCharSet a
| otherwise = CharSet' CS.empty
M lib/Graphics/Text/Font/Choose/ObjectSet.hs => lib/Graphics/Text/Font/Choose/ObjectSet.hs +2 -0
@@ 1,6 1,8 @@
-- | Which properties of a font do we want to read?
module Graphics.Text.Font.Choose.ObjectSet(ObjectSet) where
+-- | Holds a list of pattern property names; it is used to indicate which
+-- properties are to be returned in the patterns from FcFontList.
type ObjectSet = [String]
-- NOTE: Already has all the typeclass instances I want, including MessagePack!
M lib/Graphics/Text/Font/Choose/Pattern.hs => lib/Graphics/Text/Font/Choose/Pattern.hs +21 -0
@@ 34,8 34,11 @@ import Data.Maybe as Mb (listToMaybe, fromMaybe, mapMaybe)
import Data.Char (isAscii)
import Prelude as L
+-- | Holds both patterns to match against the available fonts, as well as the information about each font.
type Pattern = M.Map Text [(Binding, Value)]
+-- | Wrapper around `Pattern` supporting useful typeclasses.
data Pattern' = Pattern' { unPattern :: Pattern } deriving (Eq, Read, Show, Generic)
+-- | The precedance for a field of a Pattern.
data Binding = Strong | Weak | Same deriving (Eq, Ord, Enum, Read, Show, Generic)
instance Hashable Binding where
@@ 64,6 67,7 @@ instance Arbitrary Pattern' where
instance Arbitrary Binding where
arbitrary = elements [Strong, Weak] -- Same doesn't roundtrip!
+-- | Does the pattern hold a value we can process?
validPattern :: Pattern -> Bool
validPattern self = not (M.null self) &&
all (validValue . snd) (concat $ M.elems self) &&
@@ 73,19 77,25 @@ validPattern self = not (M.null self) &&
all (not . Txt.elem '\0') (M.keys self) &&
all (Txt.all isAscii) (M.keys self) &&
all (\k -> Txt.length k < 18) (M.keys self)
+-- | Variant of `validPattern` which applies to the `Pattern'` wrapper.
validPattern' :: Pattern' -> Bool
validPattern' = validPattern . unPattern
+-- | Replace a field with a singular type-casted value.
setValue :: ToValue v => Text -> Binding -> v -> Pattern -> Pattern
setValue key strength v self = setValues key strength [v] self
+-- | Replace a field with multiple type-casted values.
setValues :: ToValue v => Text -> Binding -> [v] -> Pattern -> Pattern
setValues key strength vs self = M.insert key [(strength, toValue v) | v <- vs] self
+-- | Retrieve a field's primary type-casted value.
getValue :: ToValue v => Text -> Pattern -> Maybe v
getValue key self = fromValue . snd =<< listToMaybe =<< M.lookup key self
+-- | Retrieve a field's type-casted values.
getValues :: ToValue v => Text -> Pattern -> [v]
getValues key self = Mb.mapMaybe (fromValue . snd) $ fromMaybe [] $ M.lookup key self
+-- | Returns whether the given patterns have exactly the same values for all of the given objects.
equalSubset :: Pattern -> Pattern -> ObjectSet -> Bool
equalSubset a b os | validPattern a && validPattern b =
case withMessage fcPatternEqualSubset [toObject a, toObject b, toObject os] of
@@ 96,23 106,31 @@ equalSubset a b os | validPattern a && validPattern b =
foreign import capi "fontconfig-wrap.h" fcPatternEqualSubset :: CString -> Int -> Int
+-- | 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 a | validPattern a = fromMessage0 $ withMessage fcDefaultSubstitute a
| otherwise = a
foreign import capi "fontconfig-wrap.h" fcDefaultSubstitute :: CString -> Int -> Ptr Int -> CString
+-- | Converts name from the standard text format described above into a pattern.
nameParse :: String -> Pattern
nameParse = fromMessage0 . withCString' fcNameParse
foreign import capi "fontconfig-wrap.h" fcNameParse :: CString -> Ptr Int -> CString
+-- | Converts the given pattern into the standard text format described above.
nameUnparse :: Pattern -> String
nameUnparse a | validPattern a = peekCString' $ withMessage fcNameUnparse a
| otherwise = ""
foreign import capi "fontconfig-wrap.h" fcNameUnparse :: CString -> Int -> CString
+-- | Format a pattern into a string according to a format specifier
+-- See https://fontconfig.pages.freedesktop.org/fontconfig/fontconfig-devel/fcpatternformat.html for full details.
nameFormat :: Pattern -> String -> String
nameFormat a b
| validPattern a = peekCString' $ flip withCString' b $ withMessage fcNameFormat a
@@ 146,6 164,7 @@ parseFontFeatures (String feat:toks) | feature@(_:_:_:_:[]) <- unpack feat = cas
_ -> ([], False, String feat:toks)
parseFontFeatures toks = ([], False, toks)
+-- | Parse OpenType variables from CSS syntax.
parseFontVars :: [Token] -> ([(String, Double)], Bool, [Token])
parseFontVars (String var':Number _ x:Comma:toks) | var@(_:_:_:_:[]) <- unpack var' =
let (vars, b, tail') = parseFontVars toks in ((var, nv2double x):vars, b, tail')
@@ 168,6 187,7 @@ parseLength super len unit = convert (nv2double len) unit
c x "%" = x/100 `c` "em"
c _ _ = 0/0 -- NaN
+-- | Parse the CSS font-stretch property.
parseFontStretch :: Token -> Maybe Int -- Result in percentages
parseFontStretch (Percentage _ x) = Just $ fromEnum $ nv2double x
parseFontStretch (Ident "ultra-condensed") = Just 50
@@ 183,6 203,7 @@ parseFontStretch (Ident "ultra-expanded") = Just 200
parseFontStretch _ = Nothing
-- Conversion between CSS scale & FontConfig scale is non-trivial, use lookuptable.
+-- | Parse the CSS font-weight property.
parseFontWeight :: Token -> Maybe Int
parseFontWeight (Ident k) | k `elem` ["initial", "normal"] = Just 80
parseFontWeight (Ident "bold") = Just 200
M lib/Graphics/Text/Font/Choose/Range.hs => lib/Graphics/Text/Font/Choose/Range.hs +2 -1
@@ 9,7 9,7 @@ import Data.Hashable (Hashable(..))
import qualified Data.Vector as V
import qualified Data.IntMap as IM
--- | Matches a numeric range.
+-- | Matches a numeric range, bounded by 2 floating point numbers.
data Range = Range Double Double deriving (Eq, Read, Show, Ord, Generic)
-- | Matches an integral range.
iRange :: Int -> Int -> Range
@@ 30,5 30,6 @@ instance Arbitrary Range where
return $ Range a $ a + abs b + 1
instance Hashable Range
+-- | Can FontConfig process this range?
validRange :: Range -> Bool
validRange (Range start end) = start < end
M lib/Graphics/Text/Font/Choose/Value.hs => lib/Graphics/Text/Font/Choose/Value.hs +2 -1
@@ 73,6 73,7 @@ instance Arbitrary Value where
ValueRange <$> arbitrary
]
+-- | Can the value be processed by FontConfig?
validValue :: Value -> Bool
validValue (ValueString "") = False
validValue (ValueString x) = '\0' `notElem` x
@@ 81,7 82,7 @@ validValue (ValueLangSet x) = validLangSet x
validValue (ValueRange x) = validRange x
validValue _ = True
--- | Coerces compiletime types to runtime types.
+-- | Coerces compiletime types to or from runtime types.
class ToValue x where
toValue :: x -> Value
fromValue :: Value -> Maybe x
M lib/Graphics/Text/Font/Choose/Weight.hs => lib/Graphics/Text/Font/Choose/Weight.hs +11 -0
@@ 3,11 3,22 @@
module Graphics.Text.Font.Choose.Weight(weightFromOpenTypeDouble,
weightToOpenTypeDouble, weightFromOpenType, weightToOpenType) where
+-- | Returns an double value to use with FC_WEIGHT, from an double in the 1..1000 range,
+-- resembling the numbers from OpenType specification's OS2 usWeight numbers,
+-- which are also similar to CSS font-weight numbers.
+-- If input is negative, zero, or greater than 1000, returns -1.
+-- This function linearly interpolates between various FC_WEIGHT_* constants.
+-- As such, the returned value does not necessarily match any of the predefined constants.
foreign import capi "fontconfig/fontconfig.h FcWeightFromOpenTypeDouble"
weightFromOpenTypeDouble :: Double -> Double
+-- | the inverse of FcWeightFromOpenType. If the input is less than FC_WEIGHT_THIN
+-- or greater than FC_WEIGHT_EXTRABLACK, returns -1.
+-- Otherwise returns a number in the range 1 to 1000.
foreign import capi "fontconfig/fontconfig.h FcWeightToOpenTypeDouble"
weightToOpenTypeDouble :: Double -> Double
+-- | Like weightFromOpenTypeDouble but with integer arguments. Use the other function instead.
foreign import capi "fontconfig/fontconfig.h FcWeightFromOpenType"
weightFromOpenType :: Int -> Int
+-- | Like weightToOpenTypeDouble but with integer arguments. Use the other function instead.
foreign import capi "fontconfig/fontconfig.h FcWeightToOpenType"
weightToOpenType :: Int -> Int