Use relative y positions during layout

This will make it possible in future to position fibers based on their
size. Before, we needed to know a fiber's final position before
calculating its height.

Author: talex5

lib/layout.ml

@@ -104,12 +104,15 @@ let as_string = function
   | `String s -> s
   | _ -> failwith "Not a string"
 
-let rec layout_item ~duration ~y (i : item) =
-  if debug_layout then Fmt.epr "%d is at %d@." i.id y;
-  i.y <- y;
+(* Walk the tree rooted at [i], calculating heights and positions.
+   Note: visited items have their [y] fields set to their position relative to
+   their parent. This gets turned into an absolute position later. *)
+let rec layout_item ~duration (i : item) =
+  i.y <- 0;
   i.height <- 1;
   i.end_cc_label <- None;
   let intervals = ref [] in
+  (* Position CCs at the same place as [i]. *)
   i.events |> Array.iter (fun (ts, e) ->
       match e with
       | Log _ | Error _ ->
@@ -122,13 +125,14 @@ let rec layout_item ~duration ~y (i : item) =
         if i.end_cc_label = None then (
           i.end_cc_label <- Some ts;
         );
-        layout_item ~duration ~y child;
+        layout_item ~duration child;
         i.height <- max i.height child.height;
         let stop = Option.value child.end_time ~default:duration in
         intervals := { Itv.value = child; start = ts; stop } :: !intervals;
     );
   if i.end_cc_label = None then i.end_cc_label <- i.end_time;
-  let start_fibers = List.length !intervals in
+  let n_ccs = List.length !intervals in
+  (* Position fibers where there is space, not overlapping CCs or other fibers. *)
   i.events |> Array.iter (fun (ts, e) ->
       match e with
       | Log _ | Error _ | Create_cc _ -> ()
@@ -140,36 +144,49 @@ let rec layout_item ~duration ~y (i : item) =
   let intervals = List.rev !intervals in
   let itv = Itv.create intervals in
   let height = ref i.height in
-  intervals |> List.to_seq |> Seq.drop start_fibers |> Seq.iter (fun (interval : _ Itv.interval) ->
-      let y = ref (i.y + 1) in
+  intervals |> List.to_seq |> Seq.drop n_ccs |> Seq.iter (fun (interval : _ Itv.interval) ->
+      let y = ref 1 in
       let adjust other =
         y := max !y (other.y + other.height);
       in
       Itv.iter_overlaps adjust interval.start interval.stop itv;
       let f = interval.Itv.value in
-      layout_item ~duration ~y:!y f;
-      height := max !height (f.y - i.y + f.height);
+      layout_item ~duration f;
+      f.y <- !y;
+      height := max !height (f.y + f.height);
     );
-  i.height <- !height;
-  if debug_layout then Fmt.epr "%d is at %d+%d@." i.id y i.height
+  i.height <- !height
+
+(* Walk the tree rooted at [i] converting relative [y] values to absolute ones,
+   using [parent] for zero. *)
+let rec make_y_absolute i parent =
+  i.y <- i.y + parent;
+  if debug_layout then Fmt.epr "%d is at %d (height %d)@." i.id i.y i.height;
+  i.events |> Array.iter (fun (_ts, e) ->
+      match e with
+      | Log _ | Error _ -> ()
+      | Add_fiber { parent = _; child }
+      | Create_cc (_, child) -> make_y_absolute child i.y
+    )
 
 let layout_ring ~duration (ring : Ring.t) =
   let max_y = ref 1 in
   let visit_domain root =
     root.Ring.cc |> Option.iter @@ fun (_ts, (i : item)) ->
-    i.y <- ring.y + 1;
+    i.y <- 1;
     i.height <- 1;
     i.end_cc_label <- None;
     i.events |> Array.iter (fun (_ts, e) ->
         match e with
         | Log _ | Error _ | Create_cc _ -> ()
         | Add_fiber { parent = _; child } ->
-          layout_item ~duration ~y:(ring.y + i.height) child;
-          i.height <- child.y - ring.y + child.height;
+          layout_item ~duration child;
+          i.height <- max i.height (child.y + child.height);
           if i.end_cc_label = None then (
             i.end_cc_label <- child.end_cc_label;
           );
       );
+    make_y_absolute i ring.y;
     max_y := max !max_y (i.y + i.height - 1);
   in
   List.iter visit_domain ring.roots;