2 files changed, 55 insertions(+), 43 deletions(-)

M src/Data/Text/ParagraphLayout/Internal/Plain.hs
M src/Data/Text/ParagraphLayout/Internal/ProtoFragment.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

@@ 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.