@@ 1,7 1,7 @@
{-# LANGUAGE CApiFFI, OverloadedStrings #-}
-- | A set of fonts to query, or resulting from a query.
module Graphics.Text.Font.Choose.FontSet(
- FontSet, validFontSet, fontSetList, fontSetMatch, fontSetSort, FontFaceParser(..)
+ FontSet, validFontSet, fontSetList, fontSetMatch, fontSetSort, FontFaceParser(..), emptyParser
) where
import Graphics.Text.Font.Choose.Pattern hiding (map)
@@ 18,6 18,7 @@ import Stylist (StyleSheet(..))
import Stylist.Parse (parseProperties)
import Data.CSS.Syntax.Tokens (Token(..), serialize)
import Data.Text (Text, unpack)
+import qualified Data.Text as Txt
import qualified Data.Map as M
import Data.List (intercalate)
@@ 81,6 82,9 @@ arg = flip withMessage
-- | `StyleSheet` wrapper to parse @font-face rules.
data FontFaceParser a = FontFaceParser { cssFonts :: FontSet, cssInner :: a}
+emptyParser :: a -> FontFaceParser a
+emptyParser = FontFaceParser []
+
parseFontFaceSrc :: [Token] -> [String]
parseFontFaceSrc (Function "local":Ident name:RightParen:Comma:rest) =
("local:" ++ unpack name):parseFontFaceSrc rest
@@ 89,6 93,9 @@ parseFontFaceSrc (Function "local":String name:RightParen:Comma:rest) =
parseFontFaceSrc (Function "local":Ident name:RightParen:[]) = ["local:" ++ unpack name]
parseFontFaceSrc (Function "local":String name:RightParen:[]) = ["local:" ++ unpack name]
+parseFontFaceSrc (Function "url":String link:RightParen:toks) =
+ parseFontFaceSrc (Url link:toks) -- TODO: Why's this needed?
+
parseFontFaceSrc (Url link:toks)
| Comma:rest <- skipMeta toks = unpack link:parseFontFaceSrc rest
| [] <- skipMeta toks = [unpack link]
@@ 118,7 125,7 @@ properties2font (("font-stretch", [start, end]):props)
M.insert "width" [(Strong, v $ iRange x y)] $ properties2font props
properties2font (("font-weight", [tok]):props) | Just x <- parseFontWeight tok =
- M.insert "width" [(Strong, v x)] $ properties2font props
+ M.insert "weight" [(Strong, v x)] $ properties2font props
properties2font (("font-weight", [start, end]):props)
| Just x <- parseFontStretch start, Just y <- parseFontStretch end =
M.insert "weight" [(Strong, v $ iRange x y)] $ properties2font props
@@ 133,13 140,13 @@ properties2font (("font-variation-settings", toks):props)
M.insert "variable" [(Strong, v $ True)] $ properties2font props
properties2font (("unicode-range", toks):props)
- | Just chars <- parseCharSet $ unpack $ serialize toks =
+ | Just chars <- parseCharSet $ unpack $ Txt.replace "/**/" "" $ serialize toks =
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 =
- M.insert "web-src" [(Strong, v $ intercalate "\t" fonts)] $ properties2font props
+ M.insert "web-src" [(Strong, v f) | f <- fonts] $ properties2font props
properties2font (_:props) = properties2font props
properties2font [] = M.empty
@@ 19,6 19,7 @@ import Graphics.Text.Font.Choose.Internal.Test
import qualified Graphics.Text.Font.Choose.Pattern as Pat
import Data.CSS.Syntax.Tokens (Token(..), NumericValue(NVInteger), tokenize)
import Stylist (PropertyParser(..))
+import qualified Stylist.Parse as CSS
main :: IO ()
main = hspec $ do
@@ 337,4 338,104 @@ main = hspec $ do
("width",[(Strong,ValueInt 100)])
]
it "@font-face" $ do
- "I'm procrastinating this" `shouldBe` "I'm procrastinating this"
+ let tRule = cssFonts . CSS.parse (emptyParser ())
+ let tRule' = tRule . Txt.unlines
+ let list2pat = M.fromList
+ tRule "" `shouldBe` []
+ tRule "@font-face {font-family: OpenSans}" `shouldBe` [list2pat [
+ ("family", [(Strong, ValueString "OpenSans")])
+ ]]
+ tRule "@font-face {font-family: 'Open Sans'}" `shouldBe` [list2pat [
+ ("family", [(Strong, ValueString "Open Sans")])
+ ]]
+
+ tRule "@font-face {font-stretch: condensed}" `shouldBe` [list2pat [
+ ("width", [(Strong, ValueInt 75)])
+ ]]
+ tRule "@font-face {font-stretch: expanded}" `shouldBe` [list2pat [
+ ("width", [(Strong, ValueInt 125)])
+ ]]
+ tRule "@font-face {font-stretch: ultra-expanded}" `shouldBe` [list2pat [
+ ("width", [(Strong, ValueInt 200)])
+ ]]
+ tRule "@font-face {font-stretch: 50%}" `shouldBe` [list2pat [
+ ("width", [(Strong, ValueInt 50)])
+ ]]
+ tRule "@font-face {font-stretch: 100%}" `shouldBe` [list2pat [
+ ("width", [(Strong, ValueInt 100)])
+ ]]
+ tRule "@font-face {font-stretch: 150%}" `shouldBe` [list2pat [
+ ("width", [(Strong, ValueInt 150)])
+ ]]
+
+ tRule "@font-face {font-weight: normal}" `shouldBe` [list2pat [
+ ("weight", [(Strong, ValueInt 80)])
+ ]]
+ tRule "@font-face {font-weight: bold}" `shouldBe` [list2pat [
+ ("weight", [(Strong, ValueInt 200)])
+ ]]
+ tRule "@font-face {font-weight: 100}" `shouldBe` [list2pat [
+ ("weight", [(Strong, ValueInt 0)])
+ ]]
+ tRule "@font-face {font-weight: 900}" `shouldBe` [list2pat [
+ ("weight", [(Strong, ValueInt 210)])
+ ]]
+
+ tRule "@font-face {font-feature-settings: normal}" `shouldBe` [list2pat []]
+ tRule "@font-face {font-feature-settings: \"liga\" 0}" `shouldBe` [list2pat [
+ ("fontfeatures", [(Strong, ValueString "liga")])
+ ]]
+ tRule "@font-face {font-feature-settings: \"tnum\"}" `shouldBe` [list2pat [
+ ("fontfeatures", [(Strong, ValueString "tnum")])
+ ]]
+ tRule "@font-face {font-feature-settings: \"smcp\", \"zero\"}" `shouldBe` [list2pat [
+ ("fontfeatures", [
+ (Strong, ValueString "smcp,zero") -- Is this right?
+ ])
+ ]]
+
+ tRule "@font-face {font-variation-settings: 'wght' 50}" `shouldBe` [list2pat [
+ ("variable", [(Strong, ValueBool True)])
+ ]]
+ tRule "@font-face {font-variation-settings: 'wght' 850}" `shouldBe` [list2pat [
+ ("variable", [(Strong, ValueBool True)])
+ ]]
+ tRule "@font-face {font-variation-settings: 'wdth' 25}" `shouldBe` [list2pat [
+ ("variable", [(Strong, ValueBool True)])
+ ]]
+ tRule "@font-face {font-variation-settings: 'wdth' 75}" `shouldBe` [list2pat [
+ ("variable", [(Strong, ValueBool True)])
+ ]]
+
+ tRule "@font-face {unicode-range: U+26}" `shouldBe` [list2pat [
+ ("charset", [(Strong, ValueCharSet $ IS.fromList [0x26])])
+ ]]
+ tRule "@font-face {unicode-range: U+0-7F}" `shouldBe` [list2pat [
+ ("charset", [(Strong, ValueCharSet $ IS.fromList [0..0x7f])])
+ ]]
+ tRule "@font-face {unicode-range: U+0025-00FF}" `shouldBe` [list2pat [
+ ("charset", [(Strong, ValueCharSet $ IS.fromList [0x25..0xff])])
+ ]]
+ tRule "@font-face {unicode-range: U+4??}" `shouldBe` [list2pat [
+ ("charset", [(Strong, ValueCharSet $ IS.fromList [0x400..0x4ff])])
+ ]]
+ tRule "@font-face {unicode-range: U+0025-00FF, U+4??}" `shouldBe` [list2pat [
+ ("charset", [(Strong, ValueCharSet $ IS.fromList ([0x25..0xff] ++ [0x400..0x4ff]))])
+ ]]
+
+ tRule' [
+ "@font-face {",
+ " font-family: \"Trickster\";",
+ " src:",
+ " local(\"Trickster\"),",
+ " url(\"trickster-COLRv1.otf\") format(\"opentype\") tech(color-COLRv1),",
+ " url(\"trickster-outline.otf\") format(\"opentype\"),",
+ " url(\"trickster-outline.woff\") format(\"woff\");",
+ "}"
+ ] `shouldBe` [list2pat [
+ ("family", [(Strong, ValueString "Trickster")]),
+ ("web-src", [(Strong, ValueString "local:Trickster"),
+ (Strong, ValueString "trickster-COLRv1.otf"),
+ (Strong, ValueString "trickster-outline.otf"),
+ (Strong, ValueString "trickster-outline.woff")])
+ ]]