VerticalOffsets.hs

module Data.Text.ParagraphLayout.Internal.VerticalOffsets
    ( VerticalOffsets (..)
    , alignBaseline
    , fromText
    , strutted
    , underBox
    , underRoot
    )
where

import Data.Int (Int32)
import Data.List.NonEmpty (NonEmpty ((:|)), (<|))
import Data.Maybe (fromMaybe)
import Data.Text.Glyphize (ascender, descender, fontExtentsForDir)

import Data.Text.ParagraphLayout.Internal.BoxOptions
import Data.Text.ParagraphLayout.Internal.LineHeight
import Data.Text.ParagraphLayout.Internal.ResolvedBox
import Data.Text.ParagraphLayout.Internal.TextOptions

-- | 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 `baseline` to the given value and update all other coordinates
-- so that distances are preserved.
alignBaseline :: Int32 -> VerticalOffsets -> VerticalOffsets
alignBaseline x vo = shift (x - baseline vo) vo

-- | Metrics calculated for a single text box, as if it existed alone
-- with its baseline at @0@.
fromText :: TextOptions -> VerticalOffsets
fromText opts = VerticalOffsets
    { layoutTop = ascent + topHalfLeading
    , fontTop = ascent
    , baseline = 0
    , fontBottom = - descent
    , 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 `fromMaybe` textAscender opts
        -- `descent` >= 0 for horizontal fonts
        descent = - (descender extents `fromMaybe` textDescender opts)
        extents = fontExtentsForDir (textFont opts) (Just dir)
        -- Actual shaped text direction may differ from the direction set in
        -- `TextOptions` (for example RTL characters in a LTR box), but
        -- HarfBuzz only distinguished horizontal and vertical extents,
        -- so this should make no difference.
        dir = textDirection opts
        lineHeight = case textLineHeight opts of
            Normal -> normalLineHeight
            Absolute h -> h

-- | Metrics for a nested text fragment, with a defined relation either to
-- the root box or to a box with line-relative alignment.
type NestedVerticalOffsets d = (Maybe (ResolvedBox d), VerticalOffsets)

-- | Test whether the given `NestedVerticalOffsets` are defined relative to
-- the root box.
underRoot :: NestedVerticalOffsets d -> Bool
underRoot (Nothing, _) = True
underRoot (Just _, _) = False

-- | Test whether the given `NestedVerticalOffsets` are defined relative to
-- the given box.
--
-- (Note that boxes are compared internally using `boxIndex`, and should
-- therefore only be compared with boxes created from the same input.)
underBox :: ResolvedBox d -> NestedVerticalOffsets d -> Bool
underBox _ (Nothing, _) = False
underBox b (Just x, _) = b == x

-- | Metrics calculated for a text box nested within zero or more boxes.
--
-- Vertical offsets will be recursively adjusted using the ancestor boxes'
-- properties, stopping once a box with line-relative alignment is reached,
-- if there is one.
--
-- If recursion ends at the root, this function returns @(`Nothing`, vo)@,
-- where @vo@ is calculated such that the root baseline is at @0@.
--
-- If recursion ends at a box with line-relative alignment, this function
-- returns @(`Just` b, vo)@, where @b@ is the box where recursion stopped
-- (root of the /aligned subtree/ in CSS terminology), and @vo@ is calculated
-- such that the baseline of @b@ is at @0@.
--
-- Note: The font extents are calculated using the same direction for the whole
--       ancestry path regardless of the actual direction of these boxes, but
--       this should not matter for text that is only horizontal.
fromNestedText :: TextOptions -> [ResolvedBox d] -> NestedVerticalOffsets d
fromNestedText opts boxes = case boxes of
    [] -> -- Inline content directly in the root box.
        (Nothing, vo)
    (b : bs) -> case boxVerticalAlignment $ boxOptions b of
        AlignLineTop -> (Just b, vo)
        AlignLineBottom -> (Just b, vo)
        AlignBaseline offset ->
            let parentOpts = boxParentTextOptions b
                (anchor, parentVO) = fromNestedText parentOpts bs
            in (anchor, alignBaseline (baseline parentVO + offset) vo)
    where
        vo = fromText opts

-- | Metrics calculated for a text box nested within zero or more boxes,
-- plus metrics for each of its ancestor boxes, which can be used as struts
-- on lines where these boxes do not directly contain any text.
strutted :: TextOptions -> [ResolvedBox d] -> NonEmpty (NestedVerticalOffsets d)
strutted opts [] =
    fromNestedText opts [] :| []
strutted opts boxes@(b : bs) =
    fromNestedText opts boxes <| strutted (boxParentTextOptions b) bs