~alcinnz/CatTrap

ref: ddee4bc6c63306443d5e5bb3b02b83383ff4509a CatTrap/Graphics/Layout/CSS/Length.hs -rw-r--r-- 3.0 KiB
ddee4bc6 — Adrian Cochrane Attempt to simplify generic height layout methods. 1 year, 6 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
}