From 13b3a637336eb3490d6379a76472c90e54a1c01b Mon Sep 17 00:00:00 2001
From: Jaro <jaro@argonaut-constellation.org>
Date: Thu, 29 Jun 2023 05:33:49 +0200
Subject: [PATCH] Store vertical offsets inside ProtoFragment.

Intended to make these offsets manipulable during layout.
---
 .../Text/ParagraphLayout/Internal/Layout.hs   | 57 ++++++++++---------
 .../ParagraphLayout/Internal/ProtoFragment.hs | 16 ++++--
 2 files changed, 41 insertions(+), 32 deletions(-)

diff --git a/src/Data/Text/ParagraphLayout/Internal/Layout.hs b/src/Data/Text/ParagraphLayout/Internal/Layout.hs
index 87b0567..39656ec 100644
--- a/src/Data/Text/ParagraphLayout/Internal/Layout.hs
+++ b/src/Data/Text/ParagraphLayout/Internal/Layout.hs
@@ -189,33 +189,7 @@ positionFragmentH line originY originX (WithBoxes lbs (WithSpan rs pf) rbs) =
             , VO.baseline = baseline
             , VO.fontBottom = fontBottom
             , VO.layoutBottom = layoutBottom
-            } = VO.alignLayoutTop originY $ verticalOffsets (WithSpan rs pf)
-
--- | Vertical offsets for the given fragment, with baseline set to 0.
-verticalOffsets :: ProtoFragmentWithSpan d -> VO.VerticalOffsets
-verticalOffsets (WithSpan rs pf) = 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
-        -- `descent` >= 0 for horizontal fonts
-        descent = - descender extents
-        extents = fontExtentsForDir (textFont opts) (Just $ PF.direction pf)
-        lineHeight = case textLineHeight opts of
-            Normal -> normalLineHeight
-            Absolute h -> h
-        opts = RS.spanTextOptions rs
+            } = VO.alignLayoutTop originY $ PF.verticalOffsets pf
 
 ancestorBoxes
     :: [RB.ResolvedBox d]
@@ -385,12 +359,39 @@ layoutRunsH runs = fmap layoutRunH runs
 layoutRunH :: WithSpan d Run -> ProtoFragmentWithSpan d
 layoutRunH (WithSpan rs run) = WithSpan rs pf
     where
-        pf = PF.protoFragmentH dir lvl glyphs hard
+        pf = PF.protoFragmentH dir lvl vo glyphs hard
         glyphs = shapeRun (WithSpan rs run)
         dir = runDirection run
         lvl = runLevel run
+        vo = verticalOffsets rs dir
         hard = runHardBreak run
 
+-- | Vertical offsets for the given fragment, with baseline set to 0.
+verticalOffsets :: RS.ResolvedSpan d -> Direction -> VO.VerticalOffsets
+verticalOffsets rs dir = 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
+        -- `descent` >= 0 for horizontal fonts
+        descent = - descender extents
+        extents = fontExtentsForDir (textFont opts) (Just dir)
+        lineHeight = case textLineHeight opts of
+            Normal -> normalLineHeight
+            Absolute h -> h
+        opts = RS.spanTextOptions rs
+
 -- | 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/ProtoFragment.hs b/src/Data/Text/ParagraphLayout/Internal/ProtoFragment.hs
index fd3dd3d..7116e07 100644
--- a/src/Data/Text/ParagraphLayout/Internal/ProtoFragment.hs
+++ b/src/Data/Text/ParagraphLayout/Internal/ProtoFragment.hs
@@ -1,5 +1,5 @@
 module Data.Text.ParagraphLayout.Internal.ProtoFragment
-    ( ProtoFragment (direction, advance, glyphs, hardBreak)
+    ( ProtoFragment (direction, verticalOffsets, advance, glyphs, hardBreak)
     , protoFragmentH
     )
 where
@@ -8,6 +8,7 @@ import Data.Int (Int32)
 import Data.Text.Glyphize (Direction (..), GlyphInfo, GlyphPos (x_advance))
 
 import qualified Data.Text.ParagraphLayout.Internal.BiDiLevels as BiDi
+import qualified Data.Text.ParagraphLayout.Internal.VerticalOffsets as VO
 
 -- | A box fragment which has not been positioned yet.
 data ProtoFragment = ProtoFragment
@@ -16,6 +17,8 @@ data ProtoFragment = ProtoFragment
     , level :: BiDi.Level
     -- ^ BiDi embedding level.
     -- Should be even for LTR fragments and odd for RTL fragments.
+    , verticalOffsets :: VO.VerticalOffsets
+    -- ^ Vertical offsets used for aligning the fragment within its line.
     , advance :: Int32
     -- ^ Total advance of glyphs in this fragment,
     -- depending on the text direction.
@@ -26,9 +29,14 @@ data ProtoFragment = ProtoFragment
 
 -- | Construct a `ProtoFragment`, automatically calculating the total advance
 -- for a horizontal text direction.
-protoFragmentH :: Direction -> BiDi.Level -> [(GlyphInfo, GlyphPos)] -> Bool ->
-    ProtoFragment
-protoFragmentH dir lvl gs hard = ProtoFragment dir lvl adv gs hard
+protoFragmentH
+    :: Direction
+    -> BiDi.Level
+    -> VO.VerticalOffsets
+    -> [(GlyphInfo, GlyphPos)]
+    -> Bool
+    -> ProtoFragment
+protoFragmentH dir lvl vo gs hard = ProtoFragment dir lvl vo adv gs hard
     where
         adv = sum $ map (x_advance . snd) gs
 
-- 
2.30.2