cleanup + move example.ml to examples.ml

some cleanup, in particular:
always declare used modules by aliasing them like:
module Time = B_time

bogue.opam

@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "20231209"
+version: "20240101"
 synopsis: "GUI library for ocaml, with animations, based on SDL2"
 description: """
 Bogue is an all-purpose GUI library for ocaml, with animations, based on SDL2.

docs/Bogue.Bogue.html

@@ -66,20 +66,20 @@ <h1>Module <a href="type_Bogue.Bogue.html">Bogue.Bogue</a></h1>
 
 <pre><span id="VALof_windows"><span class="keyword">val</span> of_windows</span> : <code class="type">?shortcuts:<a href="Bogue.Main.html#TYPEshortcuts">shortcuts</a> -&gt;<br>       ?connections:<a href="Bogue.Widget.html#TYPEconnection">Widget.connection</a> list -&gt;<br>       ?on_user_event:(Tsdl.Sdl.event -&gt; unit) -&gt;<br>       <a href="Bogue.Window.html#TYPEt">Window.t</a> list -&gt; <a href="Bogue.Main.html#TYPEboard">board</a></code></pre><div class="info ">
 <div class="info-desc">
-<p>Synonym for <a href="Bogue.Main.html#VALcreate"><code class="code"><span class="constructor">Main</span>.create</code></a>.</p>
+<p>Synonym for <a href="Bogue.Main.html#VALcreate"><code class="code"><span class="constructor">Main</span>.create</code></a>. (Since 20220418)</p>
 </div>
 </div>
 
 <pre><span id="VALof_layouts"><span class="keyword">val</span> of_layouts</span> : <code class="type">?shortcuts:<a href="Bogue.Main.html#TYPEshortcuts">shortcuts</a> -&gt;<br>       ?connections:<a href="Bogue.Widget.html#TYPEconnection">Widget.connection</a> list -&gt;<br>       ?on_user_event:(Tsdl.Sdl.event -&gt; unit) -&gt;<br>       <a href="Bogue.Layout.html#TYPEt">Layout.t</a> list -&gt; <a href="Bogue.Main.html#TYPEboard">board</a></code></pre><div class="info ">
 <div class="info-desc">
 <p>Similar to <a href="Bogue.Main.html#VALcreate"><code class="code"><span class="constructor">Main</span>.create</code></a>. Each layout in the list will be displayed in a
-     different window.</p>
+     different window. (Since 20220418)</p>
 </div>
 </div>
 
 <pre><span id="VALof_layout"><span class="keyword">val</span> of_layout</span> : <code class="type">?shortcuts:<a href="Bogue.Main.html#TYPEshortcuts">shortcuts</a> -&gt;<br>       ?connections:<a href="Bogue.Widget.html#TYPEconnection">Widget.connection</a> list -&gt;<br>       ?on_user_event:(Tsdl.Sdl.event -&gt; unit) -&gt; <a href="Bogue.Layout.html#TYPEt">Layout.t</a> -&gt; <a href="Bogue.Main.html#TYPEboard">board</a></code></pre><div class="info ">
 <div class="info-desc">
-<p>Similar to <a href="Bogue.Main.html#VALof_layout"><code class="code"><span class="constructor">Main</span>.of_layout</code></a> but with only one layout.</p>
+<p>Similar to <a href="Bogue.Main.html#VALof_layout"><code class="code"><span class="constructor">Main</span>.of_layout</code></a> but with only one layout. (Since 20220418)</p>
 </div>
 </div>
 

docs/Bogue.Main.html

@@ -69,20 +69,20 @@ <h6 id="5_graphbmainhtmlDependencygraph"><a href="graph-b_main.html">Dependency
 
 <pre><span id="VALof_windows"><span class="keyword">val</span> of_windows</span> : <code class="type">?shortcuts:<a href="Bogue.Main.html#TYPEshortcuts">shortcuts</a> -&gt;<br>       ?connections:<a href="Bogue.Widget.html#TYPEconnection">Widget.connection</a> list -&gt;<br>       ?on_user_event:(Tsdl.Sdl.event -&gt; unit) -&gt;<br>       <a href="Bogue.Window.html#TYPEt">Window.t</a> list -&gt; <a href="Bogue.Main.html#TYPEboard">board</a></code></pre><div class="info ">
 <div class="info-desc">
-<p>Synonym for <a href="Bogue.Main.html#VALcreate"><code class="code"><span class="constructor">Main</span>.create</code></a>.</p>
+<p>Synonym for <a href="Bogue.Main.html#VALcreate"><code class="code"><span class="constructor">Main</span>.create</code></a>. (Since 20220418)</p>
 </div>
 </div>
 
 <pre><span id="VALof_layouts"><span class="keyword">val</span> of_layouts</span> : <code class="type">?shortcuts:<a href="Bogue.Main.html#TYPEshortcuts">shortcuts</a> -&gt;<br>       ?connections:<a href="Bogue.Widget.html#TYPEconnection">Widget.connection</a> list -&gt;<br>       ?on_user_event:(Tsdl.Sdl.event -&gt; unit) -&gt;<br>       <a href="Bogue.Layout.html#TYPEt">Layout.t</a> list -&gt; <a href="Bogue.Main.html#TYPEboard">board</a></code></pre><div class="info ">
 <div class="info-desc">
 <p>Similar to <a href="Bogue.Main.html#VALcreate"><code class="code"><span class="constructor">Main</span>.create</code></a>. Each layout in the list will be displayed in a
-     different window.</p>
+     different window. (Since 20220418)</p>
 </div>
 </div>
 
 <pre><span id="VALof_layout"><span class="keyword">val</span> of_layout</span> : <code class="type">?shortcuts:<a href="Bogue.Main.html#TYPEshortcuts">shortcuts</a> -&gt;<br>       ?connections:<a href="Bogue.Widget.html#TYPEconnection">Widget.connection</a> list -&gt;<br>       ?on_user_event:(Tsdl.Sdl.event -&gt; unit) -&gt; <a href="Bogue.Layout.html#TYPEt">Layout.t</a> -&gt; <a href="Bogue.Main.html#TYPEboard">board</a></code></pre><div class="info ">
 <div class="info-desc">
-<p>Similar to <a href="Bogue.Main.html#VALof_layout"><code class="code"><span class="constructor">Main</span>.of_layout</code></a> but with only one layout.</p>
+<p>Similar to <a href="Bogue.Main.html#VALof_layout"><code class="code"><span class="constructor">Main</span>.of_layout</code></a> but with only one layout. (Since 20220418)</p>
 </div>
 </div>
 

docs/Bogue.html

@@ -34,7 +34,7 @@ <h1>Module <a href="type_Bogue.html">Bogue</a></h1>
 </div>
 <ul class="info-attributes">
 <li><b>Author(s):</b> Vu Ngoc San</li>
-<li><b>Version:</b> 20231209</li>
+<li><b>Version:</b> 20240101</li>
 <li><b>See also</b> <a href="https://github.com/sanette/bogue">the source code on github</a></li>
 </ul>
 </div>

dune-project

@@ -1,7 +1,7 @@
 (lang dune 2.7)
 (cram enable)
 (name bogue)
-(version "20231209")
+(version "20240101")
 (generate_opam_files true)
 (license ISC)
 (maintainers "Vu Ngoc San <[email protected]>")

examples/dune

@@ -1,5 +1,5 @@
 (executable
- (name example)
+ (name examples)
  (modules
   (:standard \ toplevel_example))
  ; toplevel_example.ml should not be compiled
@@ -16,4 +16,4 @@
    (setenv
     BOGUE_DEBUG
     true
-    (run ./example.exe 00)))))
+    (run ./examples.exe 00)))))

lib/b_chain.ml

@@ -13,7 +13,9 @@
    empty. See
    https://blog.janestreet.com/howto-static-access-control-using-phantom-types/*)
 
-let debug = !B_utils.debug
+module Utils = B_utils
+
+let debug = !Utils.debug
 
 exception Max_insert
 
@@ -30,7 +32,7 @@ type 'a element =
     mutable next : ('a element) option
   }
 
-let new_id = B_utils.fresh_int ()
+let new_id = Utils.fresh_int ()
 
 type 'a t = 'a element option (* None = empty chain *)
 
@@ -172,15 +174,15 @@ let insert_after t value =
         (* TODO: en fait on peut encore décaler le suivant ! *)
         else x.id, x.depth + d / 2 in
   let t' = Some { id; value; depth; prev = t; next = n} in
-  B_utils.(printd debug_memory "New layer created with depth: %u\n" depth);
+  Utils.(printd debug_memory "New layer created with depth: %u\n" depth);
   do_option t (fun x -> x.next <- t');
   do_option n (fun x -> x.prev <- t');
   t'
 
 let insert_after t value =
   try insert_after t value with
   | Max_insert ->
-    B_utils.(printd debug_memory "Need to evenize chain...");
+    Utils.(printd debug_memory "Need to evenize chain...");
     evenize t; insert_after t value
   | e -> raise e
 
@@ -198,15 +200,15 @@ let insert_before t value =
       (* TODO: en fait on peut encore décaler le suivant ! *)
       else x.id, x.depth - d / 2 in
   let t' = Some { id; value; depth; prev = p; next = t } in
-  B_utils.(printd debug_memory  "New layer created with depth: %u\n" depth);
+  Utils.(printd debug_memory  "New layer created with depth: %u\n" depth);
   do_option t (fun x -> x.prev <- t');
   do_option p (fun x -> x.next <- t');
   t'
 
 let insert_before t value =
   try insert_before t value with
   | Max_insert ->
-    B_utils.(printd debug_memory "Need to evenize chain...");
+    Utils.(printd debug_memory "Need to evenize chain...");
     evenize t; insert_before t value
   | e -> raise e
 
@@ -333,7 +335,7 @@ let copy = function
    order. *)
 let copy_into ~dst:t = function
   | None ->
-    B_utils.(printd debug_warning "Copying an empty Chain has no effect.");
+    Utils.(printd debug_warning "Copying an empty Chain has no effect.");
     None
   | Some a as s ->
     if same_stack s t

lib/b_layout.ml

@@ -17,26 +17,27 @@
    Layout. Otherwise, the results are not going to be satisfactory: a
    widget is associated to a geometry in a layout. Instead one should
    use two differents widgets with a connection between them to
-   synchronize the data *)
+   synchronize the data. *)
 
 
 open Tsdl
 open B_utils
-module Widget = B_widget
 module Avar = B_avar
+module Box = B_box
 module Chain = B_chain
-module Theme = B_theme
-module Time = B_time
-module Var = B_var
-module Tvar = B_tvar
-module Trigger = B_trigger
-module Sync = B_sync
 module Draw = B_draw
+module Label = B_label
 module Mouse = B_mouse
-module Style = B_style
-module Box = B_box
-module Slider = B_slider
 module Selection = B_selection
+module Slider = B_slider
+module Style = B_style
+module Sync = B_sync
+module Theme = B_theme
+module Time = B_time
+module Trigger = B_trigger
+module Tvar = B_tvar
+module Var = B_var
+module Widget = B_widget
 
 type background =
   (* TODO instead we should keep track of how the box was
@@ -106,11 +107,11 @@ type room_content =
   (* In principle, rooms in a house with the same layer should have
      non-intersecting geometries, otherwise it is not clear which one gets the
      mouse focus (this can be violated, eg. with Layout.superpose). Popups are
-     drawn on a different layer *)
+     drawn on a different layer. *)
   | Resident of Widget.t
 
 and room = {
-    id : int; (* unique identifier *)
+    id : int; (* unique identifier. *)
     name : string option;
     (* If needed for debugging, one can give a name to the room. *)
     lock : Mutex.t;
@@ -144,13 +145,13 @@ and room = {
        than indicated size. Before the start of the main loop, it is equal to
        the initial values of the geometry field. *)
     (* A special case of current_geom.(x,y) is to specify window position for
-       the top layouts. See set_window_pos *)
+       the top layouts. See set_window_pos. *)
     mutable clip : bool;
     (* If [clip]=true, the room (and its children) will be clipped inside its
        geometry. This should be set whenever one want to scroll the content of
        the layout inside the layout. This is also used (and set) by hide/show
-       animations. TODO replace this by a more flexible 'overflow' specification
-     *)
+       animations. TODO replace this by a more flexible 'overflow'
+       specification.  *)
     mutable background : background option;
     mutable shadow : Style.shadow option;
     mask : Sdl.surface option;
@@ -2326,62 +2327,62 @@ let make_clip
      this is superfluous... *)
   let layer = get_layer room in
   let container = tower ~margins:0 ~clip:true
-      [superpose [resident_with_layer ~layer active_bg; room]] in
+                    [superpose [resident_with_layer ~layer active_bg; room]] in
   (* The container should be a room with a unique subroom (and the active
      background); the subroom can then be scrolled with respect to the container
-  *)
+   *)
   set_size container (w,h);
 
   let result =
     if scrollbar
     then begin
-      (* We first initialize the bar layout with a dummy widget, so that the
-         var is able to use it. This is only useful if the height of the
-         container is modified after creation, for instance when the user
-         resizes the window. *)
-      let bar = resident_with_layer ~layer
-          ~background:(color_bg Draw.(lighter scrollbar_color))
-          (Widget.empty ~w:10 ~h:10 ()) in
-      (* The scrollbar is a slider. Its Tvar takes the voffset value into the
-         slider value, between 0 and (height room - height container). 0
-         corresponds to the bottom position of the slider, so this means the
-         *largest* scroll (voffset is the most negative). *)
-      let var = Tvar.create container.geometry.voffset
-          ~t_from:(fun vo ->
-              let dh = height room - height bar in
-              if dh <= 0 then 0 (* then the bar should be hidden *)
-              else dh + Avar.get vo)
-          ~t_to:(fun v ->
-              let dh = height room - height bar in
-              let v = imin v dh |> imax 0 in
-              Avar.var (height bar - height room + v)) in
-      let wsli = Widget.slider ~kind:Slider.Vertical ~length:h
-          ~thickness:scrollbar_width
-          ~tick_size:(h * h / (height room))
-          ~var (imax 0 (height room - h)) in
-      change_resident bar wsli;
-      if h >= (height room) then hide ~duration:0 bar;
-      let r = if scrollbar_inside
-        then (setx bar (w - width bar);
-              set_layer bar (Chain.insert_after
-                               (Chain.last (get_layer container))
-                               (Draw.new_layer ()));
-              (* TODO: is this a bit too much ?? We just want to make
-                 sure the scrollbar gets mouse focus. *)
-              superpose ~name [container; bar])
-        else flat ~name ~margins:0 [container; bar] in
-      disable_resize bar;
-      (* We register a resize function that simultaneously sets the container
-         and the bar sizes. It will hide the bar when the container is large
-         enough to display the whole content. *)
-      container.resize <- (fun (w,h) ->
+        (* We first initialize the bar layout with a dummy widget, so that the
+           var is able to use it. This is only useful if the height of the
+           container is modified after creation, for instance when the user
+           resizes the window. *)
+        let bar = resident_with_layer ~layer
+                    ~background:(color_bg Draw.(lighter scrollbar_color))
+                    (Widget.empty ~w:10 ~h:10 ()) in
+        (* The scrollbar is a slider. Its Tvar takes the voffset value into the
+           slider value, between 0 and (height room - height container). 0
+           corresponds to the bottom position of the slider, so this means the
+           *largest* scroll (voffset is the most negative). *)
+        let var = Tvar.create container.geometry.voffset
+                    ~t_from:(fun vo ->
+                      let dh = height room - height bar in
+                      if dh <= 0 then 0 (* then the bar should be hidden *)
+                      else dh + Avar.get vo)
+                    ~t_to:(fun v ->
+                      let dh = height room - height bar in
+                      let v = imin v dh |> imax 0 in
+                      Avar.var (height bar - height room + v)) in
+        let wsli = Widget.slider ~kind:Slider.Vertical ~length:h
+                     ~thickness:scrollbar_width
+                     ~tick_size:(h * h / (height room))
+                     ~var (imax 0 (height room - h)) in
+        change_resident bar wsli;
+        if h >= (height room) then hide ~duration:0 bar;
+        let r = if scrollbar_inside
+                then (setx bar (w - width bar);
+                      set_layer bar (Chain.insert_after
+                                       (Chain.last (get_layer container))
+                                       (Draw.new_layer ()));
+                      (* TODO: is this a bit too much ?? We just want to make
+                         sure the scrollbar gets mouse focus. *)
+                      superpose ~name [container; bar])
+                else flat ~name ~margins:0 [container; bar] in
+        disable_resize bar;
+        (* We register a resize function that simultaneously sets the container
+           and the bar sizes. It will hide the bar when the container is large
+           enough to display the whole content. *)
+        container.resize <- (fun (w,h) ->
           let keep_resize = true in
           set_height ~keep_resize bar h;
           if scrollbar_inside then set_size ~keep_resize container (w,h)
           else begin
-            set_size ~keep_resize container (w - width bar, h);
-            setx ~keep_resize bar (w - width bar)
-          end;
+              set_size ~keep_resize container (w - width bar, h);
+              setx ~keep_resize bar (w - width bar)
+            end;
           let dh = height room - height bar in
           let sli = Widget.get_slider wsli in
           if dh >= 1 then Slider.set_max sli dh
@@ -2392,14 +2393,14 @@ let make_clip
           let h = height bar in
           if height room <> 0
           then Slider.set_tick_size sli
-              (imax (Slider.min_tick_size sli) (h * h / (height room)));
+                 (imax (Slider.min_tick_size sli) (h * h / (height room)));
           let v = Slider.update_value sli; Slider.value sli in
           if v < 0 then Slider.set sli 0;
           if dh <= 0
           then rec_set_show false bar
           else rec_set_show true bar);
-      r
-    end
+        r
+      end
     else container in
 
   sety result y0;
@@ -2643,10 +2644,10 @@ let display ?pos0 room =
           end;
           if !draw_boxes (* we print the room number at the end to make sure
                             it's visible *)
-          then let label = B_label.create ~size:7 ~fg:(Draw.(transp blue))
+          then let label = Label.create ~size:7 ~fg:(Draw.(transp blue))
                    (sprint_id r) in
             let geom = Draw.scale_geom {Draw.x; y; w=g.w+1; h=g.h+1; voffset} in
-            let blits = B_label.display (get_canvas r) (get_layer r) label geom in
+            let blits = Label.display (get_canvas r) (get_layer r) label geom in
             List.iter Draw.blit_to_layer blits;
             List.iter Draw.unload_blit blits
         end

lib/b_menu.ml

@@ -5,17 +5,18 @@
 
 open B_utils
 open Tsdl
-module Layout = B_layout
-module Widget = B_widget
 module Avar = B_avar
+module Button = B_button
 module Chain = B_chain
-module Timeout = B_timeout
-module Trigger =  B_trigger
 module Draw = B_draw
-module Button = B_button
+module Layout = B_layout
 module Popup = B_popup
+module Print = B_print
 module Style = B_style
 module Sync = B_sync
+module Timeout = B_timeout
+module Trigger =  B_trigger
+module Widget = B_widget
 
 let pre = if !debug && !debug_code land debug_custom <> 0
   then fun s -> print_endline ("[Menu] " ^ s) (* for local debugging *)
@@ -333,7 +334,7 @@ module Engine = struct
           if entry.parent_menu.always_shown
           then entry.parent_menu.active <- false
         end else begin
-          pre (B_print.layout_down entry.layout);
+          pre (Print.layout_down entry.layout);
           set_keyboard_focus entry.layout;
           activate screen menu;
           activate screen entry.parent_menu