~alcinnz/CatTrap

ref: 711248ffd5f52dfb2922991171ba472ef80d479f CatTrap/Graphics/Layout/CSS/Length.hs -rw-r--r-- 3.0 KiB
711248ff — Adrian Cochrane Merge branch 'main' of git.argonaut-constellation.org:~alcinnz/CatTrap 1 year, 3 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
}