~alcinnz/CatTrap

1fb004f66e1a3282a192fa3159910cb393e0d5e5 — Adrian Cochrane 1 year, 7 months ago f744439
Refactor abstract grids to seperate fields of children array.
2 files changed, 42 insertions(+), 42 deletions(-)

M Graphics/Layout.hs
M Graphics/Layout/Grid/CSS.hs
M Graphics/Layout.hs => Graphics/Layout.hs +37 -37
@@ 25,7 25,7 @@ import Graphics.Text.Font.Choose (Pattern)

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)]
    | LayoutGrid x (Grid m n) [GridItem m n] [LayoutItem m n x]
    | LayoutInline x Font' Paragraph PageOptions [x] -- Balkon holds children.
    | LayoutInline' x Font' ParagraphLayout PageOptions [x]
    | LayoutSpan x Font' Fragment


@@ 36,7 36,7 @@ nullLayout = LayoutFlow temp zero []
layoutGetBox :: (Zero m, Zero n, CastDouble m, CastDouble n) =>
        LayoutItem m n x -> PaddedBox m n
layoutGetBox (LayoutFlow _ ret _) = ret
layoutGetBox (LayoutGrid _ self _) = zero {
layoutGetBox (LayoutGrid _ self _ _) = zero {
    B.min = Size (fromDouble $ gridMinWidth toDouble self) (fromDouble $ gridMinHeight toDouble self),
    B.size = Size (fromDouble $ gridNatWidth toDouble self) (fromDouble $ gridNatHeight toDouble self),
    B.max = Size (fromDouble $ gridNatWidth toDouble self) (fromDouble $ gridNatHeight toDouble self)


@@ 51,14 51,14 @@ layoutGetBox (LayoutSpan _ f self) = zero {
    B.min = fragmentSize f self, B.size = fragmentSize f self, B.max = fragmentSize f self
}
layoutGetChilds (LayoutFlow _ _ ret) = ret
layoutGetChilds (LayoutGrid _ _ ret) = map snd ret
layoutGetChilds (LayoutGrid _ _ _ ret) = ret
layoutGetChilds (LayoutSpan _ _ _) = []
layoutGetChilds (LayoutInline _ font self _ vals) = map inner $ inlineChildren vals self
  where inner (val, fragment) = LayoutSpan val font fragment
layoutGetChilds (LayoutInline' _ font self _ vals) = map inner $ layoutChildren vals self
  where inner (val, fragment) = LayoutSpan val font fragment
layoutGetInner (LayoutFlow ret _ _) = ret
layoutGetInner (LayoutGrid ret _ _) = ret
layoutGetInner (LayoutGrid ret _ _ _) = ret
layoutGetInner (LayoutInline ret _ _ _ _) = ret
layoutGetInner (LayoutInline' ret _ _ _ _) = ret
layoutGetInner (LayoutSpan ret _ _) = ret


@@ 75,19 75,19 @@ boxMinWidth parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
    childs' = map (boxMinWidth $ Just selfWidth) childs
    selfWidth = width $ mapX' (lowerLength parent') self
    parent' = fromMaybe 0 parent
boxMinWidth parent (LayoutGrid val self childs) = LayoutGrid val self' $ zip cells' childs'
boxMinWidth parent (LayoutGrid val self cells0 childs) = LayoutGrid val self' cells' childs'
  where
    self' = self { colMins = cells }
    (min', cells) = gridMinWidths parent' self cells''
    (_, cells) = gridMinWidths parent' self cells''
    cells'' = [ setCellBox (mapX' (lowerLength selfWidth) $ gridItemBox cell) cell
                | cell <- cells']
    cells' = map setCellBox' $ zip childs' $ map fst childs
    cells' = map setCellBox' $ zip childs' cells0
    childs'' = map (mapX' $ lowerLength selfWidth) $ map layoutGetBox childs'
    childs' = map (boxMinWidth $ Just selfWidth) $ map snd childs
    childs' = map (boxMinWidth $ Just selfWidth) childs
    selfWidth = gridNatWidth (lowerLength parent') self
    parent' = fromMaybe (gridEstWidth self [
        GridItem startRow endRow startCol endCol alignment zeroBox |
        (GridItem {..}, _) <- childs]) parent
        GridItem {..} <- cells0]) parent
    zeroBox :: PaddedBox Double Double
    zeroBox = zero
boxMinWidth _ self@(LayoutInline _ _ _ _ _) = self


@@ 103,21 103,21 @@ boxNatWidth parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
    childs' = map (boxNatWidth $ Just selfWidth) childs
    selfWidth = width $ mapX' (lowerLength parent') self
    parent' = fromMaybe 0 parent
boxNatWidth parent (LayoutGrid val self childs) = LayoutGrid val self' $ zip cells' childs'
boxNatWidth parent (LayoutGrid val self cells0 childs) = LayoutGrid val self' cells' childs'
  where
    self' = self { colNats = cells }
    (size', cells) = gridNatWidths parent' self cells''
    (_, cells) = gridNatWidths parent' self cells''
    cells'' = [
        cell { gridItemBox = mapX' (lowerLength selfWidth) $ gridItemBox cell }
        | cell <- cells']
    cells' = map setCellBox $ zip childs' $ map fst childs
    cells' = map setCellBox $ zip childs' cells0
    setCellBox (child, cell) = cell { gridItemBox = layoutGetBox child }
    childs'' = map (mapX' $ lowerLength selfWidth) $ map layoutGetBox childs'
    childs' = map (boxNatWidth $ Just selfWidth) $ map snd childs
    childs' = map (boxNatWidth $ Just selfWidth) childs
    selfWidth = gridNatWidth (lowerLength parent') self
    parent' = fromMaybe (gridEstWidth self [
        GridItem startRow endRow startCol endCol alignment zeroBox |
        (GridItem {..}, _) <- childs]) parent
        GridItem {..} <- cells0]) parent
    zeroBox :: PaddedBox Double Double
    zeroBox = zero
boxNatWidth _ self@(LayoutInline _ _ _ _ _) = self


@@ 130,7 130,7 @@ boxMaxWidth parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
    self'' = mapX' (lowerLength $ inline $ B.size parent) self'
    self' = self { B.max = Size (Pixels max') (block $ B.max self) }
    max' = flowMaxWidth parent self
boxMaxWidth parent (LayoutGrid val self childs) = LayoutGrid val self childs
boxMaxWidth parent (LayoutGrid val self cells childs) = LayoutGrid val self cells childs -- TODO recurse
boxMaxWidth parent self@(LayoutInline _ _ _ _ _) = self
boxMaxWidth parent self@(LayoutInline' _ _ _ _ _) = self
boxMaxWidth parent self@(LayoutSpan _ f self') = self


@@ 143,9 143,9 @@ boxWidth parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
        size = Size size' $ block $ B.max self
      }
    size' = flowWidth parent self
boxWidth parent (LayoutGrid val self childs) = LayoutGrid val self' childs'
boxWidth parent (LayoutGrid val self cells childs) = LayoutGrid val self' cells' childs'
  where
    childs' = map recurse childs
    (cells', childs') = unzip $ map recurse $ zip cells childs
    recurse (cell, child) = (cell', child')
      where
        cell' = cell { gridItemBox = layoutGetBox child' }


@@ 174,14 174,14 @@ boxNatHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
    size' = flowNatHeight parent self childs''
    childs'' = map (mapY' (lowerLength parent)) $ map layoutGetBox childs'
    childs' = map (boxNatHeight $ inline $ size self) childs
boxNatHeight parent (LayoutGrid val self childs) = LayoutGrid val self $ zip cells childs'
boxNatHeight parent (LayoutGrid val self cells childs) = LayoutGrid val self cells childs'
  where
    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 (boxNatHeight width) $ map snd childs
    (_, heights) = gridNatHeights parent self cells'
    cells' = [setCellBox (mapY' (lowerLength width) $ gridItemBox cell) cell | cell <- cells0]
    cells0 = map setCellBox' $ zip childs' cells
    childs' = map (boxNatHeight width) childs
    width = gridNatWidth id self
boxNatHeight parent self@(LayoutInline _ _ _ _ _) = self
boxNatHeight parent self@(LayoutInline' _ _ _ _ _) = self


@@ 192,20 192,20 @@ boxMinHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
    childs' = 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) = LayoutGrid val self' childs'
boxMinHeight parent (LayoutGrid val self cells childs) = LayoutGrid val self' cells' childs'
  where
    childs' = map recurse childs
    (cells', childs') = unzip $ map recurse $ zip cells childs
    recurse (cell, child) = (cell', child')
      where
        cell' = setCellBox (layoutGetBox child') cell
        child' = boxMinHeight width child
    self' = self { rowMins = heights }
    (min', heights) = gridMinHeights width self childs0
    (_, 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]
      } | cell <- cells]
    width = gridNatWidth id self
