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