From 1c28add050308b9568fdb41831772e40b9251302 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Fri, 2 Dec 2022 11:10:47 +1300
Subject: [PATCH] Parse font-weight & font-stretch properties for @font-face.

---
 Graphics/Text/Font/Choose/FontSet.hs | 13 ++++++
 Graphics/Text/Font/Choose/Pattern.hs | 69 ++++++++++++++++------------
 2 files changed, 53 insertions(+), 29 deletions(-)

diff --git a/Graphics/Text/Font/Choose/FontSet.hs b/Graphics/Text/Font/Choose/FontSet.hs
index 550f34a..c5d41ef 100644
--- a/Graphics/Text/Font/Choose/FontSet.hs
+++ b/Graphics/Text/Font/Choose/FontSet.hs
@@ -15,6 +15,7 @@ import Control.Exception (bracket)
 import Stylist.Parse (StyleSheet(..), parseProperties)
 import Data.CSS.Syntax.Tokens (Token(..))
 import Data.Text (unpack, Text)
+import Graphics.Text.Font.Choose.Range (iRange)
 
 type FontSet = [Pattern]
 
@@ -74,6 +75,18 @@ properties2font (("font-family", [String font]):props) =
 properties2font (("font-family", [Ident font]):props) =
     setValue "family" Strong (unpack font) $ properties2font props
 
+properties2font (("font-stretch", [tok]):props) | Just x <- parseFontStretch tok =
+    setValue "width" Strong x $ properties2font props
+properties2font (("font-stretch", [start, end]):props)
+    | Just x <- parseFontStretch start, Just y <- parseFontStretch end =
+        setValue "width" Strong (x `iRange` y) $ properties2font props
+
+properties2font (("font-weight", [tok]):props) | Just x <- parseFontWeight tok =
+    setValue "width" Strong x $ properties2font props
+properties2font (("font-weight", [start, end]):props)
+    | Just x <- parseFontStretch start, Just y <- parseFontStretch end =
+        setValue "weight" Strong (x `iRange` y) $ properties2font props
+
 properties2font (_:props) = properties2font props
 properties2font [] = []
 
diff --git a/Graphics/Text/Font/Choose/Pattern.hs b/Graphics/Text/Font/Choose/Pattern.hs
index f69122e..5e328cd 100644
--- a/Graphics/Text/Font/Choose/Pattern.hs
+++ b/Graphics/Text/Font/Choose/Pattern.hs
@@ -3,7 +3,9 @@ module Graphics.Text.Font.Choose.Pattern (Pattern(..), Binding(..), equalSubset,
     normalizePattern, filter, defaultSubstitute, nameParse, nameUnparse, format,
     Pattern_, withPattern, thawPattern, thawPattern_, patternAsPointer,
 
-    setValue, setValues, unset) where
+    setValue, setValues, unset,
+    parseFontFamily, parseFontFeatures, parseFontVars, parseLength,
+    parseFontStretch, parseFontWeight) where
 
 import Prelude hiding (filter)
 import Data.List (nub)
@@ -214,6 +216,39 @@ parseLength super length unit = convert (nv2double length) unit
     c x "%" = x/100 `c` "em"
     c _ _ = 0/0 -- NaN
 
+parseFontStretch :: Token -> Maybe Int -- Result in percentages
+parseFontStretch (Percentage _ x) = Just $ fromEnum $ nv2double x
+parseFontStretch (Ident "ultra-condensed") = Just 50
+parseFontStretch (Ident "extra-condensed") = Just 63 -- 62.5%, but round towards 100%
+parseFontStretch (Ident "condensed") = Just 75
+parseFontStretch (Ident "semi-condensed") = Just 88 -- 87.5% actually...
+parseFontStretch (Ident "normal") = Just 100
+parseFontStretch (Ident "initial") = Just 100
+parseFontStretch (Ident "semi-expanded") = Just 112 -- 112.5% actually...
+parseFontStretch (Ident "expanded") = Just 125
+parseFontStretch (Ident "extra-expanded") = Just 150
+parseFontStretch (Ident "ultra-expanded") = Just 200
+parseFontStretch _ = Nothing
+
+-- Conversion between CSS scale & FontConfig scale is non-trivial, use lookuptable.
+parseFontWeight :: Token -> Maybe Int
+parseFontWeight (Ident k) | k `elem` ["initial", "normal"] = Just 80
+parseFontWeight (Ident "bold") = Just 200
+parseFontWeight (Number _ (NVInteger 100)) = Just 0
+parseFontWeight (Number _ (NVInteger 200)) = Just 40
+parseFontWeight (Number _ (NVInteger 300)) = Just 50
+parseFontWeight (Number _ (NVInteger 400)) = Just 80
+parseFontWeight (Number _ (NVInteger 500)) = Just 100
+parseFontWeight (Number _ (NVInteger 600)) = Just 180
+parseFontWeight (Number _ (NVInteger 700)) = Just 200
+parseFontWeight (Number _ (NVInteger 800)) = Just 205
+parseFontWeight (Number _ (NVInteger 900)) = Just 210
+parseFontWeight (Number _ (NVInteger 950)) = Just 215
+parseFontWeight (Number _ (NVInteger x))
+    | x > 920 = parseFontWeight $ Number "" $ NVInteger 950
+    | otherwise = parseFontWeight $ Number "" $ NVInteger $ (x `div` 100) * 100
+parseFontWeight _ = Nothing
+
 nv2double (NVInteger x) = fromInteger x
 nv2double (NVNumber x) = toRealFloat x
 
