4 files changed, 32 insertions(+), 18 deletions(-)

M CHANGELOG.md
M src/Data/Text/ParagraphLayout/Internal/Plain.hs
M src/Data/Text/ParagraphLayout/Internal/ProtoFragment.hs
M src/Data/Text/ParagraphLayout/Internal/ResolvedSpan.hs

@@ 2,6 2,19 @@
 
 ## 0.3.0.0 -- TBD
 
+* Limited support for bidirectional text (LTR and RTL in the same paragraph).
+
+    * The paragraph direction is assumed to be LTR.
+      This will be configurable in a future interface.
+
+    * Only strong directional characters are used to determine text direction.
+
+    * The direction of weak directional characters and neutral characters is
+      determined by the nearest preceding strong directional character, or if
+      none is found, the nearest following strong directional character.
+
+    * Explicit bidirectional formatting characters are ignored.
+
 ## 0.2.1.0 -- 2023-04-04
 
 * Added pagination.

@@ 12,7 12,6 @@ import Data.Text.Foreign (lengthWord8)
 import Data.Text.Glyphize
     ( Buffer (..)
     , ContentType (ContentTypeUnicode)
-    , Direction (..)
     , FontExtents (..)
     , GlyphInfo
     , GlyphPos


@@ 25,6 24,7 @@ import qualified Data.Text.ICU as BreakStatus (Line (Hard))
 import Data.Text.Internal (Text (Text))
 import qualified Data.Text.Lazy as Lazy
 
+import Data.Text.ParagraphLayout.Internal.BiDiReorder
 import Data.Text.ParagraphLayout.Internal.Break
 import Data.Text.ParagraphLayout.Internal.Fragment
 import Data.Text.ParagraphLayout.Internal.LineHeight


@@ 70,28 70,13 @@ layoutAndAlignLines maxWidth runs = frags
     where
         frags = concatMap NonEmpty.toList fragsInLines
         (_, fragsInLines) = mapAccumL positionLineH originY canonicalLines
-        canonicalLines = fmap canonicalOrder logicalLines
+        canonicalLines = fmap reorder logicalLines
         logicalLines = nonEmptyItems $ layoutLines maxWidth runs
         originY = paragraphOriginY
 
 nonEmptyItems :: Foldable t => t [a] -> [NonEmpty a]
 nonEmptyItems = catMaybes . map nonEmpty . toList
 
--- | 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 :: NonEmpty (WithSpan PF.ProtoFragment) ->
-    NonEmpty (WithSpan PF.ProtoFragment)
-canonicalOrder pfs@((WithSpan _ headPF) :| _) = case PF.direction headPF of
-    -- TODO: Use BiDi levels to control reversing.
-    Just DirLTR -> pfs
-    Just DirRTL -> NonEmpty.reverse pfs
-    Just DirTTB -> pfs
-    Just DirBTT -> NonEmpty.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.
 --

@@ 5,7 5,9 @@ module Data.Text.ParagraphLayout.Internal.ProtoFragment
 where
 
 import Data.Int (Int32)
-import Data.Text.Glyphize (Direction, GlyphInfo, GlyphPos (x_advance))
+import Data.Text.Glyphize (Direction (..), GlyphInfo, GlyphPos (x_advance))
+
+import Data.Text.ParagraphLayout.Internal.BiDiReorder
 
 -- | A box fragment which has not been positioned yet.
 data ProtoFragment = ProtoFragment


@@ 23,3 25,13 @@ protoFragmentH :: Maybe Direction -> [(GlyphInfo, GlyphPos)] -> ProtoFragment
 protoFragmentH dir gs = ProtoFragment dir adv gs
     where
         adv = sum $ map (x_advance . snd) gs
+
+instance WithLevel ProtoFragment where
+    level pf = case direction pf of
+        -- TODO: Allow externally set paragraph embedding level.
+        -- TODO: Properly calculate BiDi levels.
+        Just DirLTR -> 0
+        Just DirRTL -> 1
+        Just DirTTB -> 0
+        Just DirBTT -> 1
+        Nothing -> 0

@@ 9,6 9,7 @@ import Data.Text (Text)
 import Data.Text.Glyphize (Font)
 import qualified Data.Text.ICU as BreakStatus (Line)
 
+import Data.Text.ParagraphLayout.Internal.BiDiReorder
 import Data.Text.ParagraphLayout.Internal.LineHeight
 import Data.Text.ParagraphLayout.Internal.TextContainer
 


@@ 48,6 49,9 @@ instance SeparableTextContainer a => SeparableTextContainer (WithSpan a) where
     dropWhileStart p (WithSpan rs c) = WithSpan rs (dropWhileStart p c)
     dropWhileEnd p (WithSpan rs c) = WithSpan rs (dropWhileEnd p c)
 
+instance WithLevel a => WithLevel (WithSpan a) where
+    level (WithSpan _ x) = level x
+
 splitBySpanIndex :: [WithSpan a] -> [[a]]
 splitBySpanIndex xs = [getBySpanIndex i xs | i <- [0 ..]]