From 924bcdcbb55270f059795fd87cb28dae6e6d05e7 Mon Sep 17 00:00:00 2001
From: Jaro <jaro@argonaut-constellation.org>
Date: Thu, 29 Jun 2023 11:26:41 +0200
Subject: [PATCH] Separate vertical alignment from horizontal positioning.

---
 .../Text/ParagraphLayout/Internal/Layout.hs     | 17 +++++++++--------
 .../ParagraphLayout/Internal/ProtoFragment.hs   |  9 +++++++++
 .../Text/ParagraphLayout/Internal/ProtoLine.hs  | 12 ++++++++++++
 3 files changed, 30 insertions(+), 8 deletions(-)

diff --git a/src/Data/Text/ParagraphLayout/Internal/Layout.hs b/src/Data/Text/ParagraphLayout/Internal/Layout.hs
index 39656ec..f57edf2 100644
--- a/src/Data/Text/ParagraphLayout/Internal/Layout.hs
+++ b/src/Data/Text/ParagraphLayout/Internal/Layout.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]
diff --git a/src/Data/Text/ParagraphLayout/Internal/ProtoFragment.hs b/src/Data/Text/ParagraphLayout/Internal/ProtoFragment.hs
index 7116e07..7223ea0 100644
--- a/src/Data/Text/ParagraphLayout/Internal/ProtoFragment.hs
+++ b/src/Data/Text/ParagraphLayout/Internal/ProtoFragment.hs
@@ -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
diff --git a/src/Data/Text/ParagraphLayout/Internal/ProtoLine.hs b/src/Data/Text/ParagraphLayout/Internal/ProtoLine.hs
index d5abd24..69499c1 100644
--- a/src/Data/Text/ParagraphLayout/Internal/ProtoLine.hs
+++ b/src/Data/Text/ParagraphLayout/Internal/ProtoLine.hs
@@ -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
-- 
2.30.2