From 9e57fdc43cd990d2fdcf8cb3c02b91f3dae5387f Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Sun, 27 Nov 2022 19:49:47 +1300
Subject: [PATCH] Language-bind CSS 'font-weight' to FontConfig 'weight' & CSS
 'font-style' to FontConfig 'slant'

---
 Graphics/Text/Font/Choose/Pattern.hs | 48 +++++++++++++++++++++++++---
 1 file changed, 44 insertions(+), 4 deletions(-)

diff --git a/Graphics/Text/Font/Choose/Pattern.hs b/Graphics/Text/Font/Choose/Pattern.hs
index 586ed33..daa49a1 100644
--- a/Graphics/Text/Font/Choose/Pattern.hs
+++ b/Graphics/Text/Font/Choose/Pattern.hs
@@ -41,9 +41,9 @@ 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
+getValue :: String -> Pattern -> Value
+getValue key pat | Just ((_, ret):_) <- lookup key pat = ret
+    | otherwise = ValueVoid
 
 unset key mapping = [(key', val') | (key', val') <- mapping, key' /= key]
 
@@ -197,8 +197,9 @@ parseLength super length unit = convert (nv2double length) unit
 
 sets a b c d = Just $ setValues a b c d
 set a b c d = Just $ setValue a b c d
+seti a b c d = Just $ setValue a b (c :: Int) d
 
-getSize pat | Just (ValueDouble x) <- getValue "size" pat = x
+getSize pat | ValueDouble x <- getValue "size" pat = x
     | otherwise = 10
 
 instance PropertyParser Pattern where
@@ -206,7 +207,46 @@ instance PropertyParser Pattern where
 
     longhand _ self "font-family" toks
         | (fonts, True, []) <- parseFontFamily toks = sets "family" Strong fonts self
+
+    -- font-size: initial should be configurable!
     longhand super self "font-size" [Dimension _ x unit]
         | let y = parseLength (getSize super) x unit, not $ isNaN y =
             set "size" Strong y self
+    longhand super self "font-size" [Percentage x y] =
+        longhand super self "font-size" [Dimension x y "%"]
+
+    longhand _ self "font-style" [Ident "initial"] = seti "slant" Strong 0 self
+    longhand _ self "font-style" [Ident "normal"] = seti "slant" Strong 0 self
+    longhand _ self "font-style" [Ident "italic"] = seti "slant" Strong 100 self
+    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 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]
+    longhand _ self "font-weight" [Ident "lighter"]
+        | ValueInt x <- getValue "weight" self, x > 200 = seti "weight" Strong 200 self
+        -- minus 100 adhears to the CSS standard awefully well in this new scale.
+        | ValueInt x <- getValue "weight" self = seti "weight" Strong (max (x - 100) 0) self
+        | otherwise = seti "weight" Strong 0 self
+    longhand _ self "font-weight" [Ident "bolder"]
+        | ValueInt x <- getValue "weight" self, x <= 65 = seti "weight" Strong 80 self
+        | ValueInt x <- getValue "weight" self, x <= 150 = seti "weight" Strong 200 self
+        | ValueInt x <- getValue "weight" self, x < 210 = seti "weight" Strong 210 self
+        | ValueInt _ <- getValue "weight" self = Just self -- As bold as it goes...
+        | otherwise = seti "weight" Strong 200 self
+
     longhand _ _ _ _ = Nothing
-- 
2.30.2