3 files changed, 30 insertions(+), 8 deletions(-)

M src/Data/Text/ParagraphLayout/Internal/Layout.hs
M src/Data/Text/ParagraphLayout/Internal/ProtoFragment.hs
M src/Data/Text/ParagraphLayout/Internal/ProtoLine.hs

@@ 114,8 114,10 @@ positionLineH dir align maxWidth originY (num, pl) = (nextY, frags)
     where
         nextY = minimum $ fmap y_min rects
         rects = fmap (\ (WithSpan _ r) -> fragmentRect r) frags
-        (_, frags) = mapAccumL (positionFragmentH num originY) originX wpfs
-        wpfs = PL.applyBoxes pl
+        (_, frags) = mapAccumL (positionFragmentH num) originX wpfs
+        wpfs = PL.applyBoxes verticallyAlignedLine
+        verticallyAlignedLine = PL.mapFragments setOrigin pl
+        setOrigin = PF.mapVerticalOffsets (VO.alignLayoutTop originY)
         originX = paragraphOriginX + if lineWidth > maxWidth
             then overflowingLineOffset dir (lineWidth - maxWidth)
             else fittingLineOffset align dir (maxWidth - lineWidth)


@@ 155,12 157,11 @@ rightAlignOffset slack = slack
 centreAlignOffset :: Int32 -> Int32
 centreAlignOffset slack = slack `div` 2
 
--- | Position the given horizontal fragment on a line,
--- using @originY@ as its top edge and @originX@ as its left edge,
--- returning the X coordinate of its right edge for continuation.
-positionFragmentH :: Int -> Int32 -> Int32 -> ProtoFragmentWithBoxes d ->
+-- | Position the given horizontal fragment on a line, using @originX@ as its
+-- left edge, returning the X coordinate of its right edge for continuation.
+positionFragmentH :: Int -> Int32 -> ProtoFragmentWithBoxes d ->
     (Int32, FragmentWithSpan d)
-positionFragmentH line originY originX (WithBoxes lbs (WithSpan rs pf) rbs) =
+positionFragmentH line originX (WithBoxes lbs (WithSpan rs pf) rbs) =
     (nextX, WithSpan rs frag)
     where
         nextX = contentX + contentWidth + rightSpacing


@@ 189,7 190,7 @@ positionFragmentH line originY originX (WithBoxes lbs (WithSpan rs pf) rbs) =
             , VO.baseline = baseline
             , VO.fontBottom = fontBottom
             , VO.layoutBottom = layoutBottom
-            } = VO.alignLayoutTop originY $ PF.verticalOffsets pf
+            } = PF.verticalOffsets pf
 
 ancestorBoxes
     :: [RB.ResolvedBox d]

@@ 1,6 1,7 @@
 module Data.Text.ParagraphLayout.Internal.ProtoFragment
     ( ProtoFragment (direction, verticalOffsets, advance, glyphs, hardBreak)
     , protoFragmentH
+    , mapVerticalOffsets
     )
 where
 


@@ 40,5 41,13 @@ protoFragmentH dir lvl vo gs hard = ProtoFragment dir lvl vo adv gs hard
     where
         adv = sum $ map (x_advance . snd) gs
 
+-- | Apply the given function to the `verticalOffsets` in the given fragment.
+mapVerticalOffsets
+    :: (VO.VerticalOffsets -> VO.VerticalOffsets)
+    -> ProtoFragment
+    -> ProtoFragment
+mapVerticalOffsets mapFunc pf =
+    pf { verticalOffsets = mapFunc $ verticalOffsets pf }
+
 instance BiDi.WithLevel ProtoFragment where
     level = level -- BiDi.level = ProtoFragment.level

@@ 4,6 4,7 @@ module Data.Text.ParagraphLayout.Internal.ProtoLine
     , visible
     , width
     , applyBoxes
+    , mapFragments
     )
 where
 


@@ 93,3 94,14 @@ boxesStart pl = allBoxes (protoFragments pl) `diff` prevOpenBoxes pl
 -- | Boxes that end on the given line.
 boxesEnd :: (Foldable f, Functor f) => ProtoLine f d -> [ResolvedBox d]
 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
+mapFragments mapFunc pl =
+    pl { protoFragments = fmap mapFunc' $ protoFragments pl }
+    where
+        mapFunc' (WithSpan rs pf) = WithSpan rs $ mapFunc pf