@@ 86,7 86,7 @@ library
build-depends: base >=4.12 && <5, containers >=0.1 && <1, css-syntax,
freetype2 >=0.2 && <0.3, hashable >=1.3 && <2, linear >=1.0.1 && <2,
scientific, stylist-traits >=0.1.1 && <1, text, msgpack >= 1.0 && <2,
- vector >= 0.13 && <1, bytestring
+ vector >= 0.13 && <1, bytestring, stylist-traits, css-syntax
-- Directories containing source files.
hs-source-dirs: lib
@@ 1,4 1,5 @@
{-# LANGUAGE DeriveGeneric, CApiFFI #-}
+{-# LANGUAGE OverloadedStrings #-}
module Graphics.Text.Font.Choose.Pattern where
import Data.Map as M
@@ 14,8 15,16 @@ import Graphics.Text.Font.Choose.Internal.FFI (withMessage, fromMessage0, withCS
import Graphics.Text.Font.Choose.Value
import Graphics.Text.Font.Choose.ObjectSet
import Graphics.Text.Font.Choose.Result
+import Graphics.Text.Font.Choose.Weight
-type Pattern = Map String [(Binding, Value)]
+import Stylist (StyleSheet(..), PropertyParser(..))
+import Stylist.Parse (parseProperties)
+import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..), serialize)
+import Data.Text (Text, unpack)
+import Data.Scientific (toRealFloat)
+import Data.List (intercalate)
+
+type Pattern = Map Text [(Binding, Value)]
data Pattern' = Pattern' { unPattern :: Pattern }
data Binding = Strong | Weak | Same deriving (Eq, Ord, Enum, Read, Show, Generic)
@@ 30,6 39,11 @@ instance MessagePack Binding where
toObject Weak = ObjectBool False
toObject Same = ObjectNil
+setValue :: ToValue v => Text -> Binding -> v -> Pattern -> Pattern
+setValue key strength v self = setValues key strength [v] self
+setValues :: ToValue v => Text -> Binding -> [v] -> Pattern -> Pattern
+setValues key strength vs self = M.insert key [(strength, toValue v) | v <- vs] self
+
equalSubset :: Pattern -> Pattern -> ObjectSet -> Bool
equalSubset a b os = case withMessage fcPatternEqualSubset [toObject a, toObject b, toObject os] of
0 -> False
@@ 62,7 76,7 @@ foreign import capi "fontconfig-wrap.h" fcNameFormat :: CString -> Int -> CStrin
--- CSS
------
-{-parseFontFamily :: [Token] -> ([String], Bool, [Token])
+parseFontFamily :: [Token] -> ([String], Bool, [Token])
parseFontFamily (String font:Comma:tail) = let (fonts, b, tail') = parseFontFamily tail
in (unpack font:fonts, b, tail')
parseFontFamily (Ident font:Comma:tail) = let (fonts, b, tail') = parseFontFamily tail
@@ 132,59 146,65 @@ 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
seti a b c d = Just $ setValue a b (c :: Int) d
-unset' a b = Just $ unset a b
+unset' a b = Just $ M.delete a b
-getSize pat | ValueDouble x <- getValue "size" pat = x
+getSize pat | Just [(_, ValueDouble x)] <- M.lookup "size" pat = x
| otherwise = 10
-instance PropertyParser Pattern where
- temp = []
+instance PropertyParser Pattern' where
+ temp = Pattern' M.empty
- longhand _ self "font-family" toks
- | (fonts, True, []) <- parseFontFamily toks = sets "family" Strong fonts self
+ longhand _ (Pattern' self) "font-family" toks
+ | (fonts, True, []) <- parseFontFamily toks = Pattern' <$> sets "family" Strong fonts self
-- font-size: initial should be configurable!
- longhand super self "font-size" [Dimension _ x unit]
+ longhand (Pattern' super) (Pattern' self) "font-size" [Dimension _ x unit]
| let y = parseLength (getSize super) x unit, not $ isNaN y =
- set "size" Strong y self
+ Pattern' <$> 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
+ longhand _ (Pattern' self) "font-style" [Ident "initial"] = Pattern' <$> seti "slant" Strong 0 self
+ longhand _ (Pattern' self) "font-style" [Ident "normal"] = Pattern' <$> seti "slant" Strong 0 self
+ longhand _ (Pattern' self) "font-style" [Ident "italic"] = Pattern' <$> seti "slant" Strong 100 self
+ longhand _ (Pattern' self) "font-style" [Ident "oblique"] = Pattern' <$> seti "slant" Strong 110 self
-- Conversion between CSS scale & FontConfig scale is non-trivial, use lookuptable.
- longhand _ self "font-weight" [tok]
- | Just x <- parseFontWeight tok = seti "weight" Strong x self
+ -- FIXME: Use Graphics.Text.Font.Choose.Weight!
+ longhand _ (Pattern' self) "font-weight" [tok]
+ | Just x <- parseFontWeight tok = Pattern' <$> 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]
- longhand _ self "font-weight" [Ident "lighter"]
- | ValueInt x <- getValue "weight" self, x > 200 = seti "weight" Strong 200 self
+ longhand _ (Pattern' self) "font-weight" [Ident "lighter"]
+ | Just ((_, ValueInt x):_) <- M.lookup "weight" self, x > 200 =
+ Pattern' <$> 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 _ self "font-feature-settings" [Ident k]
- | k `elem` ["initial", "normal"] = unset' "fontfeatures" self
- longhand _ self "font-feature-settings" toks
- | (features, True, []) <- parseFontFeatures toks =
- set "fontfeatures" Strong (intercalate "," $ map fst features) self
-
- longhand _ self "font-variation-settings" [Ident k]
- | k `elem` ["initial", "normal"] = unset' "variable" self
- longhand _ self "font-variation-settings" toks
- | (_, True, []) <- parseFontVars toks = set "variable" Strong True self
-
- longhand _ s "font-stretch" [tok]
- | Just x <- parseFontStretch tok = seti "width" Strong x s
-
- longhand _ _ _ _ = Nothing -}
+ | Just ((_, ValueInt x):_) <- M.lookup "weight" self =
+ Pattern' <$> seti "weight" Strong (max (x - 100) 0) self
+ | otherwise = Pattern' <$> seti "weight" Strong 0 self
+ longhand _ self'@(Pattern' self) "font-weight" [Ident "bolder"]
+ | Just ((_, ValueInt x):_) <- M.lookup "weight" self, x <= 65 =
+ Pattern' <$> seti "weight" Strong 80 self
+ | Just ((_, ValueInt x):_) <- M.lookup "weight" self, x <= 150 =
+ Pattern' <$> seti "weight" Strong 200 self
+ | Just ((_, ValueInt x):_) <- M.lookup "weight" self, x < 210 =
+ Pattern' <$> seti "weight" Strong 210 self
+ | Just ((_, ValueInt _):_) <- M.lookup "weight" self = Just self' -- As bold as it goes...
+ | otherwise = Pattern' <$> seti "weight" Strong 200 self
+
+ longhand _ (Pattern' self) "font-feature-settings" [Ident k]
+ | k `elem` ["initial", "normal"] = Pattern' <$> unset' "fontfeatures" self
+ longhand _ (Pattern' self) "font-feature-settings" toks
+ | (features, True, []) <- parseFontFeatures toks = Pattern' <$>
+ set "fontfeatures" Strong (intercalate "," $ Prelude.map fst features) self
+
+ longhand _ (Pattern' self) "font-variation-settings" [Ident k]
+ | k `elem` ["initial", "normal"] = Pattern' <$> unset' "variable" self
+ longhand _ (Pattern' self) "font-variation-settings" toks
+ | (_, True, []) <- parseFontVars toks = Pattern' <$> set "variable" Strong True self
+
+ longhand _ (Pattern' s) "font-stretch" [tok]
+ | Just x <- parseFontStretch tok = Pattern' <$> seti "width" Strong x s
+
+ longhand _ _ _ _ = Nothing