daemon synchrone semi-auto

test/Makefile.dot

-# Time-stamp: <modified the 04/12/2020 (at 11:14) by Erwan Jahier>
+# Time-stamp: <modified the 29/03/2021 (at 14:48) by Erwan Jahier>
 
 
 # Rules to generate various dot files.
@@ -34,7 +34,7 @@ ring%.dot:
 	gg-deco $(DECO_PATTERN) $@ -o $@
 
 dtree%.dot:
-	gg tree -dir -n $* -o $@
+	gg tree -n $* -o $@
 	gg-deco $(DECO_PATTERN) $@ -o $@
 
 

tools/rdbg4sasa/daemongui.ml

@@ -45,7 +45,7 @@ let rdbg_nodes_enabled e =
     in
     List.rev (last::res)
   
-type daemon_kind = D | S | C | LC | ManualCentral | Manual 
+type daemon_kind = Distributed | Synchronous | Central | LocCentral | ManualCentral | Manual 
 let daemon_kind = ref ManualCentral
 
 let refresh_fun_tbl = Hashtbl.create 1
@@ -86,7 +86,7 @@ let main () =
       (*       ~width:320 ~height:240 *)
       ~title:"Daemon GUI"
       ~show:true () in
-  let vbox = GPack.vbox ~packing:window#add () in
+  let vbox = GPack.vbox ~packing:window#add () ~homogeneous:false in
   ignore (window#connect#destroy ~callback: (
       fun () ->
         quit (); (* quit rdbg, this will stop the readloop below *)
@@ -99,18 +99,18 @@ let main () =
   (* création du rdbg_mv_hook et de tout ce qu'il faut autour *)
   init_rdbg_hook ();
 
-  let daemon_box = GPack.hbox ~packing:vbox#add () in
+  let daemon_box = GPack.hbox ~packing:vbox#add ()  ~homogeneous:true  ~height:15 in
   let daemon_box_manual = GPack.hbox ~packing:vbox#add () in
-  let dk_dd = GButton.radio_button  ~active:(!daemon_kind=D)
+  let dk_dd = GButton.radio_button  ~active:(!daemon_kind=Distributed)
       ~label:"Distributed" ~packing:daemon_box#add ()
   in
-  let dk_cd = GButton.radio_button ~active:(!daemon_kind=C)
+  let dk_cd = GButton.radio_button ~active:(!daemon_kind=Central)
       ~label:"Central" ~group:dk_dd#group ~packing:daemon_box#add ()
   in
-  let dk_lcd = GButton.radio_button  ~active:(!daemon_kind=LC)
+  let dk_lcd = GButton.radio_button  ~active:(!daemon_kind=LocCentral)
       ~label:"Locally Central" ~group:dk_dd#group ~packing:daemon_box#add ()
   in
-  let dk_sd = GButton.radio_button  ~active:(!daemon_kind=S)
+  let dk_sd = GButton.radio_button  ~active:(!daemon_kind=Synchronous)
       ~label:"Synchronous" ~group:dk_dd#group ~packing:daemon_box#add ()
   in
   let dk_manual = GButton.radio_button  ~active:(!daemon_kind=Manual)
@@ -133,28 +133,32 @@ let main () =
   dk_manual_central#misc#set_tooltip_text (Printf.sprintf "Set the manual central mode");
 
   let nodes_enabled = rdbg_nodes_enabled !e in
-  List.iter (fun (n,_enab) -> Hashtbl.add daemongui_activate n false) nodes_enabled;
-  (** Met à jour le hook pour un noeud  *)
+
+  (** Met à jour le hook pour node quand le bouton ou une checkbox correspondant est activé *)
   let update_rdbg_hook node activate =
-    match !daemon_kind with
-    | D | S | C | LC ->
-      gtext#buffer#set_text  "finish me" (* todo *)
-    | ManualCentral -> (
-        let txt = Printf.sprintf "ManualCentral step: \n%s" (str_of_sasa_event false !e) in
-        gtext#buffer#set_text txt;
-        Hashtbl.iter
-          (fun n status ->
-             if n = node then (
-               if not status then Hashtbl.replace daemongui_activate n true;
-             )
-             else (
-               Hashtbl.replace daemongui_activate n false;
-             )
-          )
-          daemongui_activate;
-      )
-    | Manual -> 
-      Hashtbl.replace daemongui_activate node activate
+    (match !daemon_kind with
+     | Distributed | Synchronous | Central | LocCentral -> 
+       assert false (* SNO *)
+     | ManualCentral -> (
+         let txt = Printf.sprintf "ManualCentral step: %s\n%s" node (str_of_sasa_event false !e) in
+         gtext#buffer#set_text txt;
+         Hashtbl.iter
+           (fun n status ->
+              if n = node then (
+                if status then Hashtbl.replace daemongui_activate n true;
+              )
+              else (
+                Hashtbl.replace daemongui_activate n false;
+              )
+           )
+           daemongui_activate;
+       )
+     | Manual ->
+       let txt = Printf.sprintf "Manual step: \n%s" (str_of_sasa_event false !e) in
+       gtext#buffer#set_text txt;
+       Hashtbl.replace daemongui_activate node activate
+    );
+
   in
 
   (* 1 case par noeud : activer/pas activer *)
@@ -166,8 +170,9 @@ let main () =
   (* build manually a m x m grid *)
   let i = ref 0 in
   let checkbox_grid = GPack.vbox ~packing:vbox#add () in
-  let checkbox_scrolled_grid = GBin.scrolled_window ~border_width:10   ~hpolicy:`AUTOMATIC 
+  let checkbox_scrolled_grid = GBin.scrolled_window ~border_width:10 ~hpolicy:`AUTOMATIC 
       ~vpolicy:`AUTOMATIC
+      ~height:300
       ~shadow_type:`OUT ~packing:checkbox_grid#add ()
   in
   let checkbox_scrolled_grid_box = GPack.vbox ~packing:checkbox_scrolled_grid#add () in
@@ -195,12 +200,13 @@ let main () =
     nodes_enabled;
 
   (* Des boutons pour le mode Manuel Central *)
-  let pushbox_grid = GPack.vbox ~packing:vbox#add () in
+  let pushbox_grid = GPack.vbox ~packing:vbox#add () ~homogeneous:true in
   let pushbox_scrolled_grid = GBin.scrolled_window ~border_width:10 ~hpolicy:`AUTOMATIC 
-      ~vpolicy:`AUTOMATIC
+      ~vpolicy:`AUTOMATIC 
+      ~height:300
       ~shadow_type:`OUT ~packing:pushbox_grid#add ()
   in
-  let pushbox_scrolled_grid_box = GPack.vbox  ~packing:pushbox_scrolled_grid#add () in
+  let pushbox_scrolled_grid_box = GPack.vbox  ~homogeneous:true ~packing:pushbox_scrolled_grid#add () in
   let pushbox_line = GPack.hbox ~packing:pushbox_scrolled_grid_box#add () in
   let pushbox_line_ref = ref pushbox_line in
   let pushbox_map = Hashtbl.create n in
@@ -229,7 +235,7 @@ let main () =
   (* Des compteurs pour les modes automatiques *)
   let counter_grid = GPack.vbox ~packing:vbox#add () in
   let counter_scrolled_grid = GBin.scrolled_window ~border_width:10 ~hpolicy:`AUTOMATIC 
-      ~vpolicy:`AUTOMATIC 
+      ~vpolicy:`AUTOMATIC ~height:400
       ~shadow_type:`OUT ~packing:counter_grid#add ()
   in
   let counter_scrolled_grid_box = GPack.vbox ~packing:counter_scrolled_grid#add () in
@@ -244,14 +250,14 @@ let main () =
         let new_counter_line = GPack.hbox ~packing:counter_scrolled_grid_box#add () in
         counter_line_ref := new_counter_line
       );
-      
+
       let counter_container_frame = GBin.frame ~label:name ~packing:!counter_line_ref#add () in
       let counter_container =
         GPack.hbox ~homogeneous:true ~border_width: 2 ~spacing:0
           ~packing:counter_container_frame#add () 
       in
       let incr_container = GPack.vbox  ~packing:counter_container#add () in
-      
+
       let counter = new GUtil.variable 0 in
       let decB = GButton.button ~label:"-" ~packing:incr_container#add () in
       let counter_lbl = GMisc.label  ~packing:counter_container#pack () in
@@ -263,7 +269,7 @@ let main () =
       ignore (counter#connect#changed ~callback:(fun n -> counter_lbl#set_text (string_of_int n)));
       counter#set 1;
       counter_container#misc#set_tooltip_text (Printf.sprintf "Set the priority of %s" name);
-      Hashtbl.add counter_map name counter_container
+      Hashtbl.add counter_map name counter
     )
     nodes_enabled;
 
@@ -274,7 +280,9 @@ let main () =
       pushbox_grid#misc#hide();
       counter_grid#misc#hide();
       let checkbox = Hashtbl.find checkbox_map node in
-      if not enabled then (
+      if enabled then
+        checkbox#misc#show ()
+      else (
         checkbox#set_active false; (* on decoche *)
         checkbox#misc#hide ()
       );
@@ -284,26 +292,30 @@ let main () =
       pushbox_grid#misc#show();
       counter_grid#misc#hide();
       let pushbox = Hashtbl.find pushbox_map node in
-      if not enabled then (pushbox#misc#hide ());
+      if enabled then
+        pushbox#misc#show ()
+      else
+        pushbox#misc#hide ();
       pushbox#set_sensitive enabled
-    | LC | C | D ->
+    | Distributed | Synchronous | Central | LocCentral ->
       checkbox_grid#misc#hide();
       pushbox_grid#misc#hide();
       counter_grid#misc#show()
-    | S ->
-      checkbox_grid#misc#hide();
-      pushbox_grid#misc#hide();
-      counter_grid#misc#hide()
   in
   let update_all_checkboxes () =
-    List.iter (fun (name, enabled) -> update_checkbox name enabled) (rdbg_nodes_enabled !e)
+    let nodes_enabled = rdbg_nodes_enabled !e in
+    List.iter (fun (name, enabled) ->
+        Hashtbl.replace daemongui_activate name enabled;
+        update_checkbox name enabled
+      )
+      nodes_enabled
   in
   Hashtbl.add refresh_fun_tbl "" update_all_checkboxes;
 
-  let set_dd_mode () = daemon_kind := D; refresh () in
-  let set_sd_mode () = daemon_kind := S; refresh () in
-  let set_cd_mode () = daemon_kind := C; refresh () in
-  let set_lcd_mode () = daemon_kind := LC; refresh () in
+  let set_dd_mode () = daemon_kind := Distributed; refresh () in
+  let set_sd_mode () = daemon_kind := Synchronous; refresh () in
+  let set_cd_mode () = daemon_kind := Central; refresh () in
+  let set_lcd_mode () = daemon_kind := LocCentral; refresh () in
   let set_manual_mode () = daemon_kind := Manual; refresh ()  in
   let set_manual_central_mode () = daemon_kind := ManualCentral; refresh ()  in
   ignore(dk_dd#connect#clicked ~callback:set_dd_mode);
@@ -319,14 +331,6 @@ let main () =
     gtext#buffer#set_text txt;
     gtext_content := txt;
   in
-  let msg = String.concat "\n" 
-      (List.map 
-         (fun (name, enabled) ->
-            Printf.sprintf "%s is %senabled" name (if enabled then "" else "not "))
-         nodes_enabled
-      )
-  in
-  print_gui msg;
 
   (* Boutons de contrôle de la simulation *)
   let hbox = GPack.hbox ~packing:vbox#add () in
@@ -336,15 +340,55 @@ let main () =
     ignore (btn#connect#clicked ~callback: (
         fun () ->
           cmd ();
-          print_gui (Printf.sprintf "%s" label);
           refresh ();
       ));
     btn
   in
+  let rec get_higher_prioriry nl =
+    let prio n =
+      let counter = Hashtbl.find counter_map n in
+      counter#get
+    in
+    let rec aux p acc = function
+      | [] -> acc
+      | (n, false)::t -> aux p acc t
+      | (n, true)::t ->
+        let pn = prio n in
+        if p > pn then aux p acc t else
+        if p = pn then aux p (n::acc) t else
+          aux pn [n] t
+    in
+    aux 0 [] nl
+  in
+  let step () =
+    match !daemon_kind with
+    | Distributed -> 
+      gtext#buffer#set_text  "finish me"
+    | Synchronous -> (
+        let nodes_enabled = rdbg_nodes_enabled !e in
+        let nodes = get_higher_prioriry nodes_enabled in
+        List.iter
+          (fun (n,_) ->
+             if List.mem n nodes
+             then Hashtbl.add daemongui_activate n true
+             else Hashtbl.add daemongui_activate n false
+          )
+          nodes_enabled;
+        sd ();
+        gtext#buffer#set_text  ("Synchronous step : " ^ (String.concat "," nodes))
+      )
+    | Central  ->
+      gtext#buffer#set_text  "finish me"
+    | LocCentral -> 
+      gtext#buffer#set_text  "finish me"
+
+    | ManualCentral -> () (* SNO *)
+    | Manual -> sd ()
+  in
   let _ = rdbg_btn "<<" "previous round" pr in
   let _ = rdbg_btn "<" "previous step" bd in
   let _ = rdbg_btn "G" "display the network" graph_view in
-  let _ = rdbg_btn ">" "next step" sd in
+  let _ = rdbg_btn ">" "next step" step in
   let _ = rdbg_btn ">>" "next round" nr in
   let _ = rdbg_btn "q" "end the session" q in
   refresh ()
@@ -352,6 +396,8 @@ let main () =
 let m = main 
 (* todo
 - cacher les boutons de rounds en mode manuel
+- cacher le bouton step en mode manuel central 
 - faire les modes automatiques
 - reglage de la taille des boites 
+
  *)

tools/rdbg4sasa/sasa-rdbg-cmds.ml

@@ -19,7 +19,7 @@ let _ = Hashtbl.add roundtbl 1 (1,true);;
 let sasa_step e = next_cond e (fun ne -> ne.kind = e.kind)
 let sasa_bstep e = rev_cond e (fun ne -> ne.kind = e.kind)
 let s () = e:=sasa_step !e ; emacs_udate !e; store !e.nb;pe()
-let b () = e:=sasa_step !e ; emacs_udate !e; store !e.nb;pe()
+let b () = e:=sasa_bstep !e ; emacs_udate !e; store !e.nb;pe()
 
 let p =
   try Topology.read dotfile