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

M balkon.cabal
M src/Data/Text/ParagraphLayout/Internal/Layout.hs
A src/Data/Text/ParagraphLayout/Internal/VerticalOffsets.hs

@@ 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,

@@ 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

@@ 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