fixed pane_*box

init.ml

@@ -1,6 +1,6 @@
 (* $Id$ -*- tuareg -*- *)
 
-#directory "/home/cqc/p/pinephone/komm/komm/_build/default/.topinf.objs/byte";;
+#directory "/home/cqc/p/console/boot/_build/default/.topinf.objs/byte";;
 open Topinf;;
 let print_directives () = 
   Format.eprintf "directive_info_table:@.";
@@ -12,3 +12,4 @@ let print_modules () =
   Format.eprintf "Env.fold_modules:\n";
   Env.fold_modules (fun modname _ _ () -> Format.eprintf "\t%s@." modname) None !Topinf.toplevel_env ();;
 print_modules ();;
+

main.ml

@@ -1,4 +1,3 @@
-
 open Lwt.Infix
 module F = Fmt
 module Store = Irmin_unix.Git.FS.KV (Irmin.Contents.String)
@@ -277,37 +276,41 @@ let path_circle c b (s : Display.state) =
           P.circle t ~cx:(Box2.midx b) ~cy:(Box2.midy b) ~r:(Box2.w b /. 2.) )
     ) )
 
-(* draws the second item below if there's room *)
-let pane_vbox (subpanes : Display.pane list) (so : Display.state) =
-  let sr, (br, ir) =
-    List.fold_left
-      (fun (sp, (_, ip)) (pane : Display.pane) ->
-        let sr, (br, ir) = pane sp in
-        let _, (_, sir) = path_box (Color.v 0.125 0.125 1.0 0.125) br sp in
-        ( { sr with box = Box2.of_pts (Box2.tl_pt br) (Box2.max sp.box) },
-          (br, Image.seq [ ip; sir; ir ]) ))
-      (so, (so.box, Image.empty))
-      subpanes
-  in
-  let b = Box2.of_pts (Box2.o so.box) (Box2.max br) in
-  let _, (_, i_redbox) = path_box (Color.v 0.5 0.125 0.125 1.0) b sr in
-  (sr, (b, Image.stack i_redbox ir))
 
-(* draws second item to right if there's room *)
-let pane_hbox (subpanes : Display.pane list) (so : Display.state) =
-  let sr, (br, ir) =
+(** Display.state.box as supplied to a widget defines the allowed drawing area for the widget.
+    This way basic widgets will just expand to the full area of a box, while other widgets can have
+    the express purpose of limiting the size of an object in a larger system of limitations. 
+
+
+    Widgets return a tuple: (state, (box, image))
+    state is the updated state, where state.box is always 
+      - the top left corner of the box the pane drew in, and
+      - the bottom right corner of the state.box that was passed in
+    box is the area the widget actually drew in (or wants to sort of "use")
+    image is the Wall.image to compose with other panes and draw to the display
+*)
+  
+
+let pane_box next_point_func (subpanes : Display.pane list) (so : Display.state) =
+  let sr, (br, ir) = 
     List.fold_left
-      (fun (sp, (_, ip)) (pane : Display.pane) ->
-        let sr, (br, ir) = pane sp in
-        let _, (_, sir) = path_box (Color.v 0.125 0.125 1.0 0.125) br sp in
-        ( { sr with box = Box2.of_pts (Box2.br_pt br) (Box2.max sp.box) },
-          (br, Image.seq [ ip; sir; ir ]) ))
-      (so, (so.box, Image.empty))
+      (fun (sp, (bp, ip)) (pane : Display.pane) -> (* uses br to hold max extent of boxes *)
+         let sr, (br, ir) = pane sp in (* draw the pane *)
+         let _, (_, irb) = path_box Color.blue br sr in (* draw the box around the pane *)
+         ( { sr with box = Box2.of_pts (next_point_func br) (Box2.max sp.box) },
+           ((Box2.of_pts (Box2.o bp) (P2.v (max (Box2.maxx br) (Box2.maxx bp))
+                               (max (Box2.maxy br) (Box2.maxy bp)))), Image.seq [ ip; irb; ir ]))
+      )
+      (so, ((Box2.of_pts (Box2.o so.box) (Box2.o so.box)), Image.empty))
       subpanes
   in
-  let b = Box2.of_pts (Box2.o so.box) (Box2.max br) in
-  let _, (_, i_redbox) = path_box (Color.v 0.5 0.125 0.125 1.0) b sr in
-  (sr, (b, Image.stack i_redbox ir))
+  let _, (_, redbox) = path_box Color.red br sr in
+  (sr, (br, Image.stack redbox ir))
+
+(* draws the second item below if there's room in so.box *)
+let pane_vbox = pane_box Box2.tl_pt (* tl_pt is actually bl_pt in the Wall coordinate system *)
+(* draws second item to right if there's room in so.box *)
+let pane_hbox = pane_box Box2.br_pt (* br_pt is actually tr_pt in the Wall coordinate system *)
 
 let simple_text f text (s : Display.state) =
   let fm = Text.Font.font_metrics f in
@@ -315,10 +318,10 @@ let simple_text f text (s : Display.state) =
   let tm = Text.Font.text_measure f text in
   let br_pt = P2.v (Box2.ox s.box +. tm.width) (Box2.oy s.box +. font_height) in
   let bextent = Box2.of_pts (Box2.o s.box) br_pt in
-  let _, (_, redbox) = path_box (Color.v 0.5 0.125 0.125 1.0) bextent s in
+  let _, (_, redbox) = path_box Color.red bextent s in
   ( { s with box = Box2.of_pts (Box2.br_pt bextent) (Box2.max s.box) },
     ( bextent,
-      I.stack redbox
+      (* I.stack redbox *)
         (I.paint
            (Paint.color (Display.gray ~a:0.5 1.0))
            Text.(
@@ -355,7 +358,6 @@ let draw_pp height fpp (s : Display.state) =
       }
   in
   let out_flush () =
-    (*epr "\tout_flush: %s@." (str_of_box !sc.box); *)
     ()
   in
   let out_newline () =
@@ -374,14 +376,10 @@ let draw_pp height fpp (s : Display.state) =
       (* WRAP *)
       out_newline ());
     let so = !sc in
-    let bo = Box2.v (Box2.o !sc.box) (P2.v (float n *. wpx) height) in
-    let bsp = Box2.v (Box2.br_pt !box) (P2.v wpx height) in
-    push
-    @@ pane_hbox
-         (List.init n (fun _ -> path_circle (Color.v 0.125 1.0 0.125 0.125) bsp))
-         !sc;
-    box := bo;
-    sc := { !sc with box = Box2.of_pts (Box2.br_pt bo) (Box2.max so.box) }
+    (* let bsp = Box2.v (Box2.br_pt !box) (P2.v wpx height) in
+    push @@ pane_hbox (List.init n (fun _ -> path_circle Color.green bsp)) !sc;*)
+    box := Box2.v (Box2.o so.box) (P2.v (float n *. wpx) height);
+    sc := { !sc with box = Box2.of_pts (Box2.br_pt !box) (Box2.max so.box) }
   in
   let out_indent n =
     let p = min (Box2.w !sc.box -. 1.) (height *. 2.0 *. float n) in

topinf.ml

@@ -1,5 +1,12 @@
 [@@@ocaml.warning "-32"]
 
+(* most of this is copied from ocaml sources because it's not exported in a way i found useful:
+   - toplevel/toploop.ml
+   - toplevel/topdirs.ml
+   - lambda/translmod.ml
+
+   ideally will reduce this file down in the future *)
+
 module F = Fmt
 open Format
 open Misc