boxMinHeight parent self@(LayoutInline _ _ _ _ _) = self
boxMinHeight _ self@(LayoutInline' _ _ _ _ _) = self


@@ 218,14 218,14 @@ boxMaxHeight parent (LayoutFlow val self childs) = LayoutFlow val 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) = LayoutGrid val self childs'
boxMaxHeight parent (LayoutGrid val self cells childs) = LayoutGrid val self cells' childs'
  where
    childs' = map recurse childs
    (cells', childs') = unzip $ map recurse $ zip cells childs
    recurse (cell, child) = (cell', child')
      where
        cell' = setCellBox (layoutGetBox child') cell
        child' = boxMaxHeight (mapY' (lowerLength width) $ gridItemBox cell) child
    (max', heights) = gridMaxHeights parent self (rowMins self) (rowNats self)
    (_, heights) = gridMaxHeights parent self (rowMins self) (rowNats self)
    width = inline $ size parent
boxMaxHeight parent (LayoutInline val font self' paging vals) =
    LayoutInline val font self' paging vals


@@ 241,13 241,13 @@ boxHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
      }
    size' = flowHeight parent self
    width = inline $ size self
boxHeight parent (LayoutGrid val self childs) = LayoutGrid val self' childs'
boxHeight parent (LayoutGrid val self cells childs) = LayoutGrid val self' cells' childs'
  where
    childs' = map recurse childs
    (cells', childs') = unzip $ map recurse $ zip cells childs
    recurse (cell, child) = (cell', child')
      where
        cell' = setCellBox (layoutGetBox child') cell
        child' = boxHeight (layoutGetBox $ LayoutGrid val self' []) child
        child' = boxHeight (layoutGetBox $ LayoutGrid val self' [] []) child
    self' = Grid {
        gap = mapSizeY (lowerLength width) $ gap self,



