From 046b068fbc4d46626147e752cde59645b0954f45 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Tue, 29 Nov 2022 15:08:35 +1300
Subject: [PATCH] Bind CSS 'font-stretch' to FontConfig 'width' property, has
 same scale!

---
 Graphics/Text/Font/Choose/Pattern.hs | 26 +++++++++++++++++++++-----
 1 file changed, 21 insertions(+), 5 deletions(-)

diff --git a/Graphics/Text/Font/Choose/Pattern.hs b/Graphics/Text/Font/Choose/Pattern.hs
index 3d17b35..8c9885e 100644
--- a/Graphics/Text/Font/Choose/Pattern.hs
+++ b/Graphics/Text/Font/Choose/Pattern.hs
@@ -190,11 +190,11 @@ parseFontFeatures (String feat:toks) | feature@(_:_:_:_:[]) <- unpack feat = cas
     Number _ (NVInteger x):tail -> ([(feature, fromEnum x)], True, tail)
 parseFontFeatures toks = ([], False, toks)
 
-parseFontVars :: [Token] -> ([(String, NumericValue)], Bool, [Token])
+parseFontVars :: [Token] -> ([(String, Double)], Bool, [Token])
 parseFontVars (String var':Number _ x:Comma:tail) | var@(_:_:_:_:[]) <- unpack var' =
-    let (vars, b, tail') = parseFontVars tail in ((var, x):vars, b, tail')
+    let (vars, b, tail') = parseFontVars tail in ((var, nv2double x):vars, b, tail')
 parseFontVars (String var':Number _ x:tail) | var@(_:_:_:_:[]) <- unpack var' =
-    ([(var, x)], True, tail)
+    ([(var, nv2double x)], True, tail)
 parseFontVars toks = ([], False, toks)
 
 parseLength :: Double -> NumericValue -> Text -> Double
@@ -212,8 +212,8 @@ parseLength super length unit = convert (nv2double length) unit
     c x "%" = x/100 `c` "em"
     c _ _ = 0/0 -- NaN
 
-    nv2double (NVInteger x) = fromInteger x
-    nx2double (NVNumber x) = toRealFloat x
+nv2double (NVInteger x) = fromInteger x
+nv2double (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
@@ -281,4 +281,20 @@ 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 _ _ _ _ = Nothing
-- 
2.30.2