diff --git a/init.ml b/init.ml index bd6c11e..ef63f85 100644 --- a/init.ml +++ b/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 ();; + diff --git a/main.ml b/main.ml index e7719aa..f6e3376 100644 --- a/main.ml +++ b/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 diff --git a/topinf.ml b/topinf.ml index 73da4e2..284173a 100644 --- a/topinf.ml +++ b/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