{-# 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