~jaro/balkon

c5e25e2b7a77d3af82227c1151820c2f4ddc559f — Jaro 9 months ago d5253a6
Clean up vertical alignment code structure.
M src/Data/Text/ParagraphLayout/Internal/Layout.hs => src/Data/Text/ParagraphLayout/Internal/Layout.hs +27 -92
@@ 17,11 17,9 @@ import Data.Text.Glyphize
    ( Buffer (..)
    , ContentType (ContentTypeUnicode)
    , Direction (DirLTR, DirRTL, DirTTB, DirBTT)
    , FontExtents (..)
    , GlyphInfo
    , GlyphPos
    , defaultBuffer
    , fontExtentsForDir
    , shape
    )
import qualified Data.Text.ICU as BreakStatus (Line (Hard))


@@ 34,7 32,6 @@ import Data.Text.ParagraphLayout.Internal.BoxOptions
import Data.Text.ParagraphLayout.Internal.Break
import Data.Text.ParagraphLayout.Internal.Fragment
import Data.Text.ParagraphLayout.Internal.Line
import Data.Text.ParagraphLayout.Internal.LineHeight
import Data.Text.ParagraphLayout.Internal.ParagraphAlignment
import Data.Text.ParagraphLayout.Internal.ParagraphExtents
import qualified Data.Text.ParagraphLayout.Internal.ProtoFragment as PF


@@ 129,10 126,23 @@ positionLineH dir align maxWidth originY (num, pl) =
            else fittingLineOffset align dir (maxWidth - lineWidth)
        lineWidth = PL.width pl

-- | Update vertical positions of all fragments on the line so that they
-- respect vertical alignment settings and fit on a line whose top coordinate
-- is @originY@. Also returns the bottom coordinate of the line.
verticalAlignment :: Int32 -> PL.ProtoLine NonEmpty d ->
    (Int32, PL.ProtoLine NonEmpty d)
verticalAlignment originY pl = (bottomY, PL.mapFragments setOrigin pl)
    where
        setOrigin rs pf =
            PF.mapVerticalOffsets (VO.alignBaseline (fragOffset rs)) pf

        fragOffset rs = case spanVO rs of
            (Nothing, vo) -> rootOffset + VO.baseline vo
            (Just b, vo) -> case boxVerticalAlignment $ RB.boxOptions b of
                AlignLineTop -> boxTopOffset b + VO.baseline vo
                AlignLineBottom -> boxBottomOffset b + VO.baseline vo
                _ -> error "verticalAlignment: wrong box used as anchor"

        bottomY = originY - finalLineHeight
        finalLineHeight = fittingTop - fittingBottom



@@ 144,25 154,20 @@ verticalAlignment originY pl = (bottomY, PL.mapFragments setOrigin pl)
        fittingBottom = minimum $ (:) rootBottom $
            map ((fittingTop -) . boxHeight) topAlignedBoxes

        rootTop = maximum $ fmap VO.layoutTop rootVOs
        rootBottom = minimum $ fmap VO.layoutBottom rootVOs
        rootVOs = map snd $ filter underRoot $ toList vors
        rootTop = maximum $ fmap (VO.layoutTop . snd) rootVOs
        rootBottom = minimum $ fmap (VO.layoutBottom . snd) rootVOs
        rootVOs = filter VO.underRoot $ toList allVOs
        rootOffset = originY - fittingTop

        boxHeight b = boxTop b - boxBottom b
        boxTop b = maximum $ map VO.layoutTop $ boxVOs b
        boxBottom b = minimum $ map VO.layoutBottom $ boxVOs b
        boxVOs b = map snd $ filter (underBox b) $ toList vors
        boxTop b = maximum $ map (VO.layoutTop . snd) $ boxVOs b
        boxBottom b = minimum $ map (VO.layoutBottom . snd) $ boxVOs b
        boxVOs b = filter (VO.underBox b) $ toList allVOs
        -- How much to shift from baseline 0 so that layoutTop = originY?
        boxTopOffset b = originY - boxTop b
        -- How much to shift from baseline 0 so that layoutBottom = bottomY?
        boxBottomOffset b = bottomY - boxBottom b

        underRoot (Nothing, _) = True
        underRoot (Just _, _) = False
        underBox _ (Nothing, _) = False
        underBox b (Just x, _) = b == x

        boxesOnLine = foldr RB.union [] $ fmap fragBoxes $ PL.protoFragments pl
        topAlignedBoxes = filter topAligned boxesOnLine
        bottomAlignedBoxes = filter bottomAligned boxesOnLine


