~alcinnz/CatTrap

ref: 309a5a356b784d60e941172b535f3d40905595da CatTrap/Graphics/Layout/Flow.hs -rw-r--r-- 6.8 KiB
309a5a35 — Adrian Cochrane Decided against adding invisible length-lowering into CatTrap, Mondrian's would be too sophisticated! 1 year, 2 months ago 
                                                                                
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
131
132
module Graphics.Layout.Flow(flowMinWidth, flowNatWidth, flowMaxWidth, flowWidth,
        flowNatHeight, flowMinHeight, flowMaxHeight, flowHeight,
        positionFlow, layoutFlow) 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] ->
        (PaddedBox Double Double, [(Size Double Double, PaddedBox Double Double)])
layoutFlow parent self childs = (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')