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