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
125
126
127
128
129
130
module Graphics.Layout.Flow where
import Graphics.Layout.Box as B
flowMinWidth :: Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double
flowMinWidth _ PaddedBox {B.min = Size (Pixels x) _} _ = x
flowMinWidth parent PaddedBox {B.min = Size (Percent x) _} _ = x * parent
flowMinWidth parent self@PaddedBox {B.min = Size Preferred _} childs =
flowNatWidth parent self childs
flowMinWidth _ _ childs = maximum $ (0:) $ map minWidth childs
flowNatWidth :: Double -> PaddedBox a Length -> [PaddedBox b Double] -> Double
flowNatWidth _ PaddedBox {size = Size (Pixels x) _} _ = x
flowNatWidth parent PaddedBox {size = Size (Percent x) _} _ = x * parent
flowNatWidth parent self@PaddedBox {size = Size Min _, B.min = Size x _} childs
-- Avoid infinite loops!
| x /= Preferred = flowMinWidth parent self childs
flowNatWidth parent _ childs = maximum $ (0:) $ map maxWidth childs
flowMaxWidth :: PaddedBox a Double -> PaddedBox b Length -> Double
flowMaxWidth _ PaddedBox {B.max = Size (Pixels x) _} = x
flowMaxWidth parent PaddedBox {B.max = Size (Percent x) _} = x * (inline $ size parent)
flowMaxWidth parent self@PaddedBox {B.max = Size Auto _} = inline (size parent) - ws
where
ws = l2d (left $ margin self) + l2d (left $ border self) + l2d (left $ padding self) +
l2d (right $ padding self) + l2d (right $ border self) + l2d (right $ margin self)
l2d = lowerLength $ inline $ size parent
flowMaxWidth parent self@PaddedBox {B.max = Size Preferred _} =
flowNatWidth (inline $ size parent) self []
flowMaxWidth parent self@PaddedBox {B.max = Size Min _} =
flowMinWidth (inline $ B.min parent) self []
flowWidth :: PaddedBox a Double -> PaddedBox b Length -> Double
flowWidth parent self
| small > large = small
| natural > large = large
| inline (size self) == Auto = large -- specialcase
| natural >= small = natural
| otherwise = small
where
small = flowMinWidth (inline $ B.min parent) self []
natural = flowNatWidth (inline $ size parent) self []
large = flowMaxWidth parent self
flowNatHeight :: Double -> PaddedBox Length Double -> [PaddedBox Double Double] -> Double
flowNatHeight _ PaddedBox {size = Size _ (Pixels y)} _ = y
flowNatHeight parent PaddedBox {size = Size _ (Percent y)} _ = y * parent
flowNatHeight _ PaddedBox {size = Size _ Min} childs =
sum $ map minHeight $ marginCollapse childs
flowNatHeight _ PaddedBox {size = Size owidth _} childs =
sum $ map height $ marginCollapse childs
flowMinHeight :: Double -> PaddedBox Length Double -> Double
flowMinHeight _ PaddedBox {B.min = Size _ (Pixels y)} = y
flowMinHeight parent PaddedBox {B.min = Size _ (Percent y)} = y * parent
flowMinHeight parent self = flowNatHeight parent self []
flowMaxHeight :: Double -> PaddedBox Length Double -> Double
flowMaxHeight _ PaddedBox {B.max = Size _ (Pixels y)} = y
flowMaxHeight parent PaddedBox {B.max = Size _ (Percent y)} = y * parent
flowMaxHeight parent PaddedBox {B.max = Size _ Auto} = parent
flowMaxHeight parent self@PaddedBox {B.max = Size _ Preferred} = flowNatHeight parent self []
flowMaxHeight parent self@PaddedBox {B.max = Size _ Min} = flowMinHeight parent self
flowHeight :: PaddedBox Double Double -> PaddedBox Length Double -> Double
flowHeight parent self
| small > large = small
| natural > large = large
| natural >= small = natural
| otherwise = small
where
small = flowMinHeight (block $ B.min parent) self
natural = flowNatHeight (block $ size parent) self []
large = flowMaxHeight (block $ B.max parent) self
positionFlow :: [PaddedBox Double Double] -> [Size Double Double]
positionFlow childs = scanl inner (Size 0 0) $ marginCollapse childs
where inner (Size x y) self = Size x $ height self
layoutFlow :: PaddedBox Double Double -> PaddedBox Length Length ->
[PaddedBox Length Double] -> Bool ->
(PaddedBox Double Double, [(Size Double Double, PaddedBox Double Double)])
layoutFlow parent self childs paginate = (self', zip positions' childs')
where
positions' = positionFlow childs'
childs' = map layoutZooko childs
self' = self0 {
B.min = (B.min self0) { block = flowMinHeight (block $ B.min parent) self0 },
size = (size self0) { block = flowHeight parent self0 },
B.max = (B.max self0) { block = flowMaxHeight (block $ B.max parent) self0 },
padding = mapY (lowerLength owidth) $ padding self0,
border = mapY (lowerLength owidth) $ border self0,
margin = mapY (lowerLength owidth) $ margin self0
}
self0 = self1 {
size = (size self1) { block = Pixels $ flowNatHeight oheight self1 childs'}
}
self1 = self2 {
size = (size self2) { inline = width' },
B.max = (B.max self2) { inline = flowMaxWidth parent self2 },
B.min = (B.min self2) { inline = flowMinWidth owidth self2 [] },
padding = mapX (lowerLength owidth) $ padding self2,
border = mapX (lowerLength owidth) $ border self2,
margin = lowerMargin owidth (owidth - width') $ margin self2
}
width' = flowWidth parent self
self2 = self {
size = (size self) { inline = Pixels $ flowNatWidth owidth self childs },
B.min = (B.min self) { inline = Pixels $ flowMinWidth owidth self childs }
}
owidth = inline $ size parent
oheight = block $ size parent
layoutZooko child = child {
B.min = Size (inline $ B.min child) (flowMinHeight (block $ B.min self') child),
size = Size (inline $ size child) (flowHeight self' child),
B.max = Size (inline $ B.max child) (flowMaxHeight (block $ size self') child),
padding = mapY (lowerLength owidth) $ padding child,
border = mapY (lowerLength owidth) $ border child,
margin = mapY (lowerLength owidth) $ margin child
}
marginCollapse :: [PaddedBox Double n] -> [PaddedBox Double n]
marginCollapse (x'@PaddedBox {margin = xm@Border { bottom = x }}:
y'@PaddedBox {margin = ym@Border { top = y}}:rest)
| x > y = x':marginCollapse (y' {margin = ym { top = 0 }}:rest)
| otherwise = x' { margin = xm { bottom = 0 }}:marginCollapse (y':rest)
marginCollapse rest = rest
lowerMargin :: Double -> Double -> Border m Length -> Border m Double
lowerMargin _ available (Border top' bottom' Auto Auto) =
Border top' bottom' (available/2) (available/2)
lowerMargin outerwidth available (Border top' bottom' Auto right') =
Border top' bottom' available $ lowerLength outerwidth right'
lowerMargin outerwidth available (Border top' bottom' left' Auto) =
Border top' bottom' (lowerLength outerwidth left') available
lowerMargin outerwidth _ (Border top' bottom' left' right') =
Border top' bottom' (lowerLength outerwidth left') (lowerLength outerwidth right')