~alcinnz/CatTrap

ref: 074d5d9c1b8ad4db9d357fcce9076bd49413c4d9 CatTrap/Graphics/Layout/Grid.hs -rw-r--r-- 8.2 KiB
074d5d9c — Adrian Cochrane Finish drafting CSS4 Grid support! 1 year, 7 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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
{-# LANGUAGE RecordWildCards #-}
module Graphics.Layout.Grid where

import Data.Text (Text)
import Data.List (intersperse)
import Graphics.Layout.Box as B

data Grid m n = Grid {
    rows :: [(Name, Either m Double)],
    columns :: [(Name, Either n Double)],
    gap :: Size m n,
    gridBox :: PaddedBox m n
}
data GridItem m n = GridItem {
    startRow :: Int, endRow :: Int, startCol :: Int, endCol :: Int,
    alignment :: Size Alignment Alignment,
    gridItemBox :: PaddedBox m n
}
data Alignment = Start | Mid | End

type Name = Text

cellsForCol :: [GridItem y x] -> Int -> [GridItem y x]
cellsForCol cells ix =
    [cell | cell <- cells, startCol cell == ix, startCol cell /= succ (endCol cell)]
cellsForRow :: [GridItem y x] -> Int -> [GridItem y x]
cellsForRow cells ix =
    [cell | cell <- cells, startRow cell == ix, startRow cell /= succ (endRow cell)]
verifyGrid self childs = and [
    startRow < width && startRow >= 0 && endRow < width && endRow >= 0 &&
    endCol > startCol && endRow > startRow &&
    startCol < height && startCol >= 0 && endCol < height && endCol >= 0 |
    GridItem {..} <- childs]
  where
    width = length $ columns self
    height = length $ rows self

{-gridEstWidth :: Grid y Length -> [GridItem y Double] -> Double-}
gridMinWidths :: Double -> Grid y Length -> [GridItem y Double] -> (Double, [Double])
gridMinWidths parent self childs =
    (sum $ intersperse (lowerLength parent $ inline $ gap self) ret, ret)
  where
    ret = map colMinWidth $ enumerate $ map snd $ columns self
    colMinWidth (_, Left (Pixels x)) = x
    colMinWidth (_, Left (Percent x)) = x * parent
    colMinWidth arg@(ix, Left Preferred) =
        maximum $ (0:) $ map (inline . size . gridItemBox) $ cellsForCol childs ix
    colMinWidth (ix, _) =
        maximum $ (0:) $ map (inline . B.min . gridItemBox) $ cellsForCol childs ix
gridNatWidths :: Double -> Grid y Length -> [GridItem y Double] -> (Double, [Double])
gridNatWidths parent self childs =
    (sum $ intersperse (lowerLength parent $ inline $ gap self) ret, ret)
  where
    ret = map colNatWidth $ enumerate $ map snd $ columns self
    colNatWidth (_, Left (Pixels x)) = x
    colNatWidth (_, Left (Percent x)) = x * parent
    colNatWidth arg@(ix, Left Min) =
        maximum $ (0:) $ map (inline . B.min . gridItemBox) $ cellsForCol childs ix
    colNatWidth (ix, _) =
        maximum $ (0:) $ map (inline . size . gridItemBox) $ cellsForCol childs ix
gridMaxWidths :: PaddedBox y Double -> Grid y Length -> [(Double, Double)] -> (Double, [Double])
gridMaxWidths parent self subwidths =
    (sum $ intersperse (lowerLength outerwidth $ inline $ gap self) ret, ret)
  where
    ret = map (colMaxWidth fr) $ zip subwidths $ map snd $ columns self
    fr = (outerwidth - estimate)/(countFRs $ map snd $ columns self)
    outerwidth = inline $ size parent
    estimate = sum $ intersperse (lowerLength outerwidth $ inline $ gap self) $
        map (colMaxWidth 0) $ zip subwidths $ map snd $ columns self
    colMaxWidth _ (_, Left (Pixels x)) = x
    colMaxWidth _ (_, Left (Percent x)) = x*(inline $ size parent)
    colMaxWidth _ ((_, nat), Left Preferred) = nat
    colMaxWidth _ ((min, _), Left Min) = min
    colMaxWidth fr (_, Left Auto) = fr
    colMaxWidth fr (_, Right x) = x*fr
gridWidths :: PaddedBox y Double -> Grid y Length -> [(Double, Double)] -> (Double, [Double])
gridWidths parent self subwidths =
    (sum $ intersperse (lowerLength outerwidth $ inline $ gap self) ret, ret)
  where
    ret = map (colWidth fr) $ zip subwidths $ map snd $ columns self
    fr = (outerwidth - estimate)/(countFRs $ map snd $ columns self)
    outerwidth = inline $ size parent
    estimate = sum $ intersperse (lowerLength outerwidth $ inline $ gap self) $
        map (colWidth 0) $ zip subwidths $ map snd $ columns self
    colWidth fr ((min, nat), size) = Prelude.min min $ colWidth' fr ((min, nat), size)
    colWidth' _ (_, Left (Pixels x)) = x
    colWidth' _ (_, Left (Percent x)) = x*(inline $ size parent)
    colWidth' _ ((_, nat), Left Preferred) = nat
    colWidth' _ ((min, _), Left Min) = min
    colWidth' fr (_, Left Auto) = fr
    colWidth' fr (_, Right x) = x*fr

gridNatHeights :: Double -> Grid Length Double -> [GridItem Double Double] -> (Double, [Double])
gridNatHeights parent self childs =
    (sum $ intersperse (lowerLength parent $ block $ gap self) ret, ret)
  where
    ret = map rowNatHeight $ enumerate $ map snd $ rows self
    rowNatHeight (_, Left (Pixels x)) = x
    rowNatHeight (_, Left (Percent x)) = x * parent
    rowNatHeight arg@(ix, Left Min) =
        maximum $ (0:) $ map (block . B.min . gridItemBox) $ cellsForCol childs ix
    rowNatHeight (ix, _) =
        maximum $ (0:) $ map (block . size . gridItemBox) $ cellsForCol childs ix
gridMinHeights :: Double -> Grid Length Double -> [GridItem Double Double] -> (Double, [Double])
gridMinHeights parent self childs =
    (sum $ intersperse (lowerLength parent $ block $ gap self) ret, ret)
  where
    ret = map rowMinHeight $ enumerate $ map snd $ rows self
    rowMinHeight (_, Left (Pixels x)) = x
    rowMinHeight (_, Left (Percent x)) = x * parent
    rowMinHeight arg@(ix, Left Preferred) =
        maximum $ (0:) $ map (block . size . gridItemBox) $ cellsForCol childs ix
    rowNatHeight (ix, _) =
        maximum $ (0:) $ map (block . B.min . gridItemBox) $ cellsForCol childs ix
gridMaxHeights :: PaddedBox Double Double -> Grid Length Double ->
    [(Double, Double)] -> (Double, [Double])
gridMaxHeights parent self subheights = (sum $ intersperse (inline $ gap self) ret, ret)
  where
    ret = map (colMaxHeight fr) $ zip subheights $ map snd $ rows self
    fr = (outerheight - estimate)/(countFRs $ map snd $ rows self)
    outerwidth = inline $ size parent
    outerheight = block $ size parent
    estimate = sum $ intersperse (inline $ gap self) $
        map (colMaxHeight 0) $ zip subheights $ map snd $ rows self
    colMaxHeight _ (_, Left (Pixels x)) = x
    colMaxHeight _ (_, Left (Percent x)) = x*outerwidth
    colMaxHeight _ ((_, nat), Left Preferred) = nat
    colMaxHeight _ ((min, _), Left Min) = min
    colMaxHeight fr (_, Left Auto) = fr
    colMaxHeight fr (_, Right x) = x*fr
gridHeights :: PaddedBox Double Double -> Grid Length Double ->
    [(Double, Double)] -> (Double, [Double])
gridHeights parent self subheights = (sum $ intersperse (inline $ gap self) ret, ret)
  where
    ret = map (colHeight fr) $ zip subheights $ map snd $ rows self
    fr = (outerheight - estimate)/(countFRs $ map snd $ rows self)
    outerwidth = inline $ size parent
    outerheight = block $ size parent
    estimate = sum $ intersperse (inline $ gap self) $
        map (colHeight 0) $ zip subheights $ map snd $ rows self
    colHeight fr ((min, nat), size) = Prelude.min min $ colHeight' fr ((min, nat), size)
    colHeight' _ (_, Left (Pixels x)) = x
    colHeight' _ (_, Left (Percent x)) = x*outerwidth
    colHeight' _ ((_, nat), Left Preferred) = nat
    colHeight' _ ((min, _), Left Min) = min
    colHeight' fr ((_, nat), Left Auto) = Prelude.min fr nat
    colHeight' fr (_, Right x) = x*fr

gridPosition :: Grid Double Double -> [GridItem Double Double] -> [Size Double Double]
gridPosition self childs = map gridCellPosition childs
  where
    gridCellPosition child =
        Size (x + align extraWidth alignX) (y + align extraHeight alignY)
      where
        Size x y = gridCellPosition' child
        Size alignX alignY = alignment child
        width = track (endCol child) (columns self) - track (startCol child) (columns self)
        height = track (endRow child) (rows self) - track (startRow child) (columns self)
        extraWidth = width - inline (size $ gridItemBox child)
        extraHeight = height - block (size $ gridItemBox child)
    gridCellPosition' child =
        Size (startCol child `track` columns self) (startRow child `track` rows self)
    track ix sizes | Right x <- map snd sizes !! ix = x -- Might error out if poorly-formed.
        | otherwise = 0
    align _ Start = 0
    align excess Mid = excess/2
    align excess End = excess
{-gridLayout :: PaddedBox Double Double -> Grid Length Length ->
        [GridItem Length Length] -> Bool ->
        (Grid Double Double, [(Size Double Double, GridItem Double Double)])-}

enumerate = zip [0..]

countFRs (Left Auto:rest) = succ $ countFRs rest
countFRs (Right x:rest) = x + countFRs rest
countFRs [] = 0