~alcinnz/CatTrap

ref: 18b54a4e3965573a2106ae1c30a6e7b9004490cd CatTrap/Graphics/Layout/CSS/Length.hs -rw-r--r-- 3.0 KiB
18b54a4e — Adrian Cochrane Fix type error, confusing paddedboxes for borders. 1 year, 7 months ago
                                                                                
ed7d0445 Adrian Cochrane
d11d3168 Adrian Cochrane
ed7d0445 Adrian Cochrane
a226a881 Adrian Cochrane
ed7d0445 Adrian Cochrane
7beb4828 Adrian Cochrane
a226a881 Adrian Cochrane
7beb4828 Adrian Cochrane
d379817e Adrian Cochrane
ed7d0445 Adrian Cochrane
d379817e Adrian Cochrane
ed7d0445 Adrian Cochrane
7beb4828 Adrian Cochrane
d379817e Adrian Cochrane
86d19fc3 Adrian Cochrane
d379817e Adrian Cochrane
86d19fc3 Adrian Cochrane
7beb4828 Adrian Cochrane
6099cfd9 Adrian Cochrane
86d19fc3 Adrian Cochrane
7beb4828 Adrian Cochrane
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
{-# LANGUAGE OverloadedStrings #-}
module Graphics.Layout.CSS.Length(Unitted, auto, parseLength, parseLength',
        n2f, finalizeLength, px2pt, Font'(..)) where

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

import Graphics.Layout.Box

type Unitted = (Double, Txt.Text)
auto :: Unitted
auto = (0,"auto")

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 [Ident "auto"] = Just (0,"auto")
parseLength [Ident "initial"] = Just (0,"auto")
parseLength _ = Nothing
parseLength' [Ident "min-content"] = Just (0,"min-content")
parseLength' [Ident "max-content"] = Just (0,"max-content")
parseLength' toks = parseLength toks

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

n2f (NVInteger x) = realToFrac x
n2f (NVNumber x) = toRealFloat x

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,"vw") f = Pixels $ x*vw f
finalizeLength (x,"vmax") f = Percent $ x*vmax f
finalizeLength (x,"vmin") f = Percent $ 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
px2pt f x = x / scale f / 96 * 72

data Font' = Font' {
    hbFont :: Font,
    pattern :: Pattern,
    fontHeight :: Char -> Double,
    fontAdvance :: Char -> Double,
    fontSize :: Double,
    rootEm :: Double,
    lineheight :: Double,
    rlh :: Double,
    vh :: Double,
    vw :: Double,
    vmax :: Double,
    vmin :: Double,
    scale :: Double
}