From ddee4bc6c63306443d5e5bb3b02b83383ff4509a Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Wed, 5 Apr 2023 20:18:37 +1200 Subject: [PATCH] Attempt to simplify generic height layout methods. --- Graphics/Layout.hs | 74 +++++++++++++++++++++------------------------- 1 file changed, 33 insertions(+), 41 deletions(-) diff --git a/Graphics/Layout.hs b/Graphics/Layout.hs index 27ac848..4b47ca4 100644 --- a/Graphics/Layout.hs +++ b/Graphics/Layout.hs @@ -170,15 +170,14 @@ boxWidth parent (LayoutInline val font (Paragraph a b c d) vals) = boxWidth parent (LayoutSpan val font self') = (B.inline $ fragmentSize' font self', LayoutSpan val font self') -boxNatHeight :: Double -> LayoutItem Length Double x -> (Double, LayoutItem Length Double x) -boxNatHeight parent (LayoutFlow val self childs) = (size', LayoutFlow val self' childs') +boxNatHeight :: Double -> LayoutItem Length Double x -> LayoutItem Length Double x +boxNatHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs' where self' = self { size = mapSizeY (mapAuto size') (size self) } size' = flowNatHeight parent self childs'' childs'' = map (mapY' (lowerLength parent)) $ map layoutGetBox childs' - childs' = map snd $ map (boxNatHeight $ inline $ size self) childs -boxNatHeight parent (LayoutGrid val self childs) = - (size', LayoutGrid val self' $ zip cells childs') + childs' = map (boxNatHeight $ inline $ size self) childs +boxNatHeight parent (LayoutGrid val self childs) = LayoutGrid val self' $ zip cells childs' where self' = self { containerSize = Size width $ Pixels size' @@ -188,23 +187,23 @@ boxNatHeight parent (LayoutGrid val self childs) = (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 + childs' = map (boxNatHeight width) $ map snd childs width = inline $ containerSize self -boxNatHeight parent self@(LayoutInline _ font self' _) = (inlineHeight font parent self', self) -boxNatHeight parent self@(LayoutSpan _ font self') = (B.block $ fragmentSize' font self', self) -boxMinHeight :: Double -> LayoutItem Length Double x -> (Double, LayoutItem Length Double x) -boxMinHeight parent (LayoutFlow val self childs) = (min', LayoutFlow val self' childs') +boxNatHeight parent self@(LayoutInline _ _ _ _) = self +boxNatHeight parent self@(LayoutSpan _ _ _) = self +boxMinHeight :: Double -> LayoutItem Length Double x -> LayoutItem Length Double x +boxMinHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs' where - childs' = map snd $ map (boxMinHeight $ inline $ size 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) = (min', LayoutGrid val self' childs') +boxMinHeight parent (LayoutGrid val self childs) = LayoutGrid val self' childs' where childs' = map recurse childs recurse (cell, child) = (cell', child') where cell' = setCellBox (layoutGetBox child') cell - (_, child') = boxMinHeight width child + child' = boxMinHeight width child self' = self { containerMin = Size width $ Pixels min', rowBounds = zip heights (map snd (rowBounds self) ++ repeat 0) @@ -216,23 +215,23 @@ boxMinHeight parent (LayoutGrid val self childs) = (min', LayoutGrid val self' c startCol = startCol cell, endCol = endCol cell, alignment = alignment cell } | (cell, _) <- childs] width = inline $ containerSize self -boxMinHeight parent self@(LayoutInline _ font self' _) = (inlineHeight font parent self', self) -boxMinHeight parent self@(LayoutSpan _ font self') = (B.block $ fragmentSize' font self', self) +boxMinHeight parent self@(LayoutInline _ font self' _) = self +boxMinHeight parent self@(LayoutSpan _ font self') = 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') + LayoutItem Length Double x +boxMaxHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs' where - childs' = map snd $ map (boxMaxHeight $ mapY' (lowerLength width) self') childs + childs' = 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') +boxMaxHeight parent (LayoutGrid val self childs) = LayoutGrid val self' childs' where childs' = map recurse childs recurse (cell, child) = (cell', child') where cell' = setCellBox (layoutGetBox child') cell - (_, child') = boxMaxHeight parent' child + child' = boxMaxHeight parent' child parent' :: PaddedBox Double Double parent' = zero { B.min = mapSizeY (lowerLength width) $ containerMin self, @@ -244,28 +243,24 @@ boxMaxHeight parent (LayoutGrid val self childs) = (max', LayoutGrid val self' c } (max', heights) = gridMaxHeights parent self $ rowBounds self width = inline $ size parent -boxMaxHeight parent (LayoutInline val font self' vals) = - (inlineHeight font (B.inline $ B.size parent) self', - LayoutInline val font self' vals) -boxMaxHeight parent (LayoutSpan val font self') = - (B.block $ fragmentSize' font self', LayoutSpan val font self') -boxHeight :: PaddedBox Double Double -> LayoutItem Length Double x -> - (Double, LayoutItem Double Double x) -boxHeight parent (LayoutFlow val self childs) = (size', LayoutFlow val self' childs') +boxMaxHeight parent (LayoutInline val font self' vals) = LayoutInline val font self' vals +boxMaxHeight parent (LayoutSpan val font self') = LayoutSpan val font self' +boxHeight :: PaddedBox Double Double -> LayoutItem Length Double x -> LayoutItem Double Double x +boxHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs' where - childs' = map snd $ map (boxHeight self') childs + childs' = 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') +boxHeight parent (LayoutGrid val self childs) = 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 + child' = boxHeight (layoutGetBox $ LayoutGrid val self' []) child self' = Grid { containerSize = Size (inline $ containerSize self) size', containerMin = mapSizeY (lowerLength width) $ containerMin self, @@ -280,11 +275,8 @@ boxHeight parent (LayoutGrid val self childs) = (size', LayoutGrid val self' chi lowerSize (Left x) = Left $ lowerLength width x lowerSize (Right x) = Right x width = inline $ size parent -boxHeight parent (LayoutInline val font self' vals) = - (inlineHeight font (B.inline $ B.size parent) self', - LayoutInline val font self' vals) -boxHeight _ (LayoutSpan val font self') = - (B.block $ fragmentSize' font self', LayoutSpan val font self') +boxHeight parent (LayoutInline val font self' vals) = LayoutInline val font self' vals +boxHeight _ (LayoutSpan val font self') = LayoutSpan val font self' boxSplit :: Double -> Double -> LayoutItem Double Double x -> (LayoutItem Double Double x, Maybe (LayoutItem Double Double x)) @@ -340,11 +332,11 @@ boxLayout parent self paginate = self8 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 + self3 = boxWidth parent self2 + self4 = boxNatHeight (inline $ size parent) self3 + self5 = boxMinHeight (inline $ size parent) self4 + self6 = boxMaxHeight parent self5 + self7 = boxHeight parent self6 self8 = boxPosition (0, 0) self7 -- Useful for assembling glyph atlases. -- 2.30.2