2 files changed, 41 insertions(+), 12 deletions(-)

M Graphics/Text/Font/Choose/Pattern.hs
M fontconfig-pure.cabal

@@ 20,13 20,14 @@ import Debug.Trace (trace) -- For reporting internal errors!
 import System.IO.Unsafe (unsafePerformIO)
 
 import Control.Monad (forM, join)
-import Data.Maybe (catMaybes)
+import Data.Maybe (catMaybes, fromMaybe)
 import Control.Exception (bracket)
 
 -- Imported for CSS bindings
-import Data.CSS.Syntax.Tokens (Token(..))
-import Data.Text (unpack)
+import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
+import Data.Text (unpack, Text)
 import Stylist (PropertyParser(..))
+import Data.Scientific (toRealFloat)
 
 type Pattern = [(String, [(Binding, Value)])]
 data Binding = Strong | Weak | Same deriving (Eq, Ord, Enum, Show, Generic)


@@ 36,11 37,15 @@ instance Hashable Binding where
     hash Weak = 1
     hash Same = 2
 
-addValue :: ToValue x => String -> Binding -> x -> Pattern -> Pattern
-addValue key b value pat = normalizePattern ((key, [(b, toValue value)]):pat)
-addValues :: ToValue x => String -> Binding -> [x] -> Pattern -> Pattern
-addValues key b values pat =
-    normalizePattern ((key, [(b, toValue v) | v <- values]):pat)
+setValue :: ToValue x => String -> Binding -> x -> Pattern -> Pattern
+setValue key b value pat = (key, [(b, toValue value)]):unset key pat
+setValues :: ToValue x => String -> Binding -> [x] -> Pattern -> Pattern
+setValues key b values pat = (key, [(b, toValue v) | v <- values]):unset key pat
+getValue :: String -> Pattern -> Maybe Value
+getValue key pat | Just ((_, ret):_) <- lookup key pat = Just ret
+    | otherwise = Nothing
+
+unset key mapping = [(key', val') | (key', val') <- mapping, key' /= key]
 
 normalizePattern :: Pattern -> Pattern
 normalizePattern pat =


@@ 172,12 177,36 @@ parseFontFamily (String font:tail) = ([unpack font], True, tail)
 parseFontFamily (Ident font:tail) = ([unpack font], True, tail)
 parseFontFamily toks = ([], False, toks) -- Invalid syntax!
 
-adds a b c d = Just $ addValues a b c d
-add a b c d = Just $ addValue a b c d
+parseLength :: Double -> NumericValue -> Text -> Double
+parseLength super length unit = convert (nv2double length) unit
+  where
+    convert = c
+    c x "pt" = x -- Unit FontConfig expects!
+    c x "pc" = x/6 `c` "in"
+    c x "in" = x/72 `c` "pt"
+    c x "Q" = x/40 `c` "cm"
+    c x "mm" = x/10 `c` "cm"
+    c x "cm" = x/2.54 `c` "in"
+    c x "px" = x/96 `c` "in" -- Conversion factor during early days of CSS, got entrenched.
+    c x "em" = x * super
+    c x "%" = x/100 `c` "em"
+    c _ _ = 0/0 -- NaN
+
+    nv2double (NVInteger x) = fromInteger x
+    nx2double (NVNumber x) = toRealFloat x
+
+sets a b c d = Just $ setValues a b c d
+set a b c d = Just $ setValue a b c d
+
+getSize pat | Just (ValueDouble x) <- getValue "size" pat = x
+    | otherwise = 10
 
 instance PropertyParser Pattern where
     temp = []
 
     longhand _ self "font-family" toks
-        | (fonts, True, []) <- parseFontFamily toks = adds "family" Strong fonts self
+        | (fonts, True, []) <- parseFontFamily toks = sets "family" Strong fonts self
+    longhand super self "font-size" [Dimension _ x unit]
+        | let y = parseLength (getSize super) x unit, not $ isNaN y =
+            set "size" Strong y self
     longhand _ _ _ _ = Nothing

@@ 71,7 71,7 @@ library
   build-depends:       base >=4.12 && <4.13, containers >= 0.1 && <1,
                         linear >= 1.0.1 && <2, freetype2 >= 0.2 && < 0.3,
                         hashable >= 1.3 && <2,
-                        css-syntax, text, stylist-traits >= 0.1.1 && < 1
+                        css-syntax, text, stylist-traits >= 0.1.1 && < 1, scientific
 
   pkgconfig-depends:    fontconfig