From 3c9b4c5f866e6262c642e0ff9167adf42f837b83 Mon Sep 17 00:00:00 2001
From: Jaro <jaro@argonaut-constellation.org>
Date: Tue, 11 Apr 2023 20:14:37 +0200
Subject: [PATCH] Integrate BiDi reordering.

---
 CHANGELOG.md                                  | 13 +++++++++++++
 .../Text/ParagraphLayout/Internal/Plain.hs    | 19 ++-----------------
 .../ParagraphLayout/Internal/ProtoFragment.hs | 14 +++++++++++++-
 .../ParagraphLayout/Internal/ResolvedSpan.hs  |  4 ++++
 4 files changed, 32 insertions(+), 18 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 09cd64f..9cf1def 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -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.
diff --git a/src/Data/Text/ParagraphLayout/Internal/Plain.hs b/src/Data/Text/ParagraphLayout/Internal/Plain.hs
index 83ee1d8..d75f5cb 100644
--- a/src/Data/Text/ParagraphLayout/Internal/Plain.hs
+++ b/src/Data/Text/ParagraphLayout/Internal/Plain.hs
@@ -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.
 --
diff --git a/src/Data/Text/ParagraphLayout/Internal/ProtoFragment.hs b/src/Data/Text/ParagraphLayout/Internal/ProtoFragment.hs
index 32bfc16..836dfdb 100644
--- a/src/Data/Text/ParagraphLayout/Internal/ProtoFragment.hs
+++ b/src/Data/Text/ParagraphLayout/Internal/ProtoFragment.hs
@@ -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
diff --git a/src/Data/Text/ParagraphLayout/Internal/ResolvedSpan.hs b/src/Data/Text/ParagraphLayout/Internal/ResolvedSpan.hs
index f6f717c..9b7ccc6 100644
--- a/src/Data/Text/ParagraphLayout/Internal/ResolvedSpan.hs
+++ b/src/Data/Text/ParagraphLayout/Internal/ResolvedSpan.hs
@@ -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 ..]]
 
-- 
2.30.2