~alcinnz/fontconfig-pure

ref: 35586a37128df60a71044132e409ccaede29c5b9 fontconfig-pure/lib/Graphics/Text/Font/Choose/FontSet.hs -rw-r--r-- 3.6 KiB
35586a37 — Adrian Cochrane Encode & decode charsets on C side (fix Haskell side) 10 months ago 
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
module Graphics.Text.Font.Choose.FontSet where

import Graphics.Text.Font.Choose.Pattern

type FontSet = [Pattern']

------
--- CSS Bindings
------

-- | `StyleSheet` wrapper to parse @font-face rules.
data FontFaceParser a = FontFaceParser { cssFonts :: FontSet, cssInner :: a}

{- 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
parseFontFaceSrc (Function "local":Ident name:RightParen:[]) = ["local:" ++ unpack name]
parseFontFaceSrc (Function "local":String name:RightParen:[]) = ["local:" ++ unpack name]

parseFontFaceSrc (Url link:toks)
    | Comma:rest <- skipMeta toks = unpack link:parseFontFaceSrc rest
    | [] <- skipMeta toks = [unpack link]
    | otherwise = [""] -- Error indicator!
  where
    skipMeta (Function "format":Ident _:RightParen:rest) = skipMeta rest
    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

parseFontFaceSrc _ = [""]

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 (("font-stretch", [tok]):props) | Just x <- parseFontStretch tok =
    setValue "width" Strong 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

properties2font (("font-weight", [tok]):props) | Just x <- parseFontWeight tok =
    setValue "width" Strong 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

properties2font (("font-feature-settings", toks):props)
    | (features, True, []) <- parseFontFeatures toks =
        setValue "fontfeatures" Strong (intercalate "," $ map fst features) $
            properties2font props

properties2font (("font-variation-settings", toks):props)
    | (_, True, []) <- parseFontVars toks =
        setValue "variable" Strong True $ properties2font props

properties2font (("unicode-range", toks):props)
    | Just chars <- parseCharSet $ unpack $ serialize toks =
        setValue "charset" Strong 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

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 (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) -}