@@ 11,6 11,7 @@ import Data.List (mapAccumL)
import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty, (<|))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Maybe (fromMaybe)
+import Data.Semigroup (sconcat)
import Data.Text.Foreign (lengthWord8)
import Data.Text.Glyphize
( Buffer (..)
@@ 29,6 30,7 @@ import qualified Data.Text.Lazy as Lazy
import Data.Text.ParagraphLayout.Internal.AncestorBox
import Data.Text.ParagraphLayout.Internal.ApplyBoxes
import Data.Text.ParagraphLayout.Internal.BiDiReorder
+import Data.Text.ParagraphLayout.Internal.BoxOptions
import Data.Text.ParagraphLayout.Internal.Break
import Data.Text.ParagraphLayout.Internal.Fragment
import Data.Text.ParagraphLayout.Internal.LineHeight
@@ 98,11 100,6 @@ layoutLines maxWidth openBoxes runs = case nonEmpty rest of
-- | Position all the given horizontal fragments on the same line,
-- using @originY@ as its top edge, and return the bottom edge for continuation.
---
--- Glyphs will be aligned by their ascent line, similar to the behaviour of
--- @vertical-align: top@ in CSS.
---
--- TODO: For rich text, allow other types of vertical alignment.
positionLineH
:: Direction
-> ParagraphAlignment
@@ 115,14 112,71 @@ positionLineH dir align maxWidth originY (num, pl) = (nextY, frags)
nextY = minimum $ fmap y_min rects
rects = fmap (\ (WithSpan _ r) -> fragmentRect r) frags
(_, frags) = mapAccumL (positionFragmentH num) originX wpfs
- wpfs = PL.applyBoxes verticallyAlignedLine
- verticallyAlignedLine = PL.mapFragments setOrigin pl
- setOrigin = PF.mapVerticalOffsets (VO.alignLayoutTop originY)
+ wpfs = PL.applyBoxes $ verticalAlignment originY pl
originX = paragraphOriginX + if lineWidth > maxWidth
then overflowingLineOffset dir (lineWidth - maxWidth)
else fittingLineOffset align dir (maxWidth - lineWidth)
lineWidth = PL.width pl
+verticalAlignment :: Int32 -> PL.ProtoLine NonEmpty d ->
+ PL.ProtoLine NonEmpty d
+verticalAlignment originY pl = PL.mapFragments setOrigin pl
+ where
+ bottomY = originY - finalLineHeight
+ finalLineHeight = fittingTop - fittingBottom
+
+ -- Firefox-like behaviour:
+ -- First extend the line upwards to fit bottom-aligned boxes,
+ -- then extend the line downwards to fit top-aligned boxes.
+ fittingTop = maximum $ (:) rootTop $
+ map ((rootBottom +) . boxHeight) bottomAlignedBoxes
+ 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
+ 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
+ -- 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
+ topAligned rb =
+ boxVerticalAlignment (RB.boxOptions rb) == AlignLineTop
+ bottomAligned rb =
+ boxVerticalAlignment (RB.boxOptions rb) == AlignLineBottom
+ fragBoxes (WithSpan rs _) = RS.spanBoxes rs
+ vors = sconcat $ fmap vor $ PL.protoFragments pl
+ vor (WithSpan rs pf) =
+ verticalOffsetsRecursiveStruts
+ (PF.direction pf)
+ (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"
+
-- | Inline offset of the first fragment on a line that overflows.
overflowingLineOffset :: Direction -> Int32 -> Int32
overflowingLineOffset DirLTR _ = 0
@@ 364,12 418,12 @@ layoutRunH (WithSpan rs run) = WithSpan rs pf
glyphs = shapeRun (WithSpan rs run)
dir = runDirection run
lvl = runLevel run
- vo = verticalOffsets (RS.spanTextOptions rs) dir
+ vo = verticalOffsets dir (RS.spanTextOptions rs)
hard = runHardBreak run
-- | Vertical offsets for the given fragment, with baseline set to 0.
-verticalOffsets :: TextOptions -> Direction -> VO.VerticalOffsets
-verticalOffsets opts dir = VO.VerticalOffsets
+verticalOffsets :: Direction -> TextOptions -> VO.VerticalOffsets
+verticalOffsets dir opts = VO.VerticalOffsets
{ VO.layoutTop = ascent + topHalfLeading
, VO.fontTop = ascent
, VO.baseline = 0
@@ 392,6 446,38 @@ verticalOffsets opts dir = VO.VerticalOffsets
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 :: Direction -> TextOptions -> [RB.ResolvedBox d] ->
+ (Maybe (RB.ResolvedBox d), VO.VerticalOffsets)
+verticalOffsetsRecursive dir 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 dir parentOpts bs
+ in (anchor, VO.alignBaseline (VO.baseline parentVO + offset) vo)
+ where
+ vo = verticalOffsets dir opts
+
+-- | Like `verticalOffsetsRecursive`, but also generate struts for every
+-- ancestor box.
+verticalOffsetsRecursiveStruts :: Direction -> TextOptions -> [RB.ResolvedBox d]
+ -> NonEmpty (Maybe (RB.ResolvedBox d), VO.VerticalOffsets)
+verticalOffsetsRecursiveStruts dir opts [] =
+ verticalOffsetsRecursive dir opts [] :| []
+verticalOffsetsRecursiveStruts dir opts boxes@(b : bs) =
+ verticalOffsetsRecursive dir opts boxes <|
+ verticalOffsetsRecursiveStruts dir (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
@@ 97,11 97,14 @@ boxesEnd pl = allBoxes (protoFragments pl) `diff` nextOpenBoxes pl
-- | Apply a function to every fragment on the line.
--
--- (`ResolvedSpan` is intentionally not passed to the mapping function,
--- to avoid the need for recalculating `prevOpenBoxes` and `nextOpenBoxes`).
-mapFragments :: Functor f =>
- (ProtoFragment -> ProtoFragment) -> ProtoLine f d -> ProtoLine f d
+-- Note that `ResolvedSpan` cannot be changed in this manner and is
+-- only provided on the input of the mapping function.
+mapFragments
+ :: Functor f
+ => (ResolvedSpan d -> ProtoFragment -> ProtoFragment)
+ -> ProtoLine f d
+ -> ProtoLine f d
mapFragments mapFunc pl =
pl { protoFragments = fmap mapFunc' $ protoFragments pl }
where
- mapFunc' (WithSpan rs pf) = WithSpan rs $ mapFunc pf
+ mapFunc' (WithSpan rs pf) = WithSpan rs $ mapFunc rs pf
@@ 1,5 1,6 @@
module Data.Text.ParagraphLayout.Internal.VerticalOffsets
( VerticalOffsets (..)
+ , alignBaseline
, alignLayoutTop
, shift
)
@@ 45,3 46,8 @@ shift d vo = vo
-- so that distances are preserved.
alignLayoutTop :: Int32 -> VerticalOffsets -> VerticalOffsets
alignLayoutTop x vo = shift (x - layoutTop vo) vo
+
+-- | 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