@@ 171,21 176,13 @@ verticalAlignment originY pl = (bottomY, PL.mapFragments setOrigin pl)
        bottomAligned rb =
            boxVerticalAlignment (RB.boxOptions rb) == AlignLineBottom
        fragBoxes (WithSpan rs _) = RS.spanBoxes rs
        vors = sconcat $ fmap vor $ PL.protoFragments pl
        vor (WithSpan rs _) =
            verticalOffsetsRecursiveStruts
                (RS.spanTextOptions rs)
                (RS.spanBoxes rs)

        setOrigin rs pf =
            PF.mapVerticalOffsets (VO.alignBaseline (fragOffset rs pf)) pf

        fragOffset rs pf = case NonEmpty.head (vor (WithSpan rs pf)) of
            (Nothing, vo) -> rootOffset + VO.baseline vo
            (Just b, vo) -> case boxVerticalAlignment $ RB.boxOptions b of
                AlignLineTop -> boxTopOffset b + VO.baseline vo
                AlignLineBottom -> boxBottomOffset b + VO.baseline vo
                _ -> error "verticalAlignment: wrong box used as anchor"
        -- Struts may get duplicated in `allVOs`.
        -- This should not be a problem since we are using idempotent functions.
        allVOs = sconcat $ fmap fragStruttedVOs $ PL.protoFragments pl
        fragStruttedVOs (WithSpan rs _) = spanStruttedVOs rs
        spanVO rs = NonEmpty.head $ spanStruttedVOs rs
        spanStruttedVOs rs =
            VO.strutted (RS.spanTextOptions rs) (RS.spanBoxes rs)

-- | Inline offset of the first fragment on a line that overflows.
overflowingLineOffset :: Direction -> Int32 -> Int32


@@ 428,71 425,9 @@ layoutRunH (WithSpan rs run) = WithSpan rs pf
        glyphs = shapeRun (WithSpan rs run)
        dir = runDirection run
        lvl = runLevel run
        vo = verticalOffsets (RS.spanTextOptions rs)
        vo = VO.fromText (RS.spanTextOptions rs)
        hard = runHardBreak run

-- | Vertical offsets for the given fragment, with baseline set to 0.
verticalOffsets :: TextOptions -> VO.VerticalOffsets
verticalOffsets opts = 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 `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

-- | Vertical offsets for the given fragment, aligned recursively either to
-- the root box or the nearest box with line-relative alignment, whichever is
-- closer.
--
-- 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.
verticalOffsetsRecursive :: TextOptions -> [RB.ResolvedBox d] ->
    (Maybe (RB.ResolvedBox d), VO.VerticalOffsets)
verticalOffsetsRecursive opts boxes = case boxes of
    [] -> -- Inline content directly in the root box.
        (Nothing, vo)
    (b : bs) -> case boxVerticalAlignment $ RB.boxOptions b of
        AlignLineTop -> (Just b, vo)
        AlignLineBottom -> (Just b, vo)
        AlignBaseline offset ->
            let parentOpts = RB.boxParentTextOptions b
                (anchor, parentVO) = verticalOffsetsRecursive parentOpts bs
            in (anchor, VO.alignBaseline (VO.baseline parentVO + offset) vo)
    where
        vo = verticalOffsets opts

-- | Like `verticalOffsetsRecursive`, but also generate struts for every
-- ancestor box.
verticalOffsetsRecursiveStruts :: TextOptions -> [RB.ResolvedBox d] ->
    NonEmpty (Maybe (RB.ResolvedBox d), VO.VerticalOffsets)
verticalOffsetsRecursiveStruts opts [] =
    verticalOffsetsRecursive opts [] :| []
verticalOffsetsRecursiveStruts opts boxes@(b : bs) =
    verticalOffsetsRecursive opts boxes <|
    verticalOffsetsRecursiveStruts (RB.boxParentTextOptions b) bs

-- | Calculate layout for the given run independently of its position.
shapeRun :: WithSpan d Run -> [(GlyphInfo, GlyphPos)]
shapeRun (WithSpan rs run) = shape font buffer features

M src/Data/Text/ParagraphLayout/Internal/VerticalOffsets.hs => src/Data/Text/ParagraphLayout/Internal/VerticalOffsets.hs +102 -1
@@ 1,11 1,22 @@
module Data.Text.ParagraphLayout.Internal.VerticalOffsets
    ( VerticalOffsets (..)
    , alignBaseline
    , shift
    , 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


@@ 45,3 56,93 @@ shift d vo = vo
-- 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