From d6a3c66265f75e969a3b7b2f0482fbe286cd5d9c Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Mon, 6 May 2024 13:58:47 +1200 Subject: [PATCH] Integrate fontsets with Haskell Stylist. --- lib/Graphics/Text/Font/Choose/FontSet.hs | 46 +++++++++++++++--------- lib/Graphics/Text/Font/Choose/Value.hs | 5 ++- 2 files changed, 34 insertions(+), 17 deletions(-) diff --git a/lib/Graphics/Text/Font/Choose/FontSet.hs b/lib/Graphics/Text/Font/Choose/FontSet.hs index d0d86fc..006aa3f 100644 --- a/lib/Graphics/Text/Font/Choose/FontSet.hs +++ b/lib/Graphics/Text/Font/Choose/FontSet.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CApiFFI #-} +{-# LANGUAGE CApiFFI, OverloadedStrings #-} module Graphics.Text.Font.Choose.FontSet where import Graphics.Text.Font.Choose.Pattern @@ -11,6 +11,16 @@ import Foreign.C.String (CString) import Foreign.Ptr (Ptr) import Data.MessagePack (MessagePack) +import Stylist (StyleSheet(..)) +import Stylist.Parse (parseProperties) +import Data.CSS.Syntax.Tokens (Token(..), serialize) +import Data.Text (Text, unpack) +import qualified Data.Map as M +import Data.List (intercalate) + +import Graphics.Text.Font.Choose.Range (iRange) +import Graphics.Text.Font.Choose.Value (ToValue(..), Value) + type FontSet = [Pattern] fontSetList :: Config -> [FontSet] -> Pattern -> ObjectSet -> FontSet @@ -47,7 +57,8 @@ arg = flip withMessage -- | `StyleSheet` wrapper to parse @font-face rules. data FontFaceParser a = FontFaceParser { cssFonts :: FontSet, cssInner :: a} -{- parseFontFaceSrc (Function "local":Ident name:RightParen:Comma:rest) = +parseFontFaceSrc :: [Token] -> [String] +parseFontFaceSrc (Function "local":Ident name:RightParen:Comma:rest) = ("local:" ++ unpack name):parseFontFaceSrc rest parseFontFaceSrc (Function "local":String name:RightParen:Comma:rest) = ("local:" ++ unpack name):parseFontFaceSrc rest @@ -63,55 +74,58 @@ parseFontFaceSrc (Url link:toks) skipMeta (Function "format":String _:RightParen:rest) = skipMeta rest skipMeta (Function "tech":Ident _:RightParen:rest) = skipMeta rest skipMeta (Function "tech":String _:RightParen:rest) = skipMeta rest - skipMeta toks = toks + skipMeta toks' = toks' parseFontFaceSrc _ = [""] +v :: ToValue x => x -> Value +v = toValue + properties2font :: [(Text, [Token])] -> Pattern properties2font (("font-family", [String font]):props) = - setValue "family" Strong (unpack font) $ properties2font props + M.insert "family" [(Strong, v $ unpack font)] $ properties2font props properties2font (("font-family", [Ident font]):props) = - setValue "family" Strong (unpack font) $ properties2font props + M.insert "family" [(Strong, v $ unpack font)] $ properties2font props properties2font (("font-stretch", [tok]):props) | Just x <- parseFontStretch tok = - setValue "width" Strong x $ properties2font props + M.insert "width" [(Strong, v x)] $ properties2font props properties2font (("font-stretch", [start, end]):props) | Just x <- parseFontStretch start, Just y <- parseFontStretch end = - setValue "width" Strong (x `iRange` y) $ properties2font props + M.insert "width" [(Strong, v $ iRange x y)] $ properties2font props properties2font (("font-weight", [tok]):props) | Just x <- parseFontWeight tok = - setValue "width" Strong x $ properties2font props + M.insert "width" [(Strong, v x)] $ properties2font props properties2font (("font-weight", [start, end]):props) | Just x <- parseFontStretch start, Just y <- parseFontStretch end = - setValue "weight" Strong (x `iRange` y) $ properties2font props + M.insert "weight" [(Strong, v $ iRange x y)] $ properties2font props properties2font (("font-feature-settings", toks):props) | (features, True, []) <- parseFontFeatures toks = - setValue "fontfeatures" Strong (intercalate "," $ map fst features) $ + M.insert "fontfeatures" [(Strong, v $ intercalate "," $ map fst features)] $ properties2font props properties2font (("font-variation-settings", toks):props) | (_, True, []) <- parseFontVars toks = - setValue "variable" Strong True $ properties2font props + M.insert "variable" [(Strong, v $ True)] $ properties2font props properties2font (("unicode-range", toks):props) | Just chars <- parseCharSet $ unpack $ serialize toks = - setValue "charset" Strong chars $ properties2font props + M.insert "charset" [(Strong, v $ CharSet' chars)] $ properties2font props -- Ignoring metadata & trusting in FreeType's broad support for fonts. properties2font (("src", toks):props) | fonts@(_:_) <- parseFontFaceSrc toks, "" `notElem` fonts = - setValue "web-src" Strong (intercalate "\t" fonts) $ properties2font props + M.insert "web-src" [(Strong, v $ intercalate "\t" fonts)] $ properties2font props properties2font (_:props) = properties2font props -properties2font [] = [] +properties2font [] = M.empty instance StyleSheet a => StyleSheet (FontFaceParser a) where - setPriorities v (FontFaceParser x self) = FontFaceParser x $ setPriorities v self + setPriorities prio (FontFaceParser x self) = FontFaceParser x $ setPriorities prio self addRule (FontFaceParser x self) rule = FontFaceParser x $ addRule self rule 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) -} + let (a, b) = addAtRule self key toks in (FontFaceParser x a, b) diff --git a/lib/Graphics/Text/Font/Choose/Value.hs b/lib/Graphics/Text/Font/Choose/Value.hs index 2a4e391..c518692 100644 --- a/lib/Graphics/Text/Font/Choose/Value.hs +++ b/lib/Graphics/Text/Font/Choose/Value.hs @@ -94,4 +94,7 @@ instance ToValue LangSet' where toValue = ValueLangSet . unLangSet fromValue (ValueLangSet x) = Just $ LangSet' x fromValue _ = Nothing - +instance ToValue Range where + toValue = ValueRange + fromValue (ValueRange x) = Just x + fromValue _ = Nothing -- 2.30.2