~alcinnz/CatTrap

ref: 593bc796bb41157cb9a52bb8687e9f8cc1b6be9e CatTrap/Graphics/Layout/Box.hs -rw-r--r-- 3.7 KiB
593bc796 — Adrian Cochrane Add missing child traversal to maxwidth computation & simplify API signature. 1 year, 7 months ago
                                                                                
09970dfc Adrian Cochrane
ca995b39 Adrian Cochrane
aef40617 Adrian Cochrane
09970dfc Adrian Cochrane
272852e8 Adrian Cochrane
09970dfc Adrian Cochrane
4c05e6f6 Adrian Cochrane
eae2c200 Adrian Cochrane
b47a0b46 Adrian Cochrane
09970dfc Adrian Cochrane
272852e8 Adrian Cochrane
09970dfc Adrian Cochrane
c06fd552 Adrian Cochrane
b47a0b46 Adrian Cochrane
c06fd552 Adrian Cochrane
272852e8 Adrian Cochrane
09970dfc Adrian Cochrane
272852e8 Adrian Cochrane
09970dfc Adrian Cochrane
272852e8 Adrian Cochrane
c06fd552 Adrian Cochrane
09970dfc Adrian Cochrane
c06fd552 Adrian Cochrane
6d1a719d Adrian Cochrane
b47a0b46 Adrian Cochrane
15ad59db Adrian Cochrane
b47a0b46 Adrian Cochrane
9b5c291c 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
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
{-# LANGUAGE RecordWildCards #-}
module Graphics.Layout.Box(Border(..), mapX, mapY,
        Size(..), mapSizeX, mapSizeY,
        PaddedBox(..), zeroBox, lengthBox, mapX', mapY',
        width, height, minWidth, minHeight, maxWidth, maxHeight,
        Length(..), mapAuto, lowerLength, Zero(..), CastDouble(..)) where

data Border m n = Border {
    top :: m, bottom :: m, left :: n, right :: n
}
mapX :: (n -> nn) -> Border m n -> Border m nn
mapY :: (m -> mm) -> Border m n -> Border mm n
mapX cb self = self { left = cb $ left self, right = cb $ right self }
mapY cb self = self { top = cb $ top self, bottom = cb $ bottom self }

data Size m n = Size {inline :: n, block :: m} deriving (Eq, Show)
mapSizeY cb self = Size (inline self) (cb $ block self)
mapSizeX cb self = Size (cb $ inline self) (block self)

data PaddedBox m n = PaddedBox {
    min :: Size m n,
    max :: Size m n,
    size :: Size m n,
    padding :: Border m n,
    border :: Border m n,
    margin :: Border m n
}
zeroBox :: PaddedBox Double Double
zeroBox = PaddedBox {
    min = Size 0 0,
    max = Size 0 0,
    size = Size 0 0,
    padding = Border 0 0 0 0,
    border = Border 0 0 0 0,
    margin = Border 0 0 0 0
  }
lengthBox = PaddedBox {
    min = Size Auto Auto,
    max = Size Auto Auto,
    size = Size Auto Auto,
    padding = Border zero zero zero zero,
    border = Border zero zero zero zero,
    margin = Border zero zero zero zero
  }

mapX' :: (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' cb PaddedBox {..} = PaddedBox {
    min = Size (cb $ inline min) (block min),
    size = Size (cb $ inline size) (block size),
    max = Size (cb $ inline max) (block max),
    padding = mapX cb padding,
    border = mapX cb border,
    margin = mapX cb margin
  }
mapY' :: (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' cb PaddedBox {..} = PaddedBox {
    min = Size (inline min) (cb $ block min),
    size = Size (inline size) (cb $ block size),
    max = Size (inline max) (cb $ block max),
    padding = mapY cb padding,
    border = mapY cb border,
    margin = mapY cb margin
  }

width PaddedBox {..} = left margin + left border + left padding +
    inline size + right padding + right border + right margin
height PaddedBox {..} = top margin + top border + top padding +
    block size + bottom padding + bottom border + bottom margin
minWidth PaddedBox {..} = left margin + left border + left padding +
    inline min + right padding + right border + right margin
minHeight PaddedBox {..} = top margin + top border + top padding +
    block min + bottom padding + bottom border + bottom margin
maxWidth PaddedBox {..} = left margin + left border + left padding +
    inline max + right padding + right border + right margin
maxHeight PaddedBox {..} = top margin + top border + top padding +
    block max + bottom padding + bottom border + bottom margin

data Length = Pixels Double | Percent Double | Auto | Preferred | Min deriving Eq

lowerLength :: Double -> Length -> Double
lowerLength _ (Pixels x) = x
lowerLength outerwidth (Percent x) = x * outerwidth
lowerLength _ _ = 0

mapAuto x Auto = Pixels x
mapAuto x Preferred = Pixels x
mapAuto x Min = Pixels x
mapAuto _ x = x

class Zero a where
    zero :: a

instance Zero Double where zero = 0
instance Zero Length where zero = Pixels 0
instance (Zero m, Zero n) => Zero (PaddedBox m n) where
    zero = PaddedBox {
        min = Size zero zero,
        max = Size zero zero,
        size = Size zero zero,
    padding = Border zero zero zero zero,
    border = Border zero zero zero zero,
    margin = Border zero zero zero zero
    }

class CastDouble a where
    fromDouble :: Double -> a

instance CastDouble Double where fromDouble = id
instance CastDouble Length where fromDouble = Pixels