{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
module Graphics.Layout where
import Graphics.Layout.Box as B
import Graphics.Layout.Grid as G
import Graphics.Layout.Flow as F
import Data.Maybe (fromMaybe)
data LayoutItem m n x =
LayoutFlow x (PaddedBox m n) [LayoutItem m n x]
| LayoutGrid x (Grid m n) [(GridItem m n, LayoutItem m n x)]
-- More to come...
layoutGetBox (LayoutFlow _ ret _) = ret
layoutGetBox (LayoutGrid _ self _) = zero {
B.min = containerMin self,
B.size = containerSize self,
B.max = containerMax self
}
setCellBox' (child, cell) = cell { gridItemBox = layoutGetBox child }
boxMinWidth :: Zero y => Maybe Double -> LayoutItem y Length x -> (Double, LayoutItem y Length x)
boxMinWidth parent (LayoutFlow val self childs) = (min', LayoutFlow val self' childs')
where
self' = self {B.min = Size (Pixels min') (block $ B.min self) }
min' = flowMinWidth parent' self childs''
childs'' = map (mapX' $ lowerLength selfWidth) $ map layoutGetBox childs'
childs' = map snd $ map (boxMinWidth $ Just selfWidth) childs
selfWidth = width $ mapX' (lowerLength parent') self
parent' = fromMaybe 0 parent
boxMinWidth parent (LayoutGrid val self childs) =
(min', LayoutGrid val self' $ zip cells' childs')
where
self' = self {
containerMin = Size (Pixels min') (block $ containerMin self),
colBounds = zip cells (map snd (colBounds self) ++ repeat 0)
}
(min', cells) = gridMinWidths parent' self cells''
cells'' = [ setCellBox (mapX' (lowerLength selfWidth) $ gridItemBox cell) cell
| cell <- cells']
cells' = map setCellBox' $ zip childs' $ map fst childs
childs'' = map (mapX' $ lowerLength selfWidth) $ map layoutGetBox childs'
childs' = map snd $ map (boxMinWidth $ Just selfWidth) $ map snd childs
selfWidth = lowerLength parent' $ inline $ containerSize self
parent' = fromMaybe (gridEstWidth self [
GridItem startRow endRow startCol endCol alignment zeroBox |
(GridItem {..}, _) <- childs]) parent
zeroBox :: PaddedBox Double Double
zeroBox = zero
boxNatWidth :: Zero y => Maybe Double -> LayoutItem y Length x -> (Double, LayoutItem y Length x)
boxNatWidth parent (LayoutFlow val self childs) = (size', LayoutFlow val self childs')
-- NOTE: Need to preserve auto/percentage in actual width calculation.
-- self' doesn't preserve this. CatTrap will need a decent refactor!
where
self' = self {size = Size (Pixels size') (block $ size self) }
size' = flowNatWidth parent' self childs''
childs'' = map (mapX' $ lowerLength selfWidth) $ map layoutGetBox childs'
childs' = map snd $ map (boxNatWidth $ Just selfWidth) childs
selfWidth = width $ mapX' (lowerLength parent') self
parent' = fromMaybe 0 parent
boxNatWidth parent (LayoutGrid val self childs) =
(size', LayoutGrid val self' $ zip cells' childs')
where
self' = self {
containerSize = Size (Pixels size') (block $ containerSize self),
colBounds = zip (map fst (colBounds self) ++ repeat 0) cells
}
(size', cells) = gridNatWidths parent' self cells''
cells'' = [
cell { gridItemBox = mapX' (lowerLength selfWidth) $ gridItemBox cell }
| cell <- cells']
cells' = map setCellBox $ zip childs' $ map fst childs
setCellBox (child, cell) = cell { gridItemBox = layoutGetBox child }
childs'' = map (mapX' $ lowerLength selfWidth) $ map layoutGetBox childs'
childs' = map snd $ map (boxNatWidth $ Just selfWidth) $ map snd childs
selfWidth = lowerLength parent' $ inline $ containerSize self
parent' = fromMaybe (gridEstWidth self [
GridItem startRow endRow startCol endCol alignment zeroBox |
(GridItem {..}, _) <- childs]) parent
zeroBox :: PaddedBox Double Double
zeroBox = zero
boxMaxWidth :: PaddedBox a Double -> LayoutItem y Length x -> (Double, LayoutItem y Length x)
boxMaxWidth parent (LayoutFlow val self childs) = (max', LayoutFlow val self' childs)
where
self' = self { B.max = Size (Pixels max') (block $ B.max self) }
max' = flowMaxWidth parent self
boxMaxWidth parent (LayoutGrid val self childs) =
(max', LayoutGrid val self' childs)
where
self' = self { containerMax = Size (Pixels max') (block $ containerMax self) }
(max', _) = gridMaxWidths parent self $ colBounds self
boxWidth :: Zero y => PaddedBox b Double -> LayoutItem y Length x ->
(Double, LayoutItem y Double x)
boxWidth parent (LayoutFlow val self childs) = (size', LayoutFlow val self' childs')
where
childs' = map (snd . boxWidth self') childs
self' = (mapX' (lowerLength $ inline $ size parent) self) {
size = Size size' $ block $ B.max self
}
size' = flowWidth parent self
boxWidth parent (LayoutGrid val self childs) = (size', LayoutGrid val self' childs')
where
childs' = map recurse childs
recurse (cell, child) = (cell', child')
where
cell' = cell { gridItemBox = layoutGetBox child' }
(_, child') = boxWidth parent' child
parent' = zero {
B.min = containerMin self',
B.size = containerSize self',
B.max = containerMax self'
}
self' = Grid {
containerSize = Size size' $ block $ containerSize self,
containerMin = mapSizeX (lowerLength outerwidth) $ containerMin self,
containerMax = mapSizeX (lowerLength outerwidth) $ containerMax self,
gap = mapSizeX (lowerLength outerwidth) $ gap self,
columns = map Left widths,
rows = rows self,
rowBounds = rowBounds self,
colBounds = colBounds self,
subgridRows = subgridRows self, subgridColumns = subgridColumns self
}
outerwidth = inline $ size parent
(size', widths) = gridWidths parent self $ colBounds self
boxNatHeight :: Double -> LayoutItem Length Double x -> (Double, LayoutItem Length Double x)
boxNatHeight parent (LayoutFlow val self childs) = (size', LayoutFlow val self' childs')
where
self' = self {
size = Size width (Pixels size')
}
size' = flowNatHeight parent self childs''
childs'' = map (mapY' (lowerLength parent)) $ map layoutGetBox childs'
childs' = map snd $ map (boxNatHeight width) childs
width = inline $ size self
boxNatHeight parent (LayoutGrid val self childs) =
(size', LayoutGrid val self' $ zip cells childs')
where
self' = self {
containerSize = Size width $ Pixels size'
}
lowerGridUnit (Left length) = Left $ lowerLength width length
lowerGridUnit (Right x) = Right x
(size', heights) = gridNatHeights parent self cells'
cells' = [setCellBox (mapY' (lowerLength width) $ gridItemBox cell) cell | cell <- cells]
cells = map setCellBox' $ zip childs' $ map fst childs
childs' = map snd $ map (boxNatHeight width) $ map snd childs
width = inline $ containerSize self
boxMinHeight :: Double -> LayoutItem Length Double x -> (Double, LayoutItem Length Double x)
boxMinHeight parent (LayoutFlow val self childs) = (min', LayoutFlow val self' childs')
where
childs' = map snd $ map (boxMinHeight $ inline $ size self) childs
self' = self {
B.min = Size (inline $ B.min self) (Pixels min')
}
min' = flowMinHeight parent self
boxMinHeight parent (LayoutGrid val self childs) = (min', LayoutGrid val self' childs')
where
childs' = map recurse childs
recurse (cell, child) = (cell', child')
where
cell' = setCellBox (layoutGetBox child') cell
(_, child') = boxMinHeight width child
self' = self {
containerMin = Size width $ Pixels min',
rowBounds = zip heights (map snd (rowBounds self) ++ repeat 0)
}
(min', heights) = gridMinHeights width self childs0
childs0 = [ GridItem {
gridItemBox = mapY' (lowerLength width) $ gridItemBox cell,
startRow = startRow cell, endRow = endRow cell,
startCol = startCol cell, endCol = endCol cell, alignment = alignment cell
} | (cell, _) <- childs]
width = inline $ containerSize self
boxMaxHeight :: PaddedBox Double Double -> LayoutItem Length Double x ->
(Double, LayoutItem Length Double x)
boxMaxHeight parent (LayoutFlow val self childs) = (max', LayoutFlow val self' childs')
where
childs' = map snd $ map (boxMaxHeight $ mapY' (lowerLength width) self') childs
self' = self {
B.max = Size (inline $ B.max self) (Pixels max')
}
max' = flowMaxHeight (inline $ size parent) self
width = inline $ size self
boxMaxHeight parent (LayoutGrid val self childs) = (max', LayoutGrid val self' childs')
where
childs' = map recurse childs
recurse (cell, child) = (cell', child')
where
cell' = setCellBox (layoutGetBox child') cell
(_, child') = boxMaxHeight parent' child
parent' :: PaddedBox Double Double
parent' = zero {
B.min = mapSizeY (lowerLength width) $ containerMin self,
B.size = mapSizeY (lowerLength width) $ containerSize self,
B.max = Size (inline $ containerMax self') max'
}
self' = self {
containerMax = Size (inline $ containerSize self) (Pixels max')
}
(max', heights) = gridMaxHeights parent self $ rowBounds self
width = inline $ size parent
boxHeight :: PaddedBox Double Double -> LayoutItem Length Double x ->
(Double, LayoutItem Double Double x)
boxHeight parent (LayoutFlow val self childs) = (size', LayoutFlow val self' childs')
where
childs' = map snd $ map (boxHeight self') childs
self' = (mapY' (lowerLength $ inline $ size parent) self) {
size = Size (inline $ size self) size'
}
size' = flowHeight parent self
width = inline $ size self
boxHeight parent (LayoutGrid val self childs) = (size', LayoutGrid val self' childs')
where
childs' = map recurse childs
recurse (cell, child) = (cell', child')
where
cell' = setCellBox (layoutGetBox child') cell
(_, child') = boxHeight (layoutGetBox $ LayoutGrid val self' []) child
self' = Grid {
containerSize = Size (inline $ containerSize self) size',
containerMin = mapSizeY (lowerLength width) $ containerMin self,
containerMax = mapSizeY (lowerLength width) $ containerMax self,
gap = mapSizeY (lowerLength width) $ gap self,
rows = map lowerSize $ rows self, rowBounds = rowBounds self,
columns = columns self, colBounds = colBounds self,
subgridRows = subgridRows self, subgridColumns = subgridColumns self
}
(size', heights) = gridHeights parent self $ rowBounds self
lowerSize (Left x) = Left $ lowerLength width x
lowerSize (Right x) = Right x
width = inline $ size parent
boxPosition :: (Double, Double) -> LayoutItem Double Double x ->
LayoutItem Double Double ((Double, Double), x)
boxPosition pos@(x, y) (LayoutFlow val self childs) = LayoutFlow (pos, val) self childs'
where
childs' = map recurse $ zip pos' childs
recurse ((Size x' y'), child) = boxPosition (x + x', y + y') child
pos' = positionFlow $ map layoutGetBox childs
boxPosition pos@(x, y) (LayoutGrid val self childs) = LayoutGrid (pos, val) self childs'
where
childs' = map recurse $ zip pos' childs
recurse ((Size x' y'), (cell, child)) = (cell, boxPosition (x + x', y + y') child)
pos' = gridPosition self $ map fst childs
boxLayout :: PaddedBox Double Double -> LayoutItem Length Length x -> Bool ->
LayoutItem Double Double ((Double, Double), x)
boxLayout parent self paginate = self8
where
(_, self0) = boxMinWidth Nothing self
(_, self1) = boxNatWidth Nothing self0
(_, self2) = boxMaxWidth parent self1
(_, self3) = boxWidth parent self2
(natsize, self4) = boxNatHeight (inline $ size parent) self3
(_, self5) = boxMinHeight natsize self4
(_, self6) = boxMaxHeight parent self5
(_, self7) = boxHeight parent self6
self8 = boxPosition (0, 0) self7