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