~alcinnz/CatTrap

ref: 4c05e6f601b07a2cb9851ddf7f382a327ebe5c88 CatTrap/Graphics/Layout/Flow.hs -rw-r--r-- 6.4 KiB
4c05e6f6 — Adrian Cochrane Draft flow layout computation. 1 year, 4 months ago
                                                                                
09970dfc Adrian Cochrane
4c05e6f6 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
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 _ Length -> [PaddedBox _ Length] -> 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 = Prelude.max [
    minWidth $ child {B.min = flowMinWidth 0 child []} | child <- childs
  ]
flowNatWidth :: Double -> PaddedBox _ Length -> [PaddedBox _ Length] -> 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 child
flowNatWidth parent _ childs = Prelude.max [
    width $ child {B.width = flowNatWidth 0 child []} | child <- childs
  ]
flowMaxWidth :: PaddedBox _ Double -> PaddedBox _ Length -> Double
flowMaxWidth _ PaddedBox {B.max = Size (Pixels x) _} = x
flowMaxWidth parent PaddedBox {B.max = Size (Percent x) _} = x * parent
flowMaxWidth parent PaddedBox {B.max = Size Auto _} = 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 _ Double -> PaddedBox _ Length -> Double
flowWidth parent self
    | small > large = small
    | natural > large = large
    | natural >= small = natural
    | otherwise = small
  where
    small = flowMinWidth (inline $ B.min parent) self []
    natural = flowNatWidth (inline $ width 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 (lowerLength owidth) 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 _ self = flowNatHeight 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 _ self@PaddedBox {B.max = Size _ Preferred} = flowNatHeight 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 = flowMaxWidth (block $ B.max parent) self

positionFlow :: [PaddedBox Double Double] -> [Size Double Double]
positionFlow childs = scanl inner (Size 0 0) $ marginCollapse id childs
  where inner (Size x y) self = Size x $ height self
layoutFlow :: PaddedBox Double Double -> PaddedBox Length Length ->
        [PaddedBox Length Length] -> 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 oheight 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 owdith) $ padding self2,
        border = mapX (lowerLength owidth) $ border self2,
        margin = lowerMargin owidth (owidth - width') $ margin self2
      }
    width' = flowWidth parent self2
    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 (flowMinWidth (inline $ B.min self') child [])
            (flowMinHeight (block $ B.min self') child),
        size = Size (flowWidth self' child) (flowHeight (block $ size self') child),
        B.max = Size (flowMaxWidth self' child) (flowMaxHeight (block $ size self') child),
      }

marginCollapse cb (x'@PaddedBox {margin = xm@Border { bottom = x }}:
        y'@PaddedBox {margin = ym@Border { top = y}}:rest)
    | cb x > cb y = x':marginCollapse (y' {margin = ym { top = 0 }}:rest)
    | otherwise = x' { margin = xm { bottom = 0 }}:marginCollapse (y':rest)

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

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')