From c5e25e2b7a77d3af82227c1151820c2f4ddc559f Mon Sep 17 00:00:00 2001 From: Jaro Date: Sun, 2 Jul 2023 14:17:30 +0200 Subject: [PATCH] Clean up vertical alignment code structure. --- .../Text/ParagraphLayout/Internal/Layout.hs | 119 ++++-------------- .../Internal/VerticalOffsets.hs | 103 ++++++++++++++- 2 files changed, 129 insertions(+), 93 deletions(-) diff --git a/src/Data/Text/ParagraphLayout/Internal/Layout.hs b/src/Data/Text/ParagraphLayout/Internal/Layout.hs index baa5708..0da52f9 100644 --- a/src/Data/Text/ParagraphLayout/Internal/Layout.hs +++ b/src/Data/Text/ParagraphLayout/Internal/Layout.hs @@ -17,11 +17,9 @@ import Data.Text.Glyphize ( Buffer (..) , ContentType (ContentTypeUnicode) , Direction (DirLTR, DirRTL, DirTTB, DirBTT) - , FontExtents (..) , GlyphInfo , GlyphPos , defaultBuffer - , fontExtentsForDir , shape ) import qualified Data.Text.ICU as BreakStatus (Line (Hard)) @@ -34,7 +32,6 @@ import Data.Text.ParagraphLayout.Internal.BoxOptions import Data.Text.ParagraphLayout.Internal.Break import Data.Text.ParagraphLayout.Internal.Fragment import Data.Text.ParagraphLayout.Internal.Line -import Data.Text.ParagraphLayout.Internal.LineHeight import Data.Text.ParagraphLayout.Internal.ParagraphAlignment import Data.Text.ParagraphLayout.Internal.ParagraphExtents import qualified Data.Text.ParagraphLayout.Internal.ProtoFragment as PF @@ -129,10 +126,23 @@ positionLineH dir align maxWidth originY (num, pl) = else fittingLineOffset align dir (maxWidth - lineWidth) lineWidth = PL.width pl +-- | Update vertical positions of all fragments on the line so that they +-- respect vertical alignment settings and fit on a line whose top coordinate +-- is @originY@. Also returns the bottom coordinate of the line. verticalAlignment :: Int32 -> PL.ProtoLine NonEmpty d -> (Int32, PL.ProtoLine NonEmpty d) verticalAlignment originY pl = (bottomY, PL.mapFragments setOrigin pl) where + setOrigin rs pf = + PF.mapVerticalOffsets (VO.alignBaseline (fragOffset rs)) pf + + fragOffset rs = case spanVO rs of + (Nothing, vo) -> rootOffset + VO.baseline vo + (Just b, vo) -> case boxVerticalAlignment $ RB.boxOptions b of + AlignLineTop -> boxTopOffset b + VO.baseline vo + AlignLineBottom -> boxBottomOffset b + VO.baseline vo + _ -> error "verticalAlignment: wrong box used as anchor" + bottomY = originY - finalLineHeight finalLineHeight = fittingTop - fittingBottom @@ -144,25 +154,20 @@ verticalAlignment originY pl = (bottomY, PL.mapFragments setOrigin pl) fittingBottom = minimum $ (:) rootBottom $ map ((fittingTop -) . boxHeight) topAlignedBoxes - rootTop = maximum $ fmap VO.layoutTop rootVOs - rootBottom = minimum $ fmap VO.layoutBottom rootVOs - rootVOs = map snd $ filter underRoot $ toList vors + rootTop = maximum $ fmap (VO.layoutTop . snd) rootVOs + rootBottom = minimum $ fmap (VO.layoutBottom . snd) rootVOs + rootVOs = filter VO.underRoot $ toList allVOs rootOffset = originY - fittingTop boxHeight b = boxTop b - boxBottom b - boxTop b = maximum $ map VO.layoutTop $ boxVOs b - boxBottom b = minimum $ map VO.layoutBottom $ boxVOs b - boxVOs b = map snd $ filter (underBox b) $ toList vors + boxTop b = maximum $ map (VO.layoutTop . snd) $ boxVOs b + boxBottom b = minimum $ map (VO.layoutBottom . snd) $ boxVOs b + boxVOs b = filter (VO.underBox b) $ toList allVOs -- How much to shift from baseline 0 so that layoutTop = originY? boxTopOffset b = originY - boxTop b -- How much to shift from baseline 0 so that layoutBottom = bottomY? boxBottomOffset b = bottomY - boxBottom b - underRoot (Nothing, _) = True - underRoot (Just _, _) = False - underBox _ (Nothing, _) = False - underBox b (Just x, _) = b == x - boxesOnLine = foldr RB.union [] $ fmap fragBoxes $ PL.protoFragments pl topAlignedBoxes = filter topAligned boxesOnLine bottomAlignedBoxes = filter bottomAligned boxesOnLine @@ -171,21 +176,13 @@ verticalAlignment originY pl = (bottomY, PL.mapFragments setOrigin pl) bottomAligned rb = boxVerticalAlignment (RB.boxOptions rb) == AlignLineBottom fragBoxes (WithSpan rs _) = RS.spanBoxes rs - vors = sconcat $ fmap vor $ PL.protoFragments pl - vor (WithSpan rs _) = - verticalOffsetsRecursiveStruts - (RS.spanTextOptions rs) - (RS.spanBoxes rs) - - setOrigin rs pf = - PF.mapVerticalOffsets (VO.alignBaseline (fragOffset rs pf)) pf - - fragOffset rs pf = case NonEmpty.head (vor (WithSpan rs pf)) of - (Nothing, vo) -> rootOffset + VO.baseline vo - (Just b, vo) -> case boxVerticalAlignment $ RB.boxOptions b of - AlignLineTop -> boxTopOffset b + VO.baseline vo - AlignLineBottom -> boxBottomOffset b + VO.baseline vo - _ -> error "verticalAlignment: wrong box used as anchor" + -- Struts may get duplicated in `allVOs`. + -- This should not be a problem since we are using idempotent functions. + allVOs = sconcat $ fmap fragStruttedVOs $ PL.protoFragments pl + fragStruttedVOs (WithSpan rs _) = spanStruttedVOs rs + spanVO rs = NonEmpty.head $ spanStruttedVOs rs + spanStruttedVOs rs = + VO.strutted (RS.spanTextOptions rs) (RS.spanBoxes rs) -- | Inline offset of the first fragment on a line that overflows. overflowingLineOffset :: Direction -> Int32 -> Int32 @@ -428,71 +425,9 @@ layoutRunH (WithSpan rs run) = WithSpan rs pf glyphs = shapeRun (WithSpan rs run) dir = runDirection run lvl = runLevel run - vo = verticalOffsets (RS.spanTextOptions rs) + vo = VO.fromText (RS.spanTextOptions rs) hard = runHardBreak run --- | Vertical offsets for the given fragment, with baseline set to 0. -verticalOffsets :: TextOptions -> VO.VerticalOffsets -verticalOffsets opts = VO.VerticalOffsets - { VO.layoutTop = ascent + topHalfLeading - , VO.fontTop = ascent - , VO.baseline = 0 - , VO.fontBottom = - descent - , VO.layoutBottom = - descent - bottomHalfLeading - } - where - -- non-negative leading values iff `lineHeight` > `normalLineHeight` - leading = lineHeight - normalLineHeight - topHalfLeading = -((-leading) `div` 2) - bottomHalfLeading = leading `div` 2 - -- `normalLineHeight` > 0 for horizontal fonts - normalLineHeight = ascent + descent - -- `ascent` >= 0 for horizontal fonts - ascent = ascender extents `fromMaybe` textAscender opts - -- `descent` >= 0 for horizontal fonts - descent = - (descender extents `fromMaybe` textDescender opts) - extents = fontExtentsForDir (textFont opts) (Just dir) - -- Actual shaped text direction may differ from the direction set in - -- `TextOptions` (for example RTL characters in a LTR box), but - -- HarfBuzz only distinguished horizontal and vertical extents, - -- so this should make no difference. - dir = textDirection opts - lineHeight = case textLineHeight opts of - Normal -> normalLineHeight - Absolute h -> h - --- | Vertical offsets for the given fragment, aligned recursively either to --- the root box or the nearest box with line-relative alignment, whichever is --- closer. --- --- Note: The font extents are calculated using the same direction for the whole --- ancestry path regardless of the actual direction of these boxes, but --- this should not matter for text that is only horizontal. -verticalOffsetsRecursive :: TextOptions -> [RB.ResolvedBox d] -> - (Maybe (RB.ResolvedBox d), VO.VerticalOffsets) -verticalOffsetsRecursive opts boxes = case boxes of - [] -> -- Inline content directly in the root box. - (Nothing, vo) - (b : bs) -> case boxVerticalAlignment $ RB.boxOptions b of - AlignLineTop -> (Just b, vo) - AlignLineBottom -> (Just b, vo) - AlignBaseline offset -> - let parentOpts = RB.boxParentTextOptions b - (anchor, parentVO) = verticalOffsetsRecursive parentOpts bs - in (anchor, VO.alignBaseline (VO.baseline parentVO + offset) vo) - where - vo = verticalOffsets opts - --- | Like `verticalOffsetsRecursive`, but also generate struts for every --- ancestor box. -verticalOffsetsRecursiveStruts :: TextOptions -> [RB.ResolvedBox d] -> - NonEmpty (Maybe (RB.ResolvedBox d), VO.VerticalOffsets) -verticalOffsetsRecursiveStruts opts [] = - verticalOffsetsRecursive opts [] :| [] -verticalOffsetsRecursiveStruts opts boxes@(b : bs) = - verticalOffsetsRecursive opts boxes <| - verticalOffsetsRecursiveStruts (RB.boxParentTextOptions b) bs - -- | Calculate layout for the given run independently of its position. shapeRun :: WithSpan d Run -> [(GlyphInfo, GlyphPos)] shapeRun (WithSpan rs run) = shape font buffer features diff --git a/src/Data/Text/ParagraphLayout/Internal/VerticalOffsets.hs b/src/Data/Text/ParagraphLayout/Internal/VerticalOffsets.hs index 4d156c6..9d5681a 100644 --- a/src/Data/Text/ParagraphLayout/Internal/VerticalOffsets.hs +++ b/src/Data/Text/ParagraphLayout/Internal/VerticalOffsets.hs @@ -1,11 +1,22 @@ module Data.Text.ParagraphLayout.Internal.VerticalOffsets ( VerticalOffsets (..) , alignBaseline - , shift + , fromText + , strutted + , underBox + , underRoot ) where import Data.Int (Int32) +import Data.List.NonEmpty (NonEmpty ((:|)), (<|)) +import Data.Maybe (fromMaybe) +import Data.Text.Glyphize (ascender, descender, fontExtentsForDir) + +import Data.Text.ParagraphLayout.Internal.BoxOptions +import Data.Text.ParagraphLayout.Internal.LineHeight +import Data.Text.ParagraphLayout.Internal.ResolvedBox +import Data.Text.ParagraphLayout.Internal.TextOptions -- | Metrics used for vertical alignment of text fragments. data VerticalOffsets = VerticalOffsets @@ -45,3 +56,93 @@ shift d vo = vo -- so that distances are preserved. alignBaseline :: Int32 -> VerticalOffsets -> VerticalOffsets alignBaseline x vo = shift (x - baseline vo) vo + +-- | Metrics calculated for a single text box, as if it existed alone +-- with its baseline at @0@. +fromText :: TextOptions -> VerticalOffsets +fromText opts = VerticalOffsets + { layoutTop = ascent + topHalfLeading + , fontTop = ascent + , baseline = 0 + , fontBottom = - descent + , layoutBottom = - descent - bottomHalfLeading + } + where + -- non-negative leading values iff `lineHeight` > `normalLineHeight` + leading = lineHeight - normalLineHeight + topHalfLeading = -((-leading) `div` 2) + bottomHalfLeading = leading `div` 2 + -- `normalLineHeight` > 0 for horizontal fonts + normalLineHeight = ascent + descent + -- `ascent` >= 0 for horizontal fonts + ascent = ascender extents `fromMaybe` textAscender opts + -- `descent` >= 0 for horizontal fonts + descent = - (descender extents `fromMaybe` textDescender opts) + extents = fontExtentsForDir (textFont opts) (Just dir) + -- Actual shaped text direction may differ from the direction set in + -- `TextOptions` (for example RTL characters in a LTR box), but + -- HarfBuzz only distinguished horizontal and vertical extents, + -- so this should make no difference. + dir = textDirection opts + lineHeight = case textLineHeight opts of + Normal -> normalLineHeight + Absolute h -> h + +-- | Metrics for a nested text fragment, with a defined relation either to +-- the root box or to a box with line-relative alignment. +type NestedVerticalOffsets d = (Maybe (ResolvedBox d), VerticalOffsets) + +-- | Test whether the given `NestedVerticalOffsets` are defined relative to +-- the root box. +underRoot :: NestedVerticalOffsets d -> Bool +underRoot (Nothing, _) = True +underRoot (Just _, _) = False + +-- | Test whether the given `NestedVerticalOffsets` are defined relative to +-- the given box. +-- +-- (Note that boxes are compared internally using `boxIndex`, and should +-- therefore only be compared with boxes created from the same input.) +underBox :: ResolvedBox d -> NestedVerticalOffsets d -> Bool +underBox _ (Nothing, _) = False +underBox b (Just x, _) = b == x + +-- | Metrics calculated for a text box nested within zero or more boxes. +-- +-- Vertical offsets will be recursively adjusted using the ancestor boxes' +-- properties, stopping once a box with line-relative alignment is reached, +-- if there is one. +-- +-- If recursion ends at the root, this function returns @(`Nothing`, vo)@, +-- where @vo@ is calculated such that the root baseline is at @0@. +-- +-- If recursion ends at a box with line-relative alignment, this function +-- returns @(`Just` b, vo)@, where @b@ is the box where recursion stopped +-- (root of the /aligned subtree/ in CSS terminology), and @vo@ is calculated +-- such that the baseline of @b@ is at @0@. +-- +-- Note: The font extents are calculated using the same direction for the whole +-- ancestry path regardless of the actual direction of these boxes, but +-- this should not matter for text that is only horizontal. +fromNestedText :: TextOptions -> [ResolvedBox d] -> NestedVerticalOffsets d +fromNestedText opts boxes = case boxes of + [] -> -- Inline content directly in the root box. + (Nothing, vo) + (b : bs) -> case boxVerticalAlignment $ boxOptions b of + AlignLineTop -> (Just b, vo) + AlignLineBottom -> (Just b, vo) + AlignBaseline offset -> + let parentOpts = boxParentTextOptions b + (anchor, parentVO) = fromNestedText parentOpts bs + in (anchor, alignBaseline (baseline parentVO + offset) vo) + where + vo = fromText opts + +-- | Metrics calculated for a text box nested within zero or more boxes, +-- plus metrics for each of its ancestor boxes, which can be used as struts +-- on lines where these boxes do not directly contain any text. +strutted :: TextOptions -> [ResolvedBox d] -> NonEmpty (NestedVerticalOffsets d) +strutted opts [] = + fromNestedText opts [] :| [] +strutted opts boxes@(b : bs) = + fromNestedText opts boxes <| strutted (boxParentTextOptions b) bs -- 2.30.2