From 878b65cdbdd47160658408033f718109267f0c57 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Thu, 1 Dec 2022 20:51:50 +1300 Subject: [PATCH] Implement @font-face 'font-family' property. --- Graphics/Text/Font/Choose/FontSet.hs | 16 ++++++++++++++-- Graphics/Text/Font/Choose/Pattern.hs | 4 +++- 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/Graphics/Text/Font/Choose/FontSet.hs b/Graphics/Text/Font/Choose/FontSet.hs index 102d7a0..550f34a 100644 --- a/Graphics/Text/Font/Choose/FontSet.hs +++ b/Graphics/Text/Font/Choose/FontSet.hs @@ -13,6 +13,8 @@ import Control.Exception (bracket) -- For CSS bindings import Stylist.Parse (StyleSheet(..), parseProperties) +import Data.CSS.Syntax.Tokens (Token(..)) +import Data.Text (unpack, Text) type FontSet = [Pattern] @@ -66,11 +68,21 @@ thawFontSet_ cb = bracket (throwNull <$> cb) fcFontSetDestroy thawFontSet data FontFaceParser a = FontFaceParser { cssFonts :: FontSet, cssInner :: a} +properties2font :: [(Text, [Token])] -> Pattern +properties2font (("font-family", [String font]):props) = + setValue "family" Strong (unpack font) $ properties2font props +properties2font (("font-family", [Ident font]):props) = + setValue "family" Strong (unpack font) $ properties2font props + +properties2font (_:props) = properties2font props +properties2font [] = [] + instance StyleSheet a => StyleSheet (FontFaceParser a) where setPriorities v (FontFaceParser x self) = FontFaceParser x $ setPriorities v self addRule (FontFaceParser x self) rule = FontFaceParser x $ addRule self rule - addAtRule self "font-face" toks = - let (props, toks') = parseProperties toks in (self, toks') + addAtRule (FontFaceParser fonts self) "font-face" toks = + let ((props, _), toks') = parseProperties toks + in (FontFaceParser (properties2font props:fonts) self, toks') addAtRule (FontFaceParser x self) key toks = let (a, b) = addAtRule self key toks in (FontFaceParser x a, b) diff --git a/Graphics/Text/Font/Choose/Pattern.hs b/Graphics/Text/Font/Choose/Pattern.hs index 8c9885e..f69122e 100644 --- a/Graphics/Text/Font/Choose/Pattern.hs +++ b/Graphics/Text/Font/Choose/Pattern.hs @@ -1,7 +1,9 @@ {-# 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 + Pattern_, withPattern, thawPattern, thawPattern_, patternAsPointer, + + setValue, setValues, unset) where import Prelude hiding (filter) import Data.List (nub) -- 2.30.2