@@ 255,7 255,7 @@ boxHeight parent (LayoutGrid val self childs) = LayoutGrid val self' childs'
        columns = columns self, colMins = colMins self, colNats = colNats self,
        subgridRows = subgridRows self, subgridColumns = subgridColumns self
      }
    (size', heights) = gridHeights parent self (rowMins self) (rowNats self)
    (_, heights) = gridHeights parent self (rowMins self) (rowNats self)
    lowerSize (Left x) = Left $ lowerLength width x
    lowerSize (Right x) = Right x
    width = inline $ size parent


@@ 288,7 288,7 @@ boxSplit maxheight pageheight (LayoutFlow val self childs)
    inner start (child:childs) = (start', child):inner start' childs -- TODO margin collapse?
        where start' = start + height (layoutGetBox child)
    inner _ [] = []
boxSplit _ _ self@(LayoutGrid _ _ _) = (self, Nothing) -- TODO
boxSplit _ _ self@(LayoutGrid _ _ _ _) = (self, Nothing) -- TODO
boxSplit maxheight pageheight (LayoutInline a b self c d) =
    boxSplit maxheight pageheight $ LayoutInline' a b (layoutPlain self) c d
boxSplit maxheight pageheight (LayoutInline' a b self paging c) =


@@ 313,11 313,11 @@ boxPosition pos@(x, y) (LayoutFlow val self childs) = LayoutFlow (pos, val) self
    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'
boxPosition pos@(x, y) (LayoutGrid val self cells childs) = LayoutGrid (pos, val) self cells 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
    recurse ((Size x' y'), child) = boxPosition (x + x', y + y') child
    pos' = gridPosition self cells
boxPosition pos@(x, y) (LayoutInline val font self paging vals) =
    LayoutInline (pos, val) font self paging $ map (\(x, y) -> (fragmentPos font pos y, x)) $
            inlineChildren vals self

M Graphics/Layout/Grid/CSS.hs => Graphics/Layout/Grid/CSS.hs +5 -5
@@ 254,7 254,7 @@ finalizeGrid :: PropertyParser x => CSSGrid -> Font' ->
    [CSSCell] -> [LayoutItem Length Length x] -> LayoutItem Length Length x
finalizeGrid self@CSSGrid {
        templateColumns = Left cols', templateRows = Left rows'
    } font cells childs = LayoutGrid temp self' $ zip cells' childs
    } font cells childs = LayoutGrid temp self' cells' childs
  where
    self' = Grid {
        rows = map finalizeFR $ map snd rows0,


@@ 333,14 333,14 @@ finalizeGrid self@CSSGrid {
    finalizeFR (x,"fr") = Right x
    finalizeFR x = Left $ finalizeLength x font
finalizeGrid self@CSSGrid { templateColumns = Right colnames } font cells childs =
    LayoutGrid val' self' { subgridColumns = length colnames } childs'
    LayoutGrid val' self' { subgridColumns = length colnames } cells' childs'
  where
    LayoutGrid val' self' childs' = finalizeGrid self {
    LayoutGrid val' self' cells' childs' = finalizeGrid self {
        templateColumns = Left $ zip colnames $ repeat (1,"fr")
      } font cells childs
finalizeGrid self@CSSGrid { templateRows = Right rownames } font cells childs =
    LayoutGrid val' self' { subgridRows = length rownames } childs'
    LayoutGrid val' self' { subgridRows = length rownames } cells' childs'
  where
    LayoutGrid val' self' childs' = finalizeGrid self {
    LayoutGrid val' self' cells' childs' = finalizeGrid self {
        templateRows = Left $ zip rownames $ repeat (1,"fr")
      } font cells childs