3 files changed, 64 insertions(+), 5 deletions(-)

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

@@ 1,4 1,4 @@
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveGeneric, OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
 module Graphics.Text.Font.Choose.Pattern (Pattern(..), Binding(..), equalSubset,
     normalizePattern, filter, defaultSubstitute, nameParse, nameUnparse, format,
     Pattern_, withPattern, thawPattern, thawPattern_, patternAsPointer) where


@@ 6,7 6,7 @@ module Graphics.Text.Font.Choose.Pattern (Pattern(..), Binding(..), equalSubset,
 import Prelude hiding (filter)
 import Data.List (nub)
 
-import Graphics.Text.Font.Choose.Value (Value, withValue, thawValue, Value_, value'Size)
+import Graphics.Text.Font.Choose.Value
 import Graphics.Text.Font.Choose.ObjectSet (ObjectSet, ObjectSet_, withObjectSet)
 import Data.Hashable (Hashable(..))
 import GHC.Generics (Generic)


@@ 23,6 23,11 @@ import Control.Monad (forM, join)
 import Data.Maybe (catMaybes)
 import Control.Exception (bracket)
 
+-- Imported for CSS bindings
+import Data.CSS.Syntax.Tokens (Token(..))
+import Data.Text (unpack)
+import Stylist (PropertyParser(..))
+
 type Pattern = [(String, [(Binding, Value)])]
 data Binding = Strong | Weak | Same deriving (Eq, Ord, Enum, Show, Generic)
 


@@ 31,6 36,12 @@ 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)
+
 normalizePattern :: Pattern -> Pattern
 normalizePattern pat =
     [(key, [val | (key', vals) <- pat, key' == key, val <- vals]) | key <- nub $ map fst pat]


@@ 147,3 158,26 @@ thawPattern_ cb = bracket (throwNull <$> cb) fcPatternDestroy thawPattern
 withNewPattern cb = bracket (throwNull <$> fcPatternCreate) fcPatternDestroy cb
 foreign import ccall "FcPatternCreate" fcPatternCreate :: IO Pattern_
 foreign import ccall "FcPatternDestroy" fcPatternDestroy :: Pattern_ -> IO ()
+
+------
+--- Pattern
+------
+
+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
+    in (unpack font:fonts, b, tail')
+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
+
+instance PropertyParser Pattern where
+    temp = []
+
+    longhand _ self "font-family" toks
+        | (fonts, True, []) <- parseFontFamily toks = adds "family" Strong fonts self
+    longhand _ _ _ _ = Nothing

@@ 1,6 1,6 @@
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveGeneric, TypeSynonymInstances, FlexibleInstances #-}
 module Graphics.Text.Font.Choose.Value (Value(..), Value_, withValue, thawValue,
-    value'Size) where
+    value'Size, ToValue(..)) where
 
 import Linear.Matrix (M22)
 import Linear.V2 (V2(..))


@@ 32,6 32,30 @@ data Value = ValueVoid
 
 instance Hashable Value
 
+class ToValue x where
+    toValue :: x -> Value
+
+instance ToValue () where
+    toValue () = ValueVoid
+instance ToValue Int where
+    toValue = ValueInt
+instance ToValue Double where
+    toValue = ValueDouble
+instance ToValue String where
+    toValue = ValueString
+instance ToValue Bool where
+    toValue = ValueBool
+instance ToValue (M22 Double) where
+    toValue = ValueMatrix
+instance ToValue CharSet where
+    toValue = ValueCharSet
+instance ToValue FT_Face where
+    toValue = ValueFTFace
+instance ToValue LangSet where
+    toValue = ValueLangSet
+instance ToValue Range where
+    toValue = ValueRange
+
 ------
 --- Low-level
 ------

@@ 70,7 70,8 @@ library
   -- Other library packages from which modules are imported.
   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
+                        hashable >= 1.3 && <2,
+                        css-syntax, text, stylist-traits >= 0.1.1 && < 1
 
   pkgconfig-depends:    fontconfig