From 86d19fc373e7fbe87d08c3ea32e49fc3992db812 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Wed, 15 Mar 2023 15:40:22 +1300 Subject: [PATCH] Improve font styling & it's configurability, expose font-pattern in output. --- Graphics/Layout/CSS.hs | 6 +++++- Graphics/Layout/CSS/Internal.hs | 25 +++++++++++++++++-------- 2 files changed, 22 insertions(+), 9 deletions(-) diff --git a/Graphics/Layout/CSS.hs b/Graphics/Layout/CSS.hs index 40b43b0..ed97ea1 100644 --- a/Graphics/Layout/CSS.hs +++ b/Graphics/Layout/CSS.hs @@ -8,7 +8,7 @@ import Stylist.Tree (StyleTree(..)) import Graphics.Layout.Box as B import Graphics.Layout -import Graphics.Text.Font.Choose (Pattern(..)) +import Graphics.Text.Font.Choose (Pattern(..), unset) import Graphics.Layout.CSS.Internal import Graphics.Layout.Grid.CSS import Graphics.Layout.Inline.CSS @@ -67,6 +67,10 @@ instance PropertyParser a => PropertyParser (CSSBox a) where captionBelow = captionBelow parent } + -- Wasn't sure how to implement in FontConfig-Pure + longhand _ self "font-family" [Ident "initial"] = + Just self { font = unset "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} longhand _ self "box-sizing" [Ident "initial"] = Just self {boxSizing = ContentBox} diff --git a/Graphics/Layout/CSS/Internal.hs b/Graphics/Layout/CSS/Internal.hs index 2beda12..8f6eea1 100644 --- a/Graphics/Layout/CSS/Internal.hs +++ b/Graphics/Layout/CSS/Internal.hs @@ -11,7 +11,8 @@ import Data.Maybe (fromMaybe) import Graphics.Layout.Box import Data.Text.Glyphize as HB -import Graphics.Text.Font.Choose (Pattern(..), Value(..), normalizePattern, getValue', getValue0) +import Graphics.Text.Font.Choose (Pattern(..), Value(..), normalizePattern, + getValue', getValue0, setValue, Binding(..)) import qualified Data.ByteString as B import System.IO.Unsafe (unsafePerformIO) @@ -61,10 +62,13 @@ finalizeLength (x,"%") _ = Percent $ x/100 finalizeLength (_,"auto") _ = Auto finalizeLength (_,"min-content") _ = Min finalizeLength (_,"max-content") _ = Preferred +finalizeLength (x, " ") _ = Pixels x -- Internal constant value... finalizeLength (_,unit) _ = trace ("Invalid unit " ++ Txt.unpack unit) $ Pixels 0 +px2pt f x = x / scale f / 96 * 72 data Font' = Font' { hbFont :: Maybe Font, -- Optional for sake of demo script, FIXME better solution? + pattern :: Pattern, fontHeight :: Char -> Double, fontAdvance :: Char -> Double, fontSize :: Double, @@ -77,7 +81,7 @@ data Font' = Font' { vmin :: Double, scale :: Double } -placeholderFont = Font' Nothing (const 0) (const 0) 0 0 0 0 0 0 0 0 1 +placeholderFont = Font' Nothing [] (const 0) (const 0) 0 0 0 0 0 0 0 0 1 hbScale f = fontSize f*hbUnit hbUnit = 64 @@ -96,8 +100,11 @@ pattern2hbfont pat scale variations = createFontWithOptions options face value2opt opts _ = opts pattern2font :: Pattern -> CSSFont -> Font' -> Font' -> Font' +pattern2font pat styles@CSSFont { cssFontSize = (x,"initial") } parent root = + pattern2font pat styles { cssFontSize = (x*fontSize root," ") } parent root pattern2font pat styles parent root = Font' { hbFont = Just font', + pattern = pat', fontHeight = height' . fontGlyphExtents font' . fontGlyph', fontAdvance = fromIntegral . fontGlyphHAdvance font' . fontGlyph', fontSize = fontSize', @@ -119,7 +126,10 @@ 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 - font' = pattern2hbfont pat (round scale') $ variations' fontSize' styles + pat' | Nothing <- lookup "family" pat, Just val <- lookup "family" $ pattern root = + ("family", val):setValue "size" Weak (px2pt root fontSize') pat + | otherwise = setValue "size" Weak (px2pt root fontSize') pat + font' = pattern2hbfont pat' (round scale') $ variations' fontSize' styles scale' = fontSize'*hbUnit data CSSFont = CSSFont { @@ -129,8 +139,7 @@ data CSSFont = CSSFont { weightVariation :: Variation, widthVariation :: Variation, slantVariation :: Variation, - opticalSize :: Bool, - defaultFontSize :: Unitted + opticalSize :: Bool } variations' :: Double -> CSSFont -> [Variation] variations' fontsize self = @@ -139,7 +148,7 @@ variations' fontsize self = fracDefault :: CSSFont -> Double -> Maybe CSSFont fracDefault self frac = Just self { - cssFontSize = (frac*fst (defaultFontSize self),snd $ defaultFontSize self) + cssFontSize = (frac,"initial") } instance PropertyParser CSSFont where temp = CSSFont { @@ -149,8 +158,7 @@ instance PropertyParser CSSFont where weightVariation = Variation wght 400, widthVariation = Variation wdth 100, slantVariation = Variation ital 0, - opticalSize = True, - defaultFontSize = (12,"pt") -- NOTE: Callers should load from system settings. + opticalSize = True } inherit parent = parent @@ -158,6 +166,7 @@ instance PropertyParser CSSFont where longhand _ self "font-size" [Ident "x-small"] = fracDefault self $ 3/4 longhand _ self "font-size" [Ident "small"] = fracDefault self $ 8/9 longhand _ self "font-size" [Ident "medium"] = fracDefault self 1 + longhand _ self "font-size" [Ident "initial"] = fracDefault self 1 longhand _ self "font-size" [Ident "large"] = fracDefault self $ 6/5 longhand _ self "font-size" [Ident "x-large"] = fracDefault self $ 3/2 longhand _ self "font-size" [Ident "xx-large"] = fracDefault self 2 -- 2.30.2