From 7dc45d1deab5d7d7e967fe2056f322f0dabac0bc Mon Sep 17 00:00:00 2001 From: Jaro Date: Fri, 30 Jun 2023 18:20:25 +0200 Subject: [PATCH] Implement vertical alignment. BREAKING: Boxes now generate struts (CSS), which can make a line taller than is necessary to contain its fragments. --- .../Text/ParagraphLayout/Internal/Layout.hs | 108 ++++++++++++++++-- .../ParagraphLayout/Internal/ProtoLine.hs | 13 ++- .../Internal/VerticalOffsets.hs | 6 + 3 files changed, 111 insertions(+), 16 deletions(-) diff --git a/src/Data/Text/ParagraphLayout/Internal/Layout.hs b/src/Data/Text/ParagraphLayout/Internal/Layout.hs index d2983ed..926835b 100644 --- a/src/Data/Text/ParagraphLayout/Internal/Layout.hs +++ b/src/Data/Text/ParagraphLayout/Internal/Layout.hs @@ -11,6 +11,7 @@ import Data.List (mapAccumL) import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty, (<|)) import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe (fromMaybe) +import Data.Semigroup (sconcat) import Data.Text.Foreign (lengthWord8) import Data.Text.Glyphize ( Buffer (..) @@ -29,6 +30,7 @@ import qualified Data.Text.Lazy as Lazy import Data.Text.ParagraphLayout.Internal.AncestorBox import Data.Text.ParagraphLayout.Internal.ApplyBoxes import Data.Text.ParagraphLayout.Internal.BiDiReorder +import Data.Text.ParagraphLayout.Internal.BoxOptions import Data.Text.ParagraphLayout.Internal.Break import Data.Text.ParagraphLayout.Internal.Fragment import Data.Text.ParagraphLayout.Internal.LineHeight @@ -98,11 +100,6 @@ layoutLines maxWidth openBoxes runs = case nonEmpty rest of -- | Position all the given horizontal fragments on the same line, -- using @originY@ as its top edge, and return the bottom edge for continuation. --- --- Glyphs will be aligned by their ascent line, similar to the behaviour of --- @vertical-align: top@ in CSS. --- --- TODO: For rich text, allow other types of vertical alignment. positionLineH :: Direction -> ParagraphAlignment @@ -115,14 +112,71 @@ positionLineH dir align maxWidth originY (num, pl) = (nextY, frags) nextY = minimum $ fmap y_min rects rects = fmap (\ (WithSpan _ r) -> fragmentRect r) frags (_, frags) = mapAccumL (positionFragmentH num) originX wpfs - wpfs = PL.applyBoxes verticallyAlignedLine - verticallyAlignedLine = PL.mapFragments setOrigin pl - setOrigin = PF.mapVerticalOffsets (VO.alignLayoutTop originY) + wpfs = PL.applyBoxes $ verticalAlignment originY pl originX = paragraphOriginX + if lineWidth > maxWidth then overflowingLineOffset dir (lineWidth - maxWidth) else fittingLineOffset align dir (maxWidth - lineWidth) lineWidth = PL.width pl +verticalAlignment :: Int32 -> PL.ProtoLine NonEmpty d -> + PL.ProtoLine NonEmpty d +verticalAlignment originY pl = PL.mapFragments setOrigin pl + where + bottomY = originY - finalLineHeight + finalLineHeight = fittingTop - fittingBottom + + -- Firefox-like behaviour: + -- First extend the line upwards to fit bottom-aligned boxes, + -- then extend the line downwards to fit top-aligned boxes. + fittingTop = maximum $ (:) rootTop $ + map ((rootBottom +) . boxHeight) bottomAlignedBoxes + 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 + 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 + -- 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 + topAligned rb = + boxVerticalAlignment (RB.boxOptions rb) == AlignLineTop + bottomAligned rb = + boxVerticalAlignment (RB.boxOptions rb) == AlignLineBottom + fragBoxes (WithSpan rs _) = RS.spanBoxes rs + vors = sconcat $ fmap vor $ PL.protoFragments pl + vor (WithSpan rs pf) = + verticalOffsetsRecursiveStruts + (PF.direction pf) + (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" + -- | Inline offset of the first fragment on a line that overflows. overflowingLineOffset :: Direction -> Int32 -> Int32 overflowingLineOffset DirLTR _ = 0 @@ -364,12 +418,12 @@ layoutRunH (WithSpan rs run) = WithSpan rs pf glyphs = shapeRun (WithSpan rs run) dir = runDirection run lvl = runLevel run - vo = verticalOffsets (RS.spanTextOptions rs) dir + vo = verticalOffsets dir (RS.spanTextOptions rs) hard = runHardBreak run -- | Vertical offsets for the given fragment, with baseline set to 0. -verticalOffsets :: TextOptions -> Direction -> VO.VerticalOffsets -verticalOffsets opts dir = VO.VerticalOffsets +verticalOffsets :: Direction -> TextOptions -> VO.VerticalOffsets +verticalOffsets dir opts = VO.VerticalOffsets { VO.layoutTop = ascent + topHalfLeading , VO.fontTop = ascent , VO.baseline = 0 @@ -392,6 +446,38 @@ verticalOffsets opts dir = VO.VerticalOffsets 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 :: Direction -> TextOptions -> [RB.ResolvedBox d] -> + (Maybe (RB.ResolvedBox d), VO.VerticalOffsets) +verticalOffsetsRecursive dir 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 dir parentOpts bs + in (anchor, VO.alignBaseline (VO.baseline parentVO + offset) vo) + where + vo = verticalOffsets dir opts + +-- | Like `verticalOffsetsRecursive`, but also generate struts for every +-- ancestor box. +verticalOffsetsRecursiveStruts :: Direction -> TextOptions -> [RB.ResolvedBox d] + -> NonEmpty (Maybe (RB.ResolvedBox d), VO.VerticalOffsets) +verticalOffsetsRecursiveStruts dir opts [] = + verticalOffsetsRecursive dir opts [] :| [] +verticalOffsetsRecursiveStruts dir opts boxes@(b : bs) = + verticalOffsetsRecursive dir opts boxes <| + verticalOffsetsRecursiveStruts dir (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/ProtoLine.hs b/src/Data/Text/ParagraphLayout/Internal/ProtoLine.hs index 69499c1..3296fc7 100644 --- a/src/Data/Text/ParagraphLayout/Internal/ProtoLine.hs +++ b/src/Data/Text/ParagraphLayout/Internal/ProtoLine.hs @@ -97,11 +97,14 @@ boxesEnd pl = allBoxes (protoFragments pl) `diff` nextOpenBoxes pl -- | Apply a function to every fragment on the line. -- --- (`ResolvedSpan` is intentionally not passed to the mapping function, --- to avoid the need for recalculating `prevOpenBoxes` and `nextOpenBoxes`). -mapFragments :: Functor f => - (ProtoFragment -> ProtoFragment) -> ProtoLine f d -> ProtoLine f d +-- Note that `ResolvedSpan` cannot be changed in this manner and is +-- only provided on the input of the mapping function. +mapFragments + :: Functor f + => (ResolvedSpan d -> ProtoFragment -> ProtoFragment) + -> ProtoLine f d + -> ProtoLine f d mapFragments mapFunc pl = pl { protoFragments = fmap mapFunc' $ protoFragments pl } where - mapFunc' (WithSpan rs pf) = WithSpan rs $ mapFunc pf + mapFunc' (WithSpan rs pf) = WithSpan rs $ mapFunc rs pf diff --git a/src/Data/Text/ParagraphLayout/Internal/VerticalOffsets.hs b/src/Data/Text/ParagraphLayout/Internal/VerticalOffsets.hs index b5aab38..3a405ce 100644 --- a/src/Data/Text/ParagraphLayout/Internal/VerticalOffsets.hs +++ b/src/Data/Text/ParagraphLayout/Internal/VerticalOffsets.hs @@ -1,5 +1,6 @@ module Data.Text.ParagraphLayout.Internal.VerticalOffsets ( VerticalOffsets (..) + , alignBaseline , alignLayoutTop , shift ) @@ -45,3 +46,8 @@ shift d vo = vo -- so that distances are preserved. alignLayoutTop :: Int32 -> VerticalOffsets -> VerticalOffsets alignLayoutTop x vo = shift (x - layoutTop vo) vo + +-- | Set `baseline` to the given value and update all other coordinates +-- so that distances are preserved. +alignBaseline :: Int32 -> VerticalOffsets -> VerticalOffsets +alignBaseline x vo = shift (x - baseline vo) vo -- 2.30.2