diff --git a/test/Makefile.dot b/test/Makefile.dot
index 03b8593a87b9acb786a7413572cfb8d37f296aa1..7cbb79ed548becc01be978bc38c2025f4ddd6cef 100644
--- a/test/Makefile.dot
+++ b/test/Makefile.dot
@@ -1,4 +1,4 @@
-# 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 $@
diff --git a/tools/rdbg4sasa/daemongui.ml b/tools/rdbg4sasa/daemongui.ml
index b0d5e6febac1510b6208b53e9f00da688cef9cc3..4192fb4d8595546c4153f4c59e6892a0d8f51d39 100644
--- a/tools/rdbg4sasa/daemongui.ml
+++ b/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
+
*)
diff --git a/tools/rdbg4sasa/sasa-rdbg-cmds.ml b/tools/rdbg4sasa/sasa-rdbg-cmds.ml
index 7a68566640ffd2e26bd09e738ea39a70305aee61..ca332620d53b296aac64929400e5f30fd91e8999 100644
--- a/tools/rdbg4sasa/sasa-rdbg-cmds.ml
+++ b/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