1 files changed, 48 insertions(+), 49 deletions(-)

M 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