~alcinnz/CatTrap

CatTrap/Graphics/Layout/CSS/Length.hs -rw-r--r-- 5.3 KiB
8e7be851 — Adrian Cochrane Release 0.6! a month 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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
-- | Infrastructure for parsing & desugaring length units & keywords,
-- in reference to the selected font.
module Graphics.Layout.CSS.Length(Unitted, auto, parseLength, parseLength', units,
        n2f, finalizeLength, finalizeLengths, px2pt, Font'(..)) where

import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import qualified Data.Text as Txt
import Data.Scientific (toRealFloat, fromFloatDigits)
import Debug.Trace (trace) -- For warnings.
import Data.Text.Glyphize (Font)
import Graphics.Text.Font.Choose (Pattern(..))

import Graphics.Layout.Box

-- | A number+unit, prior to resolving side units.
-- The unit may alternately represent a keyword, in which case the number is
-- ignored & typically set to 0.
type Unitted = (Double, Txt.Text)
instance Zero Unitted where zero = (0,"px")
-- | The CSS `auto` keyword.
auto :: Unitted
auto = (0,"auto")

-- | Parse a pre-tokenized CSS length value.
parseLength :: [Token] -> Maybe Unitted
parseLength [Percentage _ x] = Just (n2f x,"%")
parseLength [Dimension _ x unit]
    | n2f x == 0 && unit == "" = Just (0,"px")
    | unit `elem` units = Just (n2f x,unit)
parseLength [Number _ x] | n2f x == 0 = Just (0,"px")
parseLength [Ident "auto"] = Just (0,"auto")
parseLength [Ident "initial"] = Just (0,"auto")
parseLength _ = Nothing
-- | Variant of `parseLength` which supports min-content & max-content keywords.
parseLength' [Ident "min-content"] = Just (0,"min-content")
parseLength' [Ident "max-content"] = Just (0,"max-content")
parseLength' toks = parseLength toks

-- | Supported length units.
units = Txt.words "cap ch em ex ic lh rem rlh vh vw vmax vmin px cm mm Q in pc pt %"

-- | Convert a lexed number to a Double.
n2f :: (Fractional x, RealFloat x) => NumericValue -> x
n2f (NVInteger x) = realToFrac x
n2f (NVNumber x) = toRealFloat x

-- | Resolve a parsed length according to the sizing parameters in a given `Font'`.
finalizeLength :: Unitted -> Font' -> Length
finalizeLength (x,"cap") f = Pixels $ x*fontHeight f 'A'
finalizeLength (x,"ch") f = Pixels $ x*fontAdvance f '0'
finalizeLength (x,"em") f = Pixels $ x*fontSize f
finalizeLength (x,"") f = Pixels $ x*fontSize f -- For line-height.
finalizeLength (x,"ex") f = Pixels $ x*fontHeight f 'x'
finalizeLength (x,"ic") f = Pixels $ x*fontHeight f '水' -- CJK water ideograph
finalizeLength (x,"lh") f = Pixels $ x*lineheight f
finalizeLength (x,"rem") f = Pixels $ x*rootEm f
finalizeLength (x,"rlh") f = Pixels $ x*rlh f
finalizeLength (x,"vh") f = Pixels $ x*vh f
finalizeLength (x,"vb") f = Pixels $ x*vh f -- TODO: Support vertical text
finalizeLength (x,"vw") f = Pixels $ x*vw f
finalizeLength (x,"vi") f = Pixels $ x*vw f -- TODO: Support vertical text
finalizeLength (x,"vmax") f = Pixels $ x*vmax f
finalizeLength (x,"vmin") f = Pixels $ x*vmin f
finalizeLength (x,"px") f = Pixels $ x*scale f
finalizeLength (x,"cm") f = Pixels $ x*scale f*96/2.54
finalizeLength (x,"in") f = Pixels $ x*96*scale f
finalizeLength (x,"mm") f | Pixels x' <- finalizeLength (x,"cm") f = Pixels $ x'/10
finalizeLength (x,"Q") f | Pixels x' <- finalizeLength (x,"cm") f = Pixels $ x'/40
finalizeLength (x,"pc") f | Pixels x' <- finalizeLength (x,"in") f = Pixels $ x'/6
finalizeLength (x,"pt") f | Pixels x' <- finalizeLength (x,"in") f = Pixels $ x'/72
finalizeLength (x,"%") _ = Percent $ x/100
finalizeLength (_,"auto") _ = Auto
finalizeLength (_,"min-content") _ = Min
finalizeLength (_,"max-content") _ = Preferred
finalizeLength (x, " ") _ = Pixels x -- Internal constant value...
finalizeLength (_,unit) _ = trace ("Invalid unit " ++ Txt.unpack unit) $ Pixels 0
-- | Convert from a computed length to the "pt" unit.
px2pt f x = x / scale f / 96 * 72

-- | Convert any length-units in the given CSS tokens to device pixels
finalizeLengths :: Font' -> [Token] -> [Token]
finalizeLengths f (Dimension _ x unit:toks)
    | unit `elem` units, Pixels y <- finalizeLength (n2f x,unit) f =
        Dimension "" (NVNumber $ fromFloatDigits y) "px":finalizeLengths f toks
finalizeLengths f (Number a b:ts)|n2f b==0=Dimension a b "px":finalizeLengths f ts
finalizeLengths f (tok:toks) = tok:finalizeLengths f toks
finalizeLengths _ [] = []

-- | A Harfbuzz font with sizing parameters.
data Font' = Font' {
    -- | The Harfbuzz font used to shape text & query character-size information.
    hbFont :: Font,
    -- | The FontConfig query result. Useful to incorporate into output rendering.
    pattern :: Pattern,
    -- | Query the height of a character.
    -- Used for cap, ex, or ic units.
    fontHeight :: Char -> Double,
    -- | Query the width of a character, used for ch unit.
    fontAdvance :: Char -> Double,
    -- | The desired font-size, used for em unit.
    fontSize :: Double,
    -- | The root font's size, used for rem unit.
    rootEm :: Double,
    -- | The desired line-height, used for lh unit.
    lineheight :: Double,
    -- | The root font's line-height, used for rlh unit.
    rlh :: Double,
    -- | Scale-factor for vh unit.
    vh :: Double,
    -- | Scale-factor for vw unit.
    vw :: Double,
    -- | Scale-factor for vmax unit.
    vmax :: Double,
    -- | Scale-factor for vmin unit.
    vmin :: Double,
    -- | How many device pixels in a CSS px?
    scale :: Double
}

instance Eq Font' where
    a == b = pattern a == pattern b
instance Show Font' where
    show a = show $ pattern a