From 0cf536ef34fcaf0c4f02e9dd4dc47523a47f631f Mon Sep 17 00:00:00 2001
From: Jaro <jaro@argonaut-constellation.org>
Date: Wed, 28 Jun 2023 20:41:46 +0200
Subject: [PATCH] Add internal structure for vertical offsets.

---
 balkon.cabal                                  |  3 +-
 .../Text/ParagraphLayout/Internal/Layout.hs   | 38 ++++++++++++---
 .../Internal/VerticalOffsets.hs               | 47 +++++++++++++++++++
 3 files changed, 80 insertions(+), 8 deletions(-)
 create mode 100644 src/Data/Text/ParagraphLayout/Internal/VerticalOffsets.hs

diff --git a/balkon.cabal b/balkon.cabal
index 7f37069..2bc7050 100644
--- a/balkon.cabal
+++ b/balkon.cabal
@@ -144,7 +144,8 @@ library balkon-internal
         Data.Text.ParagraphLayout.Internal.ProtoLine,
         Data.Text.ParagraphLayout.Internal.ProtoRun,
         Data.Text.ParagraphLayout.Internal.Script,
-        Data.Text.ParagraphLayout.Internal.SplitList
+        Data.Text.ParagraphLayout.Internal.SplitList,
+        Data.Text.ParagraphLayout.Internal.VerticalOffsets
 
     build-depends:
         base >=4.12 && < 4.16,
diff --git a/src/Data/Text/ParagraphLayout/Internal/Layout.hs b/src/Data/Text/ParagraphLayout/Internal/Layout.hs
index 4cfe0fc..87b0567 100644
--- a/src/Data/Text/ParagraphLayout/Internal/Layout.hs
+++ b/src/Data/Text/ParagraphLayout/Internal/Layout.hs
@@ -43,6 +43,7 @@ import Data.Text.ParagraphLayout.Internal.Run
 import Data.Text.ParagraphLayout.Internal.SplitList
 import Data.Text.ParagraphLayout.Internal.TextContainer
 import Data.Text.ParagraphLayout.Internal.TextOptions
+import qualified Data.Text.ParagraphLayout.Internal.VerticalOffsets as VO
 import Data.Text.ParagraphLayout.Internal.WithSpan
 
 -- This is redundant.
@@ -178,19 +179,42 @@ positionFragmentH line originY originX (WithBoxes lbs (WithSpan rs pf) rbs) =
             }
         userData = RS.spanUserData rs
         bs = ancestorBoxes lbs rbs rs
-        contentRect = Rect contentX contentY contentWidth (-normalLineHeight)
-        contentY = originY + penY + ascent
-        rect = Rect contentX originY contentWidth (-lineHeight)
+        contentRect = Rect contentX fontTop contentWidth (fontBottom - fontTop)
+        rect = Rect contentX layoutTop contentWidth (layoutBottom - layoutTop)
         penX = 0
-        penY = descent + leading `div` 2 - lineHeight
-        lineHeight = case textLineHeight opts of
-            Normal -> normalLineHeight
-            Absolute h -> h
+        penY = baseline - layoutTop
+        VO.VerticalOffsets
+            { VO.layoutTop = layoutTop
+            , VO.fontTop = fontTop
+            , 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
 
 ancestorBoxes
diff --git a/src/Data/Text/ParagraphLayout/Internal/VerticalOffsets.hs b/src/Data/Text/ParagraphLayout/Internal/VerticalOffsets.hs
new file mode 100644
index 0000000..b5aab38
--- /dev/null
+++ b/src/Data/Text/ParagraphLayout/Internal/VerticalOffsets.hs
@@ -0,0 +1,47 @@
+module Data.Text.ParagraphLayout.Internal.VerticalOffsets
+    ( VerticalOffsets (..)
+    , alignLayoutTop
+    , shift
+    )
+where
+
+import Data.Int (Int32)
+
+-- | Metrics used for vertical alignment of text fragments.
+data VerticalOffsets = VerticalOffsets
+
+    { layoutTop :: Int32
+    -- ^ Y coordinate of the top edge of the fragment,
+    -- including half-leading.
+
+    , fontTop :: Int32
+    -- ^ Y coordinate of the font's ascender.
+
+    , baseline :: Int32
+    -- ^ Y coordinate of the font's baseline.
+
+    , fontBottom :: Int32
+    -- ^ Y coordinate of the font's descender.
+
+    , layoutBottom :: Int32
+    -- ^ Y coordinate of the bottom edge of the fragment,
+    -- including half-leading.
+
+    }
+    deriving (Eq, Show)
+
+-- | Add a constant to each of the coordinates, effectively moving them
+-- up by the given amount while preserving distances between them.
+shift :: Int32 -> VerticalOffsets -> VerticalOffsets
+shift d vo = vo
+    { layoutTop = layoutTop vo + d
+    , fontTop = fontTop vo + d
+    , baseline = baseline vo + d
+    , fontBottom = fontBottom vo + d
+    , layoutBottom = layoutBottom vo + d
+    }
+
+-- | Set `layoutTop` to the given value and update all other coordinates
+-- so that distances are preserved.
+alignLayoutTop :: Int32 -> VerticalOffsets -> VerticalOffsets
+alignLayoutTop x vo = shift (x - layoutTop vo) vo
-- 
2.30.2