From d549219c1de66809be3801517e80971b977fa42b Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Wed, 12 Apr 2023 14:28:36 +1200 Subject: [PATCH] Reference-document generic layout/tree-traversal, seperate natural from final size fields. --- Graphics/Layout.hs | 35 +++++++++++++++++++++++++++++++---- Graphics/Layout/Box.hs | 9 +++++++-- Graphics/Layout/CSS.hs | 1 + Graphics/Layout/Flow.hs | 2 +- 4 files changed, 40 insertions(+), 7 deletions(-) diff --git a/Graphics/Layout.hs b/Graphics/Layout.hs index bf5fbf4..8ff3d50 100644 --- a/Graphics/Layout.hs +++ b/Graphics/Layout.hs @@ -23,16 +23,25 @@ import qualified Data.Map.Strict as M import qualified Data.Text.Glyphize as Hb import Graphics.Text.Font.Choose (Pattern) +-- | A tree of different layout algorithms. +-- More to come... data LayoutItem m n x = + -- | A block element. With margins, borders, & padding. LayoutFlow x (PaddedBox m n) [LayoutItem m n x] + -- | A grid or table element. | LayoutGrid x (Grid m n) [GridItem] [LayoutItem m n x] + -- | Some richtext. | LayoutInline x Font' Paragraph PageOptions [x] -- Balkon holds children. + -- | Results laying out richtext, has fixed width. + -- Generated from `LayoutInline` for the sake of pagination. | LayoutInline' x Font' ParagraphLayout PageOptions [x] + -- | Children of a `LayoutInline` or `LayoutInline'`. | LayoutSpan x Font' Fragment --- More to come... +-- | An empty box. nullLayout :: (PropertyParser x, Zero m, Zero n) => LayoutItem m n x nullLayout = LayoutFlow temp zero [] +--- | Retrieve the surrounding box for a layout item. layoutGetBox :: (Zero m, Zero n, CastDouble m, CastDouble n) => LayoutItem m n x -> PaddedBox m n layoutGetBox (LayoutFlow _ ret _) = ret @@ -53,6 +62,7 @@ layoutGetBox (LayoutInline' _ f self _ _) = zero { layoutGetBox (LayoutSpan _ f self) = zero { B.min = fragmentSize f self, B.size = fragmentSize f self, B.max = fragmentSize f self } +-- | Retrieve the subtree under a node. layoutGetChilds (LayoutFlow _ _ ret) = ret layoutGetChilds (LayoutGrid _ _ _ ret) = ret layoutGetChilds (LayoutSpan _ _ _) = [] @@ -60,14 +70,17 @@ layoutGetChilds (LayoutInline _ font self _ vals) = map inner $ inlineChildren v 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 +-- | Retrieve the caller-specified data attached to a layout node. layoutGetInner (LayoutFlow ret _ _) = ret layoutGetInner (LayoutGrid ret _ _ _) = ret layoutGetInner (LayoutInline ret _ _ _ _) = ret layoutGetInner (LayoutInline' ret _ _ _ _) = ret layoutGetInner (LayoutSpan ret _ _) = ret +-- | map-ready wrapper around `setCellBox` sourcing from a child node. setCellBox' (child, cell) = setCellBox cell $ layoutGetBox child +-- | Update a (sub)tree to compute & cache minimum legible sizes. boxMinWidth :: (Zero y, CastDouble y) => Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x boxMinWidth parent (LayoutFlow val self childs) = LayoutFlow val self' childs' @@ -92,13 +105,14 @@ boxMinWidth parent (LayoutGrid val self cells0 childs) = LayoutGrid val self' ce boxMinWidth _ self@(LayoutInline _ _ _ _ _) = self boxMinWidth _ self@(LayoutInline' _ _ _ _ _) = self boxMinWidth _ self@(LayoutSpan _ _ _) = self +-- | Update a (sub)tree to compute & cache ideal width. boxNatWidth :: (Zero y, CastDouble y) => Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x -boxNatWidth parent (LayoutFlow val self childs) = LayoutFlow val self childs' +boxNatWidth parent (LayoutFlow val self childs) = LayoutFlow val self' childs' where - {-self' = self { size = mapSizeX (B.mapAuto size') (size self) } + self' = self { B.nat = Size size' $ block $ B.nat self } size' = flowNatWidth parent' self childs'' - childs'' = map (mapX' $ lowerLength selfWidth) $ map layoutGetBox childs'-} + childs'' = map (mapX' $ lowerLength selfWidth) $ map layoutGetBox childs' childs' = map (boxNatWidth $ Just selfWidth) childs selfWidth = width $ mapX' (lowerLength parent') self parent' = fromMaybe 0 parent @@ -116,6 +130,7 @@ boxNatWidth parent (LayoutGrid val self cells0 childs) = LayoutGrid val self' ce boxNatWidth _ self@(LayoutInline _ _ _ _ _) = self boxNatWidth _ self@(LayoutInline' _ _ _ _ _) = self boxNatWidth _ self@(LayoutSpan _ _ _) = self +-- | Update a (sub)tree to compute & cache maximum legible width. boxMaxWidth :: CastDouble y => PaddedBox a Double -> LayoutItem y Length x -> LayoutItem y Length x boxMaxWidth parent (LayoutFlow val self childs) = LayoutFlow val self' childs' where @@ -132,6 +147,7 @@ boxMaxWidth parent (LayoutGrid val self cells childs) = LayoutGrid val self cell boxMaxWidth parent self@(LayoutInline _ _ _ _ _) = self boxMaxWidth parent self@(LayoutInline' _ _ _ _ _) = self boxMaxWidth parent self@(LayoutSpan _ f self') = self +-- | Update a (sub)tree to compute & cache final width. boxWidth :: (Zero y, CastDouble y) => PaddedBox b Double -> LayoutItem y Length x -> LayoutItem y Double x boxWidth parent (LayoutFlow val self childs) = LayoutFlow val self' childs' @@ -161,6 +177,7 @@ boxWidth parent (LayoutInline val font (Paragraph a b c d) paging vals) = boxWidth _ (LayoutInline' a b c d e) = LayoutInline' a b c d e boxWidth parent (LayoutSpan val font self') = LayoutSpan val font self' +-- | Update a (sub)tree to compute & cache ideal legible height. boxNatHeight :: Double -> LayoutItem Length Double x -> LayoutItem Length Double x boxNatHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs' where @@ -178,6 +195,7 @@ boxNatHeight parent (LayoutGrid val self cells childs) = LayoutGrid val self' ce boxNatHeight parent self@(LayoutInline _ _ _ _ _) = self boxNatHeight parent self@(LayoutInline' _ _ _ _ _) = self boxNatHeight parent self@(LayoutSpan _ _ _) = self +-- | Update a (sub)tree to compute & cache minimum legible height. boxMinHeight :: Double -> LayoutItem Length Double x -> LayoutItem Length Double x boxMinHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs' where @@ -197,6 +215,7 @@ boxMinHeight parent (LayoutGrid val self cells childs) = LayoutGrid val self' ce boxMinHeight parent self@(LayoutInline _ _ _ _ _) = self boxMinHeight _ self@(LayoutInline' _ _ _ _ _) = self boxMinHeight parent self@(LayoutSpan _ font self') = self +-- | Update a subtree to compute & cache maximum legible height. boxMaxHeight :: PaddedBox Double Double -> LayoutItem Length Double x -> LayoutItem Length Double x boxMaxHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs' @@ -219,6 +238,7 @@ boxMaxHeight parent (LayoutInline val font self' paging vals) = boxMaxHeight parent (LayoutInline' val font self' paging vals) = LayoutInline' val font self' paging vals boxMaxHeight parent (LayoutSpan val font self') = LayoutSpan val font self' +-- | Update a (sub)tree to compute & cache final height. boxHeight :: PaddedBox Double Double -> LayoutItem Length Double x -> LayoutItem Double Double x boxHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs' where @@ -250,6 +270,8 @@ boxHeight _ (LayoutInline' val font self' paging vals) = LayoutInline' val font self' paging vals boxHeight _ (LayoutSpan val font self') = LayoutSpan val font self' +-- | Split a (sub)tree to fit within max-height. +-- May take full page height into account. boxSplit :: PropertyParser x => Double -> Double -> LayoutItem Double Double x -> (LayoutItem Double Double x, Maybe (LayoutItem Double Double x)) boxSplit maxheight _ node | height (layoutGetBox node) <= maxheight = (node, Nothing) @@ -286,11 +308,13 @@ boxSplit maxheight pageheight (LayoutInline' a b self paging c) = where wrap self' = LayoutInline' a b self' paging c boxSplit _ _ self@(LayoutSpan _ _ _) = (self, Nothing) -- Can't split! +-- | Generate a list of pages from a node, splitting subtrees where necessary. boxPaginate pageheight node | (page, Just overflow) <- boxSplit pageheight pageheight node = page:boxPaginate pageheight overflow | otherwise = [node] +-- | Compute position of all nodes in the (sub)tree relative to a base coordinate. boxPosition :: PropertyParser x => (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' @@ -310,6 +334,7 @@ boxPosition pos@(x, y) (LayoutInline' val font self paging vals) = LayoutInline' (pos, val) font self paging $ map (\(x, y) -> (fragmentPos font pos y, x)) $ layoutChildren vals self boxPosition pos (LayoutSpan val f self) = LayoutSpan (pos, val) f self -- No children... +-- | Compute sizes & position information for all nodes in the (sub)tree. boxLayout :: PropertyParser x => PaddedBox Double Double -> LayoutItem Length Length x -> Bool -> [LayoutItem Double Double ((Double, Double), x)] boxLayout parent self paginate = self9 @@ -326,6 +351,8 @@ boxLayout parent self paginate = self9 | otherwise = [self7] self9 = map (boxPosition (0, 0)) self8 +-- | Compute a mapping from a layout tree indicating which glyphs for which fonts +-- are required. -- Useful for assembling glyph atlases. glyphsPerFont :: LayoutItem x y z -> M.Map (Pattern, Double) IS.IntSet glyphsPerFont (LayoutSpan _ font self) = diff --git a/Graphics/Layout/Box.hs b/Graphics/Layout/Box.hs index 666ff3a..a2122fa 100644 --- a/Graphics/Layout/Box.hs +++ b/Graphics/Layout/Box.hs @@ -32,8 +32,8 @@ data PaddedBox m n = PaddedBox { min :: Size m n, -- | The maximum amount of pixels this box should take. max :: Size m n, - -- --| The ideal number of pixels this box should take. - -- nat :: Size Double Double, -- FIXME Use seperate field for natsize. + -- | The ideal number of pixels this box should take. + nat :: Size Double Double, -- | The amount of pixels this box should take. size :: Size m n, -- | The amount of space between the box & the border. @@ -48,6 +48,7 @@ zeroBox :: PaddedBox Double Double zeroBox = PaddedBox { min = Size 0 0, max = Size 0 0, + nat = Size 0 0, size = Size 0 0, padding = Border 0 0 0 0, border = Border 0 0 0 0, @@ -58,6 +59,7 @@ lengthBox :: PaddedBox Length Length lengthBox = PaddedBox { min = Size Auto Auto, max = Size Auto Auto, + nat = Size 0 0, size = Size Auto Auto, padding = Border zero zero zero zero, border = Border zero zero zero zero, @@ -69,6 +71,7 @@ mapX' :: (n -> nn) -> PaddedBox m n -> PaddedBox m nn mapX' cb PaddedBox {..} = PaddedBox { min = Size (cb $ inline min) (block min), size = Size (cb $ inline size) (block size), + nat = Size 0 0, max = Size (cb $ inline max) (block max), padding = mapX cb padding, border = mapX cb border, @@ -79,6 +82,7 @@ mapY' :: (m -> mm) -> PaddedBox m n -> PaddedBox mm n mapY' cb PaddedBox {..} = PaddedBox { min = Size (inline min) (cb $ block min), size = Size (inline size) (cb $ block size), + nat = Size 0 0, max = Size (inline max) (cb $ block max), padding = mapY cb padding, border = mapY cb border, @@ -137,6 +141,7 @@ instance (Zero m, Zero n) => Zero (PaddedBox m n) where zero = PaddedBox { min = Size zero zero, max = Size zero zero, + nat = Size 0 0, size = Size zero zero, padding = Border zero zero zero zero, border = Border zero zero zero zero, diff --git a/Graphics/Layout/CSS.hs b/Graphics/Layout/CSS.hs index c1a73bd..a443061 100644 --- a/Graphics/Layout/CSS.hs +++ b/Graphics/Layout/CSS.hs @@ -62,6 +62,7 @@ instance PropertyParser a => PropertyParser (CSSBox a) where cssBox = PaddedBox { B.min = Size auto auto, size = Size auto auto, + nat = Size 0 0, B.max = Size auto auto, padding = noborder, border = noborder, diff --git a/Graphics/Layout/Flow.hs b/Graphics/Layout/Flow.hs index c7dc29f..6661969 100644 --- a/Graphics/Layout/Flow.hs +++ b/Graphics/Layout/Flow.hs @@ -75,7 +75,7 @@ flowHeight parent self | otherwise = small where small = flowMinHeight (block $ B.min parent) self - natural = flowNatHeight (block $ size parent) self [] + natural = flowNatHeight (block $ B.nat parent) self [] large = flowMaxHeight (block $ B.max parent) self -- | Compute position of all children relative to this block element. -- 2.30.2