@@ -244,19 +279,8 @@ instance PropertyParser Pattern where
     longhand _ self "font-style" [Ident "oblique"] = seti "slant" Strong 110 self
 
     -- Conversion between CSS scale & FontConfig scale is non-trivial, use lookuptable.
-    longhand _ self "font-weight" [Ident "initial"] = seti "weight" Strong 80 self
-    longhand _ self "font-weight" [Ident "normal"] = seti "weight" Strong 80 self
-    longhand _ self "font-weight" [Ident "bold"] = seti "weight" Strong 200 self
-    longhand _ s "font-weight" [Number _ (NVInteger 100)] = seti "weight" Strong 0 s
-    longhand _ s "font-weight" [Number _ (NVInteger 200)] = seti "weight" Strong 40 s
-    longhand _ s "font-weight" [Number _ (NVInteger 300)] = seti "weight" Strong 50 s
-    longhand _ s "font-weight" [Number _ (NVInteger 400)] = seti "weight" Strong 80 s
-    longhand _ s "font-weight" [Number _ (NVInteger 500)] = seti "weight" Strong 100 s
-    longhand _ s "font-weight" [Number _ (NVInteger 600)] = seti "weight" Strong 180 s
-    longhand _ s "font-weight" [Number _ (NVInteger 700)] = seti "weight" Strong 200 s
-    longhand _ s "font-weight" [Number _ (NVInteger 800)] = seti "weight" Strong 205 s
-    longhand _ s "font-weight" [Number _ (NVInteger 900)] = seti "weight" Strong 210 s
-    longhand _ s "font-weight" [Number _ (NVInteger 950)] = seti "weight" Strong 215 s
+    longhand _ self "font-weight" [tok]
+        | Just x <- parseFontWeight tok = seti "weight" Strong x self
     longhand super self "font-weight" [Number _ (NVInteger x)]
         | x > 920 = longhand super self "font-weight" [Number "" $ NVInteger 950]
         | otherwise = longhand super self "font-weight" [Number "" $ NVInteger $ (x `div` 100) * 100]
@@ -283,20 +307,7 @@ instance PropertyParser Pattern where
     longhand _ self "font-variation-settings" toks
         | (_, True, []) <- parseFontVars toks = set "variable" Strong True self
 
-    longhand _ s "font-stretch" [Percentage _ x] =
-        seti "width" Strong (fromEnum $ nv2double x) s
-    longhand _ s "font-stretch" [Ident "ultra-condensed"] = seti "width" Strong 50 s
-    -- 62.5% actually, but round into an int towards 100%
-    longhand _ s "font-stretch" [Ident "extra-condensed"] = seti "width" Strong 63 s
-    longhand _ s "font-stretch" [Ident "condensed"] = seti "width" Strong 75 s
-    -- 87.5% actually...
-    longhand _ s "font-stretch" [Ident "semi-condensed"] = seti "width" Strong 88 s
-    longhand _ s "font-stretch" [Ident "normal"] = seti "width" Strong 100 s
-    longhand _ s "font-stretch" [Ident "initial"] = seti "width" Strong 100 s
-    -- 112.5% actually...
-    longhand _ s "font-stretch" [Ident "semi-expanded"] = seti "width" Strong 112 s
-    longhand _ s "font-stretch" [Ident "expanded"] = seti "width" Strong 125 s
-    longhand _ s "font-stretch" [Ident "extra-expanded"] = seti "width" Strong 150 s
-    longhand _ s "font-stretch" [Ident "ultra-expanded"] = seti "width" Strong 200 s
+    longhand _ s "font-stretch" [tok]
+        | Just x <- parseFontStretch tok = seti "width" Strong x s
 
     longhand _ _ _ _ = Nothing
-- 
2.30.2