From 15889a7d3a784c6d0bec914603c2d2b85a3eb819 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Tue, 4 Feb 2025 12:29:32 +1300 Subject: [PATCH] Upgrade to more resilient FontConfig-Pure! --- Graphics/Layout/CSS/Font.hs | 37 ++++++++++++++++++++---------------- Graphics/Layout/CSS/Parse.hs | 34 +++++++++++++++++++-------------- app/Integration.hs | 2 +- app/Integration2.hs | 2 +- cattrap.cabal | 2 +- 5 files changed, 44 insertions(+), 33 deletions(-) diff --git a/Graphics/Layout/CSS/Font.hs b/Graphics/Layout/CSS/Font.hs index 7c6ac5b..7517a90 100644 --- a/Graphics/Layout/CSS/Font.hs +++ b/Graphics/Layout/CSS/Font.hs @@ -7,20 +7,23 @@ import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..), serialize) import Stylist (PropertyParser(..)) import qualified Data.Text as Txt import Data.Maybe (fromMaybe) +import qualified Data.List as L import Graphics.Layout.Box import Graphics.Layout.CSS.Length import Data.Text.Glyphize as HB -import Graphics.Text.Font.Choose (Pattern(..), Value(..), normalizePattern, - getValue', getValue0, setValue, Binding(..), - configSubstitute', defaultSubstitute, - fontSort', MatchKind(..), fontRenderPrepare') +import Graphics.Text.Font.Choose (Pattern(..), Value(..), + getValues, getValue, setValue, Binding(..), + substitute, defaultSubstitute, current', + fontSort, MatchKind(..), fontRenderPrepare) +import Graphics.Text.Font.Choose.Config (Config) +import Data.Map as M import qualified Data.ByteString as B import System.IO.Unsafe (unsafePerformIO) -- | zero'd `Font'` to serve as the root's parent in a font heirarchy. -placeholderFont = Font' undefined [] (const 0) (const 0) 0 0 0 0 0 0 0 0 1 +placeholderFont = Font' undefined M.empty (const 0) (const 0) 0 0 0 0 0 0 0 0 1 -- | Scale-factor for text-shaping APIs. hbUnit = 64 :: Double @@ -28,16 +31,16 @@ hbUnit = 64 :: Double pattern2hbfont :: Pattern -> Int -> [Variation] -> Font pattern2hbfont pat scale variations = createFontWithOptions options face where - bytes = unsafePerformIO $ B.readFile $ getValue0 "file" pat - face = createFace bytes $ toEnum $ fromMaybe 0 $ getValue' "index" pat - options = foldl value2opt defaultFontOptions { optionScale = Just (scale, scale) } $ - normalizePattern pat + bytes | Just path <- getValue "file" pat = unsafePerformIO $ B.readFile path + | otherwise = "" -- Should yield an empty font. + face = createFace bytes $ toEnum $ fromMaybe 0 $ getValue "index" pat + options = M.foldlWithKey value2opt defaultFontOptions { optionScale = Just (scale, scale) } pat - value2opt opts ("slant", (_, ValueInt x):_) = opts { + value2opt opts "slant" ((_, ValueInt x):_) = opts { optionSynthSlant = Just $ realToFrac x } - value2opt opts ("fontvariations", _:_) = opts {optionVariations = variations} - value2opt opts _ = opts + value2opt opts "fontvariations" (_:_) = opts {optionVariations = variations} + value2opt opts _ _ = opts -- | Convert Parsed CSS to a `Font'`. -- Includes sizing parameters derived from a root & parent `Font'`. @@ -68,14 +71,16 @@ pattern2font pat styles parent root = Font' { fontSize' = lowerLength' (cssFontSize styles) parent lowerLength' a = lowerLength (fontSize parent) . finalizeLength a fontGlyph' ch = fromMaybe 0 $ fontGlyph font' ch Nothing - q | Nothing <- lookup "family" pat, Just val <- lookup "family" $ pattern root = - ("family", val):setValue "size" Weak (px2pt root fontSize') pat + q | Nothing <- M.lookup "family" pat, Just val <- M.lookup "family" $ pattern root = + M.insert "family" val $ setValue "size" Weak (px2pt root fontSize') pat | otherwise = setValue "size" Weak (px2pt root fontSize') pat - font = case fontSort' (defaultSubstitute $ configSubstitute' q MatchPattern) False of - Just (font:_, _) -> fontRenderPrepare' q font + font :: Pattern + font = case fontSort cfg (defaultSubstitute $ substitute cfg q Nothing MatchPattern) False of + Just (font:_, _) -> fontRenderPrepare cfg q font _ -> error "TODO: Set fallback font!" font' = pattern2hbfont font (round scale') $ variations' fontSize' styles scale' = fontSize' * hbUnit + cfg = current' -- | Parsed CSS font properties, excluding the FontConfig query. data CSSFont = CSSFont { diff --git a/Graphics/Layout/CSS/Parse.hs b/Graphics/Layout/CSS/Parse.hs index ccbe6e0..9c0f5dd 100644 --- a/Graphics/Layout/CSS/Parse.hs +++ b/Graphics/Layout/CSS/Parse.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module Graphics.Layout.CSS.Parse ( - CSSBox(..), direction, txtOpts, BoxSizing(..), Display(..)) where + CSSBox(..), font, direction, txtOpts, BoxSizing(..), Display(..)) where import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..)) import Stylist (PropertyParser(..), TrivialPropertyParser, parseOperands, parseUnorderedShorthand', parseUnorderedShorthand) @@ -10,7 +10,7 @@ import Data.Text.ParagraphLayout.Rich (textDirection, ParagraphOptions, import Data.Text.Glyphize (Direction(..)) import Graphics.Layout.Box as B -import Graphics.Text.Font.Choose (Pattern, unset) +import Graphics.Text.Font.Choose (Pattern, Pattern'(..)) import Graphics.Layout.CSS.Length (Unitted, parseLength', parseLength, auto, units) import Graphics.Layout.CSS.Font (CSSFont) import Graphics.Layout.Grid.CSS (CSSGrid(..), CSSCell(..), Placement(..)) @@ -21,6 +21,7 @@ import Graphics.Layout.Flex.CSS (CSSFlex(..)) import Data.Maybe (isJust, fromMaybe) import Text.Read (readMaybe) import qualified Data.HashMap.Lazy as HM +import qualified Data.Map as M import Data.Text (Text, unpack) import Debug.Trace (trace) -- For debug warnings. @@ -34,7 +35,7 @@ data CSSBox a = CSSBox { -- Stores units in case they're needed for font-related units. cssBox :: PaddedBox Unitted Unitted, -- calc()? -- | Query parameters describing desired font. - font :: Pattern, + font_ :: Pattern', -- | Additional font-related CSS properties. font' :: CSSFont, -- | Caller-specified data, to parse additional CSS properties. @@ -59,6 +60,8 @@ data CSSBox a = CSSBox { -- | Semi-parsed CSS properties relating to FlexBox layouts. flexOptions :: CSSFlex } +-- | Retrieve unwrapped font pattern. +font = unPattern . font_ -- | FlexOptions getter with `textLTR` set flexOpts' self@CSSBox { flexOptions = ret } = ret { textRTL = direction self == DirRTL } -- | Accessor for inlineStyle's `textDirection` attribute. @@ -91,7 +94,7 @@ instance PropertyParser a => PropertyParser (CSSBox a) where border = noborder, margin = noborder }, - font = temp, + font_ = temp, font' = temp, inner = temp, innerProperties = [], @@ -111,7 +114,7 @@ instance PropertyParser a => PropertyParser (CSSBox a) where boxSizing = boxSizing parent, display = Inline, cssBox = cssBox (temp :: CSSBox TrivialPropertyParser), - font = inherit $ font parent, + font_ = inherit $ font_ parent, font' = inherit $ font' parent, inner = inherit $ inner parent, innerProperties = [], @@ -124,13 +127,13 @@ instance PropertyParser a => PropertyParser (CSSBox a) where tableOptions = inherit $ tableOptions parent, flexOptions = inherit $ flexOptions parent } - priority self = concat [x inlineStyles, x font, x font', x gridStyles, + priority self = concat [x inlineStyles, x font_, x font', x gridStyles, x cellStyles, x flexOptions, x inner] where x getter = priority $ getter self -- Wasn't sure how to implement in FontConfig-Pure longhand _ self "font-family" [Ident "initial"] = - Just self { font = unset "family" $ font self} + Just self { font_ = Pattern' $ M.delete "family" $ font self} longhand _ self "box-sizing" [Ident "content-box"] = Just self {boxSizing = ContentBox} longhand _ self "box-sizing" [Ident "border-box"] = Just self {boxSizing = BorderBox} @@ -305,11 +308,11 @@ instance PropertyParser a => PropertyParser (CSSBox a) where x -> ret x where ret x = Just self { paragraphOptions = o { paragraphAlignment = x } } - longhand a b c d | Just x <- longhand (font a) (font b) c d, + longhand a b c d | Just x <- longhand (font_ a) (font_ b) c d, Just y <- longhand (font' a) (font' b) c d = - Just b { font = x, font' = y } -- Those properties can overlap! - longhand a b c d | Just font' <- longhand (font a) (font b) c d = Just b { - font = font' + Just b { font_ = x, font' = y } -- Those properties can overlap! + longhand a b c d | Just font' <- longhand (font_ a) (font_ b) c d = Just b { + font_ = font' } longhand a b c d | Just font <- longhand (font' a) (font' b) c d = Just b { font' = font @@ -360,8 +363,11 @@ instance PropertyParser a => PropertyParser (CSSBox a) where (a:toks') | ret@(_:_) <- unordered [a] -> inner ret toks' toks' -> inner [] toks' where - unordered operands = parseUnorderedShorthand' self [ - "font-style", "font-variant", "font-weight", "font-stretch"] operands + unordered operands = + let ret = parseUnorderedShorthand' self [ + "font-style", "font-variant", "font-weight", "font-stretch" + ] operands + in if ("", []) `elem` ret then [] else ret -- Check for errors! inner ret (size:[Delim '/']:height:family) | Just _ <- longhand self self "font-size" size, Just _ <- longhand self self "line-height" height, @@ -395,7 +401,7 @@ instance PropertyParser a => PropertyParser (CSSBox a) where ("border-bottom-width", bottom), ("border-left-width", left)] where x = parseOperands toks - shorthand self k v | ret@(_:_) <- shorthand (font self) k v = ret + shorthand self k v | ret@(_:_) <- shorthand (font_ self) k v = ret shorthand self k v | ret@(_:_) <- shorthand (font' self) k v = ret shorthand self k v | ret@(_:_) <- shorthand (inlineStyles self) k v = ret shorthand self k v | ret@(_:_) <- shorthand (gridStyles self) k v = ret diff --git a/app/Integration.hs b/app/Integration.hs index 8721c4a..1695ccb 100644 --- a/app/Integration.hs +++ b/app/Integration.hs @@ -105,7 +105,7 @@ lowerToks _ = CSSCond.B False main :: IO () main = do - FC.init + FC.initFonts SDL.initializeAll let wcfg = defaultWindow { diff --git a/app/Integration2.hs b/app/Integration2.hs index a7e05c0..700e785 100644 --- a/app/Integration2.hs +++ b/app/Integration2.hs @@ -36,7 +36,7 @@ stylize' style = preorder inner main :: IO () main = do - FC.init + FC.initFonts doc <- HTML.readFile "test.html" let css' :: CSSCond.ConditionalStyles (Style.VarParser (CSSTxt.TextStyle (CSSBox Nil))) diff --git a/cattrap.cabal b/cattrap.cabal index 5d02c0a..1339aa1 100644 --- a/cattrap.cabal +++ b/cattrap.cabal @@ -34,7 +34,7 @@ library build-depends: base >=4.12 && <5, containers >= 0.6 && < 1, parallel >= 3 && <4, css-syntax >= 0.1 && < 0.2, scientific >= 0.3 && < 1, text >= 2.0.2, deepseq >= 1.4 && <2, stylist-traits >= 0.1.3.0 && < 1, - fontconfig-pure >= 0.2 && < 0.5, + fontconfig-pure >= 0.5.1.0 && < 0.6, harfbuzz-pure >= 1.0.3.2 && < 1.1, bytestring >= 0.11 && <1, balkon >= 1.2 && <2, unordered-containers >= 0.2 && <1, data-array-byte >= 0.1 && < 0.2 -- 2.30.2