From 1dd8f91e1ad98c2416182880edd26902f7e483c8 Mon Sep 17 00:00:00 2001 From: Jaro Date: Wed, 8 Mar 2023 18:37:36 +0100 Subject: [PATCH] Implement correct positioning of RTL runs. --- .../Text/ParagraphLayout/Internal/Plain.hs | 95 +++++++++++-------- .../ParagraphLayout/Internal/ProtoFragment.hs | 3 - 2 files changed, 55 insertions(+), 43 deletions(-) diff --git a/src/Data/Text/ParagraphLayout/Internal/Plain.hs b/src/Data/Text/ParagraphLayout/Internal/Plain.hs index 6c6cd1c..4fa5119 100644 --- a/src/Data/Text/ParagraphLayout/Internal/Plain.hs +++ b/src/Data/Text/ParagraphLayout/Internal/Plain.hs @@ -17,6 +17,7 @@ import Data.Text.Foreign (lengthWord8) import Data.Text.Glyphize (Buffer(..) ,ContentType(ContentTypeUnicode) + ,Direction(..) ,FontExtents(..) ,GlyphInfo ,GlyphPos(x_advance) @@ -69,10 +70,26 @@ layoutAndAlignLines :: Int32 -> [WithSpan Run] -> [WithSpan Fragment] layoutAndAlignLines maxWidth runs = frags where frags = concat fragsInLines - (_, fragsInLines) = mapAccumL alignLineH originY protoFragsInLines - protoFragsInLines = layoutLines maxWidth runs + (_, fragsInLines) = mapAccumL positionLineH originY canonicalLines + canonicalLines = map canonicalOrder logicalLines + logicalLines = layoutLines maxWidth runs originY = paragraphOriginY +-- | Reorder the given fragments from logical order to whatever order HarfBuzz +-- uses (LTR for horizontal text, TTB for vertical text), so that cluster order +-- is preserved even across runs. +canonicalOrder :: [WithSpan PF.ProtoFragment] -> [WithSpan PF.ProtoFragment] +canonicalOrder [] = [] +canonicalOrder pfs@((WithSpan _ headPF):_) = case PF.direction headPF of + -- TODO: Update for bidi. + Just DirLTR -> pfs + Just DirRTL -> reverse pfs + Just DirTTB -> pfs + Just DirBTT -> reverse pfs + -- If no guess can be made, use LTR. + -- TODO: Add explicit direction to input interface. + Nothing -> pfs + -- | Create a multi-line layout from the given runs, splitting them as -- necessary to fit within the requested line width. -- @@ -90,34 +107,37 @@ layoutLines maxWidth runs -- Something fits, the rest goes on the next line. = fitting : layoutLines maxWidth rest where - (fitting, rest) = tryAddRunsH maxWidth originX runs - overflowing = addRunsH originX runs - originX = paragraphOriginX + (fitting, rest) = layoutAndWrapRunsH maxWidth runs + overflowing = layoutRunsH runs -- TODO: Allow a run across multiple spans (e.g. if they only differ by colour). --- | Align all the given horizontal fragments vertically on the same line, +-- | 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. -alignLineH :: Int32 -> [WithSpan PF.ProtoFragment] -> +positionLineH :: Int32 -> [WithSpan PF.ProtoFragment] -> (Int32, [WithSpan Fragment]) -alignLineH originY pfs = (nextY, frags) +positionLineH originY pfs = (nextY, frags) where nextY = maximum $ map y_min rects rects = map (\(WithSpan _ r) -> fragmentRect r) frags - frags = map (alignFragmentH originY) pfs + frags = snd $ mapAccumL (positionFragmentH originY) originX pfs + originX = paragraphOriginX --- | Align the given horizontal fragment vertically on a line, --- using `originY` as its top edge. -alignFragmentH :: Int32 -> WithSpan PF.ProtoFragment -> WithSpan Fragment -alignFragmentH originY (WithSpan rs pf) = - WithSpan rs (Fragment rect (penX, penY) (PF.glyphs pf)) +-- | Position the given horizontal fragment on a line, +-- using `originY` as its top edge and `originX` as its left edge, +-- returning the X coordinate of its right edge for continuation. +positionFragmentH :: + Int32 -> Int32 -> WithSpan PF.ProtoFragment -> (Int32, WithSpan Fragment) +positionFragmentH originY originX (WithSpan rs pf) = (nextX, WithSpan rs frag) where - rect = Rect (PF.offset pf) originY (PF.advance pf) (-lineHeight) + nextX = originX + PF.advance pf + frag = Fragment rect (penX, penY) (PF.glyphs pf) + rect = Rect originX originY (PF.advance pf) (-lineHeight) penX = 0 penY = descent + leading `div` 2 - lineHeight lineHeight = case RS.spanLineHeight rs of @@ -130,21 +150,21 @@ alignFragmentH originY (WithSpan rs pf) = extents = fontExtentsForDir font (PF.direction pf) font = RS.spanFont rs --- | Like `addRunsH`, but break the input runs as necessary to prevent --- overflowing the maximum line width, +-- | Calculate layout for multiple horizontal runs, breaking them as necessary +-- to fit as much content as possible without exceeding the maximum line width, -- and return the remaining runs to be placed on other lines. -tryAddRunsH :: Int32 -> Int32 -> [WithSpan Run] -> +layoutAndWrapRunsH :: Int32 -> [WithSpan Run] -> ([WithSpan PF.ProtoFragment], [WithSpan Run]) -tryAddRunsH maxWidth currentX runs = +layoutAndWrapRunsH maxWidth runs = fromMaybe lastResortSplit $ listToMaybe validSplits where lastResortSplit = do let (runs1, runs2) = splitTextsAt8 1 runs - let (_, pfs) = mapAccumL addRunH currentX runs1 + let pfs = layoutRunsH runs1 (pfs, runs2) applySplit (runs1, runs2) = do - let (nextX, pfs) = mapAccumL addRunH currentX runs1 - if abs nextX <= maxWidth + let pfs = layoutRunsH runs1 + if totalAdvances pfs <= maxWidth then Just (pfs, runs2) else Nothing validSplits = catMaybes $ map applySplit splits @@ -152,6 +172,15 @@ tryAddRunsH maxWidth currentX runs = noSplit = (runs, []) hasContent = not . null . fst +-- | Calculate layout for multiple horizontal runs on the same line, without +-- any breaking. +layoutRunsH :: [WithSpan Run] -> [WithSpan PF.ProtoFragment] +layoutRunsH runs = map layoutRunH runs + +-- | Sum of all advances within the given fragments. +totalAdvances :: [WithSpan PF.ProtoFragment] -> Int32 +totalAdvances pfs = sum $ map (\(WithSpan _ pf) -> PF.advance pf) pfs + -- | Recursive function for finding all possible ways to split a list of runs -- into two on a valid line-breaking boundary, including the start of the first -- run and excluding the end of the last run. @@ -174,25 +203,11 @@ breakSplits closed (x:xs) = splits ++ breakSplits (x:closed) xs mapFunc ((x1, x2), _) = (reverse $ collapse $ x1 :| xs, collapse $ x2 :| closed) --- | Calculate layout for multiple runs on the same line and --- arrange them in one horizontal direction starting from the given x_offset. -addRunsH :: Int32 -> [WithSpan Run] -> [WithSpan PF.ProtoFragment] -addRunsH currentX runs = snd $ mapAccumL addRunH currentX runs - --- | Calculate layout for the given run, --- place the generated fragment horizontally at the given x_offset in a line, --- and return the final x_offset for continuation. -addRunH :: Int32 -> WithSpan Run -> (Int32, WithSpan PF.ProtoFragment) -addRunH currentX run = (nextX, WithSpan rs pf) - where - WithSpan rs pf = layoutRun currentX run - nextX = currentX + PF.advance pf - --- | Calculate layout for the given run and position it in a line. -layoutRun :: Int32 -> WithSpan Run -> WithSpan PF.ProtoFragment -layoutRun originX (WithSpan rs run) = WithSpan rs pf +-- | Calculate layout for the given horizontal run and attach extra information. +layoutRunH :: WithSpan Run -> WithSpan PF.ProtoFragment +layoutRunH (WithSpan rs run) = WithSpan rs pf where - pf = PF.ProtoFragment dir originX totalX glyphs + pf = PF.ProtoFragment dir totalX glyphs glyphs = shapeRun (WithSpan rs run) positions = map snd glyphs totalX = sum $ map x_advance positions diff --git a/src/Data/Text/ParagraphLayout/Internal/ProtoFragment.hs b/src/Data/Text/ParagraphLayout/Internal/ProtoFragment.hs index c21bd00..bd594aa 100644 --- a/src/Data/Text/ParagraphLayout/Internal/ProtoFragment.hs +++ b/src/Data/Text/ParagraphLayout/Internal/ProtoFragment.hs @@ -8,9 +8,6 @@ import Data.Text.Glyphize (Direction, GlyphInfo, GlyphPos) data ProtoFragment = ProtoFragment { direction :: Maybe Direction -- ^ Text direction, which is constant within a fragment. - , offset :: Int32 - -- ^ Distance from the start of the line, - -- depending on the text direction. , advance :: Int32 -- ^ Total advance of glyphs in this fragment, -- depending on the text direction. -- 2.30.2