From 8308c7a926605d5affdab24fa7bd3676ccdddaa4 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Tue, 30 May 2023 13:34:43 +1200
Subject: [PATCH] Compute boxes & positions.

---
 Graphics/Layout/Inline.hs | 40 +++++++++++++++++++++++++++++----------
 1 file changed, 30 insertions(+), 10 deletions(-)

diff --git a/Graphics/Layout/Inline.hs b/Graphics/Layout/Inline.hs
index e1c8121..61d0cb9 100644
--- a/Graphics/Layout/Inline.hs
+++ b/Graphics/Layout/Inline.hs
@@ -9,7 +9,8 @@ module Graphics.Layout.Inline(inlineMinWidth, inlineMin, inlineNatWidth, inlineH
 import Data.Text.ParagraphLayout.Rich (Paragraph(..), ParagraphOptions(..),
                                 Fragment(..), ParagraphLayout(..), AncestorBox(..),
                                 layoutRich)
-import Data.Text.ParagraphLayout.Rect (Rect(..), width, height, x_min, y_min)
+import Data.Text.ParagraphLayout.Rect (Rect(..),
+                                       width, height, x_max, x_min, y_min, y_max)
 import Data.Text.Internal (Text(..))
 import qualified Data.Text as Txt
 import Data.Char (isSpace)
@@ -62,26 +63,40 @@ layoutRich' (Paragraph a b c d) width =
 
 -- | Retrieve the rect for a fragment & convert to CatTrap types.
 fragmentSize :: (CastDouble x, CastDouble y) => FragmentTree a -> Size x y
-fragmentSize (Branch _ _) = Size (c 0) (c 0) -- FIXME
-fragmentSize (Leaf self) = Size (c $ width r) (c $ height r)
-    where r = fragmentRect self
+fragmentSize self = Size (c $ width r) (c $ height r)
+    where r = treeRect self
+-- | Compute the unioned rect for a subtree.
+treeRect :: FragmentTree a -> Rect Int32
+treeRect (Branch _ childs) = foldr unionRect (Rect 0 0 0 0) $ map treeRect childs
+    where unionRect a b = Rect (x_min a `min` x_min b) (y_min a `min` y_min b)
+            ((x_max a `max` x_max b) - (x_min a `min` x_min b))
+            ((y_max a `max` y_max b) - (y_min a `min` x_min b))
+treeRect (Leaf self) = fragmentRect self
+
 -- | Variant of `fragmentSize` asserting to the typesystem that both fields
 -- of the resulting `Size` are of the same type.
 fragmentSize' :: CastDouble x => FragmentTree a -> Size x x
 fragmentSize' = fragmentSize -- Work around for typesystem.
 -- | Retrieve the position of a fragment.
 fragmentPos :: (Double, Double) -> Fragment a -> (Double, Double)
-fragmentPos (x, y) self =
-        (x + hbScale (x_min r), y + hbScale (y_min r))
+fragmentPos (x, y) self = (x + hbScale (x_min r), y + hbScale (y_min r))
     where r = fragmentRect self
 
 -- | Alter userdata to hold positions.
 positionChildren :: (Double, Double) -> ParagraphLayout (a, b, c) ->
                     ParagraphLayout (a, b, ((Double, Double), c))
 positionChildren pos self = self {
-    paragraphFragments = [Fragment (a, b, (fragmentPos pos frag, c)) d [] f g h
-            | frag@(Fragment (a, b, c) d _ f g h) <- paragraphFragments self]
+    paragraphFragments = [
+        Fragment (a, b, (pos', c)) d (positionParents pos' e) f g h
+        | frag@(Fragment (a, b, c) d e f g h) <- paragraphFragments self,
+        let pos' = fragmentPos pos frag]
   }
+positionParents :: (Double, Double) -> [AncestorBox (a, b, c)] ->
+        [AncestorBox (a, b, ((Double, Double), c))]
+positionParents pos (parent@AncestorBox { boxUserData = (a, b, c) }:parents) =
+    parent { boxUserData = (a, b, (pos', c)) }:positionParents pos' parents
+  where pos' = pos -- FIXME: Take into account borders.
+positionParents _ [] = []
 
 data FragmentTree x = Branch (AncestorBox x) [FragmentTree x]
     | Leaf (Fragment x)
@@ -94,13 +109,18 @@ reconstructTree ParagraphLayout { paragraphFragments = frags } =
 reconstructTree' :: Eq x => [Fragment x] -> [FragmentTree x]
 reconstructTree' (self@Fragment { fragmentAncestorBoxes = [] }:frags) =
     Leaf self:reconstructTree' frags
-reconstructTree' frags@(Fragment { fragmentAncestorBoxes = branch:_ }:_) =
+reconstructTree' frags@(Fragment {
+        fragmentAncestorBoxes = branch:_, fragmentLine = line
+  }:_) =
     Branch branch (reconstructTree' [ child { fragmentAncestorBoxes = ancestors }
             | child@Fragment { fragmentAncestorBoxes = _:ancestors } <- childs])
         :reconstructTree' sibs
   where
     (childs, sibs) = span sameBranch frags
-    sameBranch Fragment { fragmentAncestorBoxes = branch':_ } = branch == branch'
+    -- Cluster ancestor branches, breaking them per-line.
+    sameBranch Fragment {fragmentAncestorBoxes=branch':_, fragmentLine=line'} =
+        branch == branch' && line == line'
+    -- Leaves are always in their own branch.
     sameBranch Fragment { fragmentAncestorBoxes = [] } = False
 reconstructTree' [] = []
 
-- 
2.30.2