From 0552e4817ad8e6eb582920c72dd62dc0dd50bfb4 Mon Sep 17 00:00:00 2001 From: Jaro Date: Tue, 7 Mar 2023 08:11:08 +0100 Subject: [PATCH] Represent line breaks directly without offsets. --- src/Data/Text/ParagraphLayout/Plain.hs | 97 +++++++++++++------------- 1 file changed, 48 insertions(+), 49 deletions(-) diff --git a/src/Data/Text/ParagraphLayout/Plain.hs b/src/Data/Text/ParagraphLayout/Plain.hs index 94405d8..59cda80 100644 --- a/src/Data/Text/ParagraphLayout/Plain.hs +++ b/src/Data/Text/ParagraphLayout/Plain.hs @@ -22,7 +22,9 @@ where import Data.Int (Int32) import Data.List (mapAccumL) -import Data.Maybe (fromMaybe, listToMaybe) +import Data.List.NonEmpty (NonEmpty((:|))) +import Data.Maybe (catMaybes, fromMaybe, listToMaybe) +import qualified Data.Text as Text import Data.Text.Array (Array) import Data.Text.Foreign (lengthWord8) import Data.Text.Glyphize @@ -115,10 +117,6 @@ getBySpanIndex idx xs = map contents $ filter matchingIndex $ xs matchingIndex (WithSpan rs _) = (RS.spanIndex rs) == idx contents (WithSpan _ x) = x -runOffsetInParagraph :: WithSpan Run -> Int -runOffsetInParagraph (WithSpan rs run) = - runOffsetInSpan run + RS.spanOffsetInParagraph rs - spanRects :: SpanLayout -> [Rect Int32] spanRects (SpanLayout frags) = map fragmentRect frags @@ -228,55 +226,49 @@ alignFragmentH originY (WithSpan rs pf) = tryAddRunsH :: Int32 -> Int32 -> [WithSpan Run] -> ([WithSpan PF.ProtoFragment], [WithSpan Run]) tryAddRunsH maxWidth currentX runs = - tryAddSplitRunsH maxWidth currentX runs totalLength + fromMaybe lastResortSplit $ listToMaybe validSplits where - totalLength = sum $ map (lengthWord8 . getText) runs - --- | Like `addRunsH`, but break the input runs at the given position, or closer --- to the start if necessary to prevent overflowing the maximum line width, --- and return the remaining runs to be placed on other lines. -tryAddSplitRunsH :: Int32 -> Int32 -> [WithSpan Run] -> Int -> - ([WithSpan PF.ProtoFragment], [WithSpan Run]) -tryAddSplitRunsH _ _ [] _ = ([], []) -tryAddSplitRunsH _ currentX runs 0 = do - -- Last resort splitting by character. - -- TODO: Split by glyph instead. - -- Note: The following auto-adjusts to UTF-8 code point boundary. - let (runs1, runs2) = splitTextsAt8 1 runs - let (_, pfs) = mapAccumL addRunH currentX runs1 - (pfs, runs2) -tryAddSplitRunsH maxWidth currentX runs breakPoint = do - -- TODO: Trim spaces around breaks. - let (runs1, runs2) = splitTextsAt8 breakPoint runs - let (nextX, pfs) = mapAccumL addRunH currentX runs1 - let next = nextBreakPoint breakPoint runs - if abs nextX <= maxWidth - then (pfs, runs2) - else tryAddSplitRunsH maxWidth currentX runs next - --- | Find the farthermost break point in one of the given runs, whose offset is --- less than the given limit, respecting locale rules. + lastResortSplit = do + let (runs1, runs2) = splitTextsAt8 1 runs + let (_, pfs) = mapAccumL addRunH currentX runs1 + (pfs, runs2) + applySplit (runs1, runs2) = do + let (nextX, pfs) = mapAccumL addRunH currentX runs1 + if abs nextX <= maxWidth + then Just (pfs, runs2) + else Nothing + validSplits = catMaybes $ map applySplit splits + splits = noSplit : (filter hasContent $ breakSplits [] (reverse runs)) + noSplit = (runs, []) + hasContent = not . null . fst + +-- | 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. -- --- The result will be an offset in `Word8` units from the start of the first --- `Run` from the list. +-- The first input list is the suffix consisting of runs that have already been +-- considered for breaking. These will be appended to the output suffix as they +-- are. -- --- If no breaks are possible, the result will be @0@. -nextBreakPoint :: Int -> [WithSpan Run] -> Int -nextBreakPoint _ [] = 0 -nextBreakPoint limit runs@(headRun:_) = fromMaybe 0 $ listToMaybe points +-- The second input list is the prefix consisting of runs to be considered for +-- breaking, in reverse order. +-- +-- The results in the form (prefix, suffix) will be ordered from the longest +-- prefix to shortest. +breakSplits :: [WithSpan Run] -> [WithSpan Run] -> + [([WithSpan Run], [WithSpan Run])] +breakSplits _ [] = [] +breakSplits closed (x:xs) = splits ++ breakSplits (x:closed) xs where - firstRunOffset = runOffsetInParagraph headRun - points = - dropWhile (>= limit) $ breakPoints firstRunOffset $ reverse runs + splits = map mapFunc $ runLineSplits x + mapFunc ((x1, x2), _) = + (reverse $ collapse $ x1 :| xs, collapse $ x2 :| closed) -breakPoints :: Int -> [WithSpan Run] -> [Int] -breakPoints _ [] = [] -breakPoints firstRunOffset (x:xs) = offsets ++ rest - where - thisRunOffset = runOffsetInParagraph x - offsets = map (correctOffset . fst) (runLineBreaks x) - correctOffset = (+ (thisRunOffset - firstRunOffset)) - rest = breakPoints firstRunOffset xs +-- | If the first run is empty, remove it. +collapse :: NonEmpty (WithSpan Run) -> [WithSpan Run] +collapse (x :| xs) + | Text.null (getText x) = xs + | otherwise = x:xs -- | Calculate layout for multiple runs on the same line and -- arrange them in one horizontal direction starting from the given x_offset. @@ -341,6 +333,13 @@ paragraphLineBreaks (Paragraph arr off _ _) end lang = where paragraphText = Text arr off (end - off) +-- | Split the given run at every valid line break position. +runLineSplits :: WithSpan Run -> + [((WithSpan Run, WithSpan Run), BreakStatus.Line)] +runLineSplits r = map split $ runLineBreaks r + where + split (i, status) = (splitTextAt8 i r, status) + runLineBreaks :: WithSpan Run -> [(Int, BreakStatus.Line)] runLineBreaks (WithSpan rs run) = dropWhile (not . valid) $ subOffsetsDesc (runOffsetInSpan run) $ RS.spanLineBreaks rs -- 2.30.2