5 files changed, 44 insertions(+), 33 deletions(-)

M Graphics/Layout/CSS/Font.hs
M Graphics/Layout/CSS/Parse.hs
M app/Integration.hs
M app/Integration2.hs
M cattrap.cabal

@@ 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 {

@@ 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

@@ 105,7 105,7 @@ lowerToks _ = CSSCond.B False
 
 main :: IO ()
 main = do
-    FC.init
+    FC.initFonts
     SDL.initializeAll
 
     let wcfg = defaultWindow {

@@ 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)))

@@ 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