From 74b9fe9a3ef102228e67ef0db9d088c44083693a Mon Sep 17 00:00:00 2001
From: Guillaume Raffin <theelectronwill@gmail.com>
Date: Mon, 22 Mar 2021 16:49:29 +0100
Subject: [PATCH 01/27] =?UTF-8?q?Interface=20graphique=20pour=20jouer=20un?=
 =?UTF-8?q?=20d=C3=A9mon=20manuellement?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 tools/daemongui/.gitignore |   1 +
 tools/daemongui/dune       |  14 ++
 tools/daemongui/gui.ml     | 331 +++++++++++++++++++++++++++++++++++++
 3 files changed, 346 insertions(+)
 create mode 100644 tools/daemongui/.gitignore
 create mode 100644 tools/daemongui/dune
 create mode 100644 tools/daemongui/gui.ml

diff --git a/tools/daemongui/.gitignore b/tools/daemongui/.gitignore
new file mode 100644
index 0000000..b095bbf
--- /dev/null
+++ b/tools/daemongui/.gitignore
@@ -0,0 +1 @@
+gui
diff --git a/tools/daemongui/dune b/tools/daemongui/dune
new file mode 100644
index 0000000..a18ca44
--- /dev/null
+++ b/tools/daemongui/dune
@@ -0,0 +1,14 @@
+
+
+(executables
+ (names gui )
+ (flags :standard -w -3-6-7-10-24-26-27-33-35 -no-strict-sequence)
+ (libraries lablgtk3 str lutils))
+
+(install
+ (section bin)
+ (package gui)
+ (files
+  (daemongui.exe as daemongui)
+ )
+)
diff --git a/tools/daemongui/gui.ml b/tools/daemongui/gui.ml
new file mode 100644
index 0000000..d61555e
--- /dev/null
+++ b/tools/daemongui/gui.ml
@@ -0,0 +1,331 @@
+open GMain
+open GdkKeysyms
+
+(* Lance rdbg avec les arguments passés au gui *)
+let from_rdbg, to_rdbg =
+  let quote str = if String.contains str ' ' then ("\""^str^"\"") else str in
+  let rdbg_cmd = String.concat " " ("rdbg"::(List.tl (List.map quote (Array.to_list Sys.argv)))) in
+  Unix.open_process rdbg_cmd
+
+let _ = Unix.set_nonblock (Unix.descr_of_in_channel from_rdbg)
+
+(** Lit la sortie d'un processus.
+  Renvoie None si la fin du flux est atteinte *)
+let read_stdout (ic: in_channel): string option =
+  let buff = Bytes.create 512 in
+  let res  = ref "" in
+  let cond = ref true in
+  let eof = ref false in
+  Unix.sleepf 0.5;
+  while !cond do
+    try
+      let n = Stdlib.input ic buff 0 512 in
+      res := !res ^ (Bytes.sub_string buff 0 n);
+      if n < 512 then cond := false;
+      if n == 0 then eof := true;
+    with Sys_blocked_io -> cond := false
+  done;
+  if !eof then None else Some !res
+
+(* Fonctions pour travailler avec les commandes rdbg *)
+type command_state =
+  | Normal
+  | Save
+
+let cmd_loop = ref false
+let cmd_state = ref Normal
+let cmd_output: string option ref = ref None
+
+let read_rdbg_out (): bool =
+  let res = read_stdout from_rdbg in
+    match res with
+    | None ->
+        if !cmd_state == Save then
+          cmd_output := Some ""; (* set cmd_output to exit the loop in rdbg_cmd *)
+        false
+    | Some str ->
+        let str = String.trim str in
+        if String.length str > 0 then Printf.printf "%s " str;
+        match !cmd_state with
+        | Normal -> ();
+        | Save ->
+            cmd_output := res;
+            cmd_state := Normal;
+        ;
+        true
+
+(** Envoie une commande à rdbg *)
+let rdbg (str: string) =
+  Printf.printf "%s\n%!" str;
+  Printf.fprintf to_rdbg "%s\n%!" str;
+  ()
+
+(** Envoie une commande à rdbg et récupère son résultat *)
+let rdbg_get (cmd: string): string =
+  cmd_state := Save;
+  cmd_output := None;
+  rdbg cmd;
+  if not !cmd_loop then ignore(read_rdbg_out ());
+  while !cmd_output == None do
+    ();
+  done;
+  cmd_state := Normal;
+  match !cmd_output with
+  | Some str ->
+    (* supprime le prompt rdbg du résultat *)
+    Str.global_replace (Str.regexp_string "(rdbg) ") "" str
+  | None -> assert false
+  (* NB: on ne peut pas faire let rec x = truc qui appelle x dans un match *)
+
+(** Compte le nombre de noeuds *)
+let rdbg_count_nodes (): int =
+  let cmd = " List.length (List.filter (fun (n,v) -> String.length n > 5 && String.sub n 0 5 = \"Enab_\") !e.outputs);;" in
+  let res = rdbg_get cmd in
+  (* rdbg renvoie une réponse qui ressemble à "- : int = 7" *)
+  (* on prend ce qui est après le '=' *)
+  let count_str = List.hd (List.tl (String.split_on_char '=' res)) in
+  int_of_string (String.trim count_str)
+
+(** Extrait le nom et l'état des noeuds
+ @return nom * etat * activable ou non
+ *)
+let rec rdbg_nodes_info (): (string * string * bool) list =
+  (* récupère une liste qui dit si chaque état de chaque noeud est activable/pas activable *)
+
+  let cmd = " String.concat \";\" (List.map (fun (n,v) -> Printf.sprintf \"%s=%s\" (String.sub n 5 (String.length n - 5)) (val_to_string string_of_float v)) (List.filter (fun (n,v) -> String.length n > 5 && String.sub n 0 5 = \"Enab_\") !e.data));;" in
+  let res =
+    let res = rdbg_get cmd in
+    if not (Str.string_partial_match (Str.regexp "[ \n]*- : string =") res 0) then
+      (* On recommence si on a obtenu un résultat incohérent (bug suite à la vérification que
+         !e.data a été chargé) *)
+      rdbg_get " ;;"
+    else
+      res
+  in
+
+  (* rdbg renvoie - : string = "p1_conflict=f;p2_conflict=t" etc. *)
+  (* "p1" est le nom du noeud, "conflict" le nom de l'état, f=false donc non activable, t=true donc activable *)
+  let data = String.trim (String.sub res 13 (String.length res - 13)) in
+  let data = String.trim (Str.global_replace (Str.regexp_string "\"") "" data) in
+  List.map (fun str ->
+    let parts = String.split_on_char '=' str in
+    match parts with
+    | a::b::[] ->
+      (match String.split_on_char '_' a with
+        | node::state::[] ->
+          let node_enabled = match b with
+            | "t" | "true" -> true
+            | _ -> false
+          in
+          (node, state, node_enabled)
+        | _ ->
+          Printf.printf "\nERROR: %s" a;
+          assert false;)
+    | _ ->
+      Printf.printf "\nERROR: %s" str;
+      assert false;
+  ) (String.split_on_char ';' data)
+
+(** Hashtable qui dit pour chaque noeud s'il est activable (càd s'il a un état activable) ou non.
+On considère que les états sont mutuellement exclusifs. *)
+let rdbg_nodes_enabled () =
+  let table = Hashtbl.create 8 in
+  List.iter (fun (node, state, enabled) ->
+    let prev_enab =
+      match Hashtbl.find_opt table node with
+      | None -> false
+      | Some e -> e
+    in
+    Hashtbl.replace table node (prev_enab || enabled)
+  ) (rdbg_nodes_info ());
+  table
+
+let hook_hashtbl_name = "daemongui_activate"
+
+(** Met en place le hook  *)
+let init_rdbg_hook () =
+  let value = "Hashtbl.create 1" in
+  let cmd = Printf.sprintf " let %s = %s;;" hook_hashtbl_name value in
+  rdbg cmd;
+  ignore(read_rdbg_out ());
+
+  let cmd = Printf.sprintf " let daemongui sl =
+    let sl = List.filter (fun (n,v) -> String.length n > 5 && String.sub n 0 5 = \"Enab_\") sl in
+    let res = List.map (fun (n,enabled) ->
+      (* n est de la forme Enab_node_state, enabled est un Data.v *)
+      let str = String.sub n 5 ((String.length n)-5) in
+      let node_name = List.hd (String.split_on_char '_' str) in
+      let to_activate = match Hashtbl.find_opt %s node_name with
+        | None -> false
+        | Some x -> x
+      in
+      let activate = match enabled with
+        | B true -> B to_activate
+        | _ -> B false
+      in
+      (str, activate)
+    ) sl in
+    Some res;;" hook_hashtbl_name in
+  rdbg cmd;
+  ignore(read_rdbg_out ());
+
+  let cmd = " rdbg_mv_hook := Some daemongui;;" in
+  rdbg cmd;
+  ignore(read_rdbg_out ());
+  ()
+
+(** Met à jour le hook pour un noeud  *)
+let update_rdbg_hook node activate =
+  let cmd = Printf.sprintf " Hashtbl.replace %s \"%s\" %B;;"
+    hook_hashtbl_name node activate
+  in
+  rdbg cmd;
+  ignore(read_rdbg_out ());
+  ()
+
+(* GTK3 *)
+let locale = GtkMain.Main.init ()
+let thread = GtkThread.start()
+let main () =
+  let window = GWindow.window ~width:320 ~height:240
+                              ~title:"Daemon GUI"
+                              ~show:true () in
+  let vbox = GPack.vbox ~packing:window#add () in
+  ignore (window#connect#destroy ~callback: (
+    fun () ->
+      rdbg "q"; (* quit rdbg, this will stop the readloop below *)
+      Main.quit () (* terminate gtk *)
+  ));
+
+  (* attend le chargement de la session rdbg *)
+  (* On attend après avoir lancé l'UI pour que l'utilisateur ne s'impatiente pas *)
+  let rec wait_for_rdbg () =
+    match read_stdout from_rdbg with
+    | None -> ();
+    | Some str ->
+        Printf.printf "%s%!" str;
+        let tr = String.trim str in
+        if not (Str.string_match (Str.regexp ".*\\(rdbg\\).*") tr 0) then wait_for_rdbg ()
+  in
+  wait_for_rdbg ();
+
+  (* création du rdbg_mv_hook et de tout ce qu'il faut autour *)
+  init_rdbg_hook ();
+
+  (* attend que !e.data soit dispo *)
+  (* let rec wait_for_data () =
+    rdbg_get " !e.data;;";
+    Unix.sleepf 1.5;
+    match read_stdout from_rdbg with
+      | None -> wait_for_data ();
+      | Some res ->
+        match String.trim res with
+        | "" -> wait_for_data ();
+        | _ -> ();
+  in *)
+  let rec wait_for_data () =
+    let res = String.trim (rdbg_get " !e.data;;") in
+    Printf.printf "\n%s\n:---\n%!" res;
+    match res with
+      | "" -> wait_for_data ();
+      | _ -> ();
+  in
+  ignore (read_rdbg_out ());
+  Unix.sleepf 1.5;
+  wait_for_data ();
+  Unix.sleepf 1.5;
+
+  (* 1 case par noeud : activer/pas activer *)
+  (* NB : lablgtk3 ne propose pas le FlowBox (pourtant dispo dans GTK >= 3.12) *)
+  let container = GPack.hbox ~packing:vbox#add () in
+  (* let n = rdbg_count_nodes () in *)
+  (* let range = List.init n (fun x -> x + 1) in *)
+  let nodes_table = rdbg_nodes_enabled () in
+  let nodes_enabled = Hashtbl.to_seq nodes_table in
+  let n = Hashtbl.length nodes_table in
+
+  let checkboxes_map = Hashtbl.create n in
+  Seq.iter (fun (name, enabled) ->
+    (* cf. classe toggle_button de lablgtk3 *)
+    let checkbox = GButton.check_button ~label:name ~packing:container#add () in
+    (* Quand on coche/décoche, met à jour le rdbg_mv_hook *)
+    ignore(checkbox#connect#toggled ~callback: (fun () ->
+      update_rdbg_hook name checkbox#active
+    ));
+    checkbox#set_sensitive enabled; (* désactive la box si le noeud n'est pas activable *)
+    checkbox#set_active false; (* décoche la case *)
+    Hashtbl.add checkboxes_map name checkbox
+  ) nodes_enabled;
+
+  let update_checkbox node enabled =
+    let checkbox = Hashtbl.find checkboxes_map node in
+    checkbox#set_sensitive enabled
+  in
+
+  (* Affichage d'informations *)
+  let scrolled = GBin.scrolled_window ~border_width:10
+    ~shadow_type:`OUT ~height:250 ~packing:vbox#add ()
+  in
+  let gtext = GText.view ~wrap_mode:`CHAR ~height:50 ~editable:false ~width:50
+    ~packing: scrolled#add () ~cursor_visible:true
+  in
+
+  let gtext_content = ref "Noeuds activables :" in
+  gtext#buffer#set_text !gtext_content;
+
+  let print_gui str =
+    let txt = Printf.sprintf "%s\n%s" !gtext_content str in
+    gtext#buffer#set_text txt;
+    gtext_content := txt;
+  in
+
+  Seq.iter (fun (name, enabled) ->
+    print_gui (Printf.sprintf "%s : %B" name enabled);
+  ) nodes_enabled;
+
+  (* Boutons de contrôle de la simulation *)
+  let hbox = GPack.hbox ~packing:vbox#add () in
+
+  let update_all_checkboxes () =
+    print_gui "Nouveaux noeuds activables :";
+    Seq.iter (fun (name, enabled) ->
+      update_checkbox name enabled;
+      print_gui (Printf.sprintf "%s : %B" name enabled);
+    ) (Hashtbl.to_seq (rdbg_nodes_enabled ()))
+  in
+
+  let rdbg_btn label cmd =
+    let btn = GButton.button ~label:label ~packing:hbox#add () in
+    btn#misc#set_tooltip_text "tooltip";
+    ignore (btn#connect#clicked ~callback: (
+      fun () ->
+        rdbg cmd;
+        Unix.sleepf 0.5;
+        ignore (read_rdbg_out ());
+        print_gui (Printf.sprintf "> %s" cmd);
+        update_all_checkboxes ();
+      )
+    );
+    btn
+  in
+
+  let _ = rdbg_btn "<<" "pr" in
+  let _ = rdbg_btn "<" "bd" in
+  let _ = rdbg_btn "G" "graph_view" in
+  let _ = rdbg_btn ">" "sd" in
+  let _ = rdbg_btn ">>" "nr" in
+
+  (* Read rdbg output until rdbg is closed *)
+  let rec read_stdout_loop () =
+    if read_rdbg_out () then read_stdout_loop () else ()
+  in
+  cmd_loop := true;
+  read_stdout_loop ()
+
+let () =
+  (* choix de session *)
+  ignore (read_rdbg_out ());
+  ignore (rdbg "\n");
+
+  (* lance l'interface graphique *)
+  main ()
-- 
GitLab


From 02ecf97cbec8cc9ded31011e3962634765ed5c37 Mon Sep 17 00:00:00 2001
From: Guillaume Raffin <theelectronwill@gmail.com>
Date: Mon, 22 Mar 2021 17:52:42 +0100
Subject: [PATCH 02/27] Cleanup, mais toujours le bug

---
 tools/daemongui/gui.ml | 48 ++++++++++++++----------------------------
 1 file changed, 16 insertions(+), 32 deletions(-)

diff --git a/tools/daemongui/gui.ml b/tools/daemongui/gui.ml
index d61555e..0c7cbd3 100644
--- a/tools/daemongui/gui.ml
+++ b/tools/daemongui/gui.ml
@@ -41,11 +41,11 @@ let read_rdbg_out (): bool =
     match res with
     | None ->
         if !cmd_state == Save then
-          cmd_output := Some ""; (* set cmd_output to exit the loop in rdbg_cmd *)
+          cmd_output := Some ""; (* set cmd_output to exit the loop in rdbg_get *)
         false
     | Some str ->
         let str = String.trim str in
-        if String.length str > 0 then Printf.printf "%s " str;
+        if String.length str > 0 then Printf.printf "%s" str;
         match !cmd_state with
         | Normal -> ();
         | Save ->
@@ -56,8 +56,8 @@ let read_rdbg_out (): bool =
 
 (** Envoie une commande à rdbg *)
 let rdbg (str: string) =
-  Printf.printf "%s\n%!" str;
   Printf.fprintf to_rdbg "%s\n%!" str;
+  Printf.printf "%s\n%!" str;
   ()
 
 (** Envoie une commande à rdbg et récupère son résultat *)
@@ -65,9 +65,8 @@ let rdbg_get (cmd: string): string =
   cmd_state := Save;
   cmd_output := None;
   rdbg cmd;
-  if not !cmd_loop then ignore(read_rdbg_out ());
   while !cmd_output == None do
-    ();
+    if not !cmd_loop then ignore(read_rdbg_out ()) else ();
   done;
   cmd_state := Normal;
   match !cmd_output with
@@ -146,8 +145,7 @@ let hook_hashtbl_name = "daemongui_activate"
 let init_rdbg_hook () =
   let value = "Hashtbl.create 1" in
   let cmd = Printf.sprintf " let %s = %s;;" hook_hashtbl_name value in
-  rdbg cmd;
-  ignore(read_rdbg_out ());
+  assert (String.length (rdbg_get cmd) > 0);
 
   let cmd = Printf.sprintf " let daemongui sl =
     let sl = List.filter (fun (n,v) -> String.length n > 5 && String.sub n 0 5 = \"Enab_\") sl in
@@ -166,12 +164,10 @@ let init_rdbg_hook () =
       (str, activate)
     ) sl in
     Some res;;" hook_hashtbl_name in
-  rdbg cmd;
-  ignore(read_rdbg_out ());
+  assert (String.length (rdbg_get cmd) > 0);
 
   let cmd = " rdbg_mv_hook := Some daemongui;;" in
-  rdbg cmd;
-  ignore(read_rdbg_out ());
+  assert (String.length (rdbg_get cmd) > 0);
   ()
 
 (** Met à jour le hook pour un noeud  *)
@@ -213,27 +209,16 @@ let main () =
   init_rdbg_hook ();
 
   (* attend que !e.data soit dispo *)
-  (* let rec wait_for_data () =
-    rdbg_get " !e.data;;";
-    Unix.sleepf 1.5;
-    match read_stdout from_rdbg with
-      | None -> wait_for_data ();
-      | Some res ->
-        match String.trim res with
-        | "" -> wait_for_data ();
-        | _ -> ();
-  in *)
-  let rec wait_for_data () =
-    let res = String.trim (rdbg_get " !e.data;;") in
-    Printf.printf "\n%s\n:---\n%!" res;
-    match res with
-      | "" -> wait_for_data ();
-      | _ -> ();
-  in
-  ignore (read_rdbg_out ());
-  Unix.sleepf 1.5;
-  wait_for_data ();
+  (*
+  BUG - la sortie de la commande ci-dessous ne sera visible qu'à la commande suivante,
+  ce qui décale tout...
+  Cet assert échoue mais ne devrait pas :
+
+  assert (String.length (String.trim (rdbg_get " !e.data;;")) > 0);
+  *)
+  rdbg " !e.data;;";
   Unix.sleepf 1.5;
+  ignore(read_rdbg_out ());
 
   (* 1 case par noeud : activer/pas activer *)
   (* NB : lablgtk3 ne propose pas le FlowBox (pourtant dispo dans GTK >= 3.12) *)
@@ -300,7 +285,6 @@ let main () =
     ignore (btn#connect#clicked ~callback: (
       fun () ->
         rdbg cmd;
-        Unix.sleepf 0.5;
         ignore (read_rdbg_out ());
         print_gui (Printf.sprintf "> %s" cmd);
         update_all_checkboxes ();
-- 
GitLab


From 9c5787e97346a48c8b5008eeafe5b3bd87d84c49 Mon Sep 17 00:00:00 2001
From: Guillaume Raffin <theelectronwill@gmail.com>
Date: Mon, 22 Mar 2021 17:59:34 +0100
Subject: [PATCH 03/27] + de commentaires

---
 tools/daemongui/gui.ml | 15 +++++++++------
 1 file changed, 9 insertions(+), 6 deletions(-)

diff --git a/tools/daemongui/gui.ml b/tools/daemongui/gui.ml
index 0c7cbd3..73469d9 100644
--- a/tools/daemongui/gui.ml
+++ b/tools/daemongui/gui.ml
@@ -66,6 +66,10 @@ let rdbg_get (cmd: string): string =
   cmd_output := None;
   rdbg cmd;
   while !cmd_output == None do
+    (*
+    Si cmd_loop vaut true c'est qu'il y a une boucle en court qui lit la sortie de rdbg
+    Sinon, il faut lire la sortie ici.
+    *)
     if not !cmd_loop then ignore(read_rdbg_out ()) else ();
   done;
   cmd_state := Normal;
@@ -74,7 +78,6 @@ let rdbg_get (cmd: string): string =
     (* supprime le prompt rdbg du résultat *)
     Str.global_replace (Str.regexp_string "(rdbg) ") "" str
   | None -> assert false
-  (* NB: on ne peut pas faire let rec x = truc qui appelle x dans un match *)
 
 (** Compte le nombre de noeuds *)
 let rdbg_count_nodes (): int =
@@ -85,9 +88,10 @@ let rdbg_count_nodes (): int =
   let count_str = List.hd (List.tl (String.split_on_char '=' res)) in
   int_of_string (String.trim count_str)
 
-(** Extrait le nom et l'état des noeuds
- @return nom * etat * activable ou non
- *)
+(**
+Extrait le nom et l'état des noeuds
+@return liste de tuples (nom, etat, activable)
+*)
 let rec rdbg_nodes_info (): (string * string * bool) list =
   (* récupère une liste qui dit si chaque état de chaque noeud est activable/pas activable *)
 
@@ -139,6 +143,7 @@ let rdbg_nodes_enabled () =
   ) (rdbg_nodes_info ());
   table
 
+(** Nom de la table utilisée par le hook dans rdbg *)
 let hook_hashtbl_name = "daemongui_activate"
 
 (** Met en place le hook  *)
@@ -223,8 +228,6 @@ let main () =
   (* 1 case par noeud : activer/pas activer *)
   (* NB : lablgtk3 ne propose pas le FlowBox (pourtant dispo dans GTK >= 3.12) *)
   let container = GPack.hbox ~packing:vbox#add () in
-  (* let n = rdbg_count_nodes () in *)
-  (* let range = List.init n (fun x -> x + 1) in *)
   let nodes_table = rdbg_nodes_enabled () in
   let nodes_enabled = Hashtbl.to_seq nodes_table in
   let n = Hashtbl.length nodes_table in
-- 
GitLab


From db2aff3d0c9b7664e4eb51307d845baffba147b4 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Mon, 22 Mar 2021 21:12:45 +0100
Subject: [PATCH 04/27] Fix the dune building process

---
 gui.opam               | 21 +++++++++++++++++++++
 tools/daemongui/dune   |  2 +-
 tools/daemongui/gui.ml |  3 ++-
 3 files changed, 24 insertions(+), 2 deletions(-)
 create mode 100644 gui.opam

diff --git a/gui.opam b/gui.opam
new file mode 100644
index 0000000..6935db2
--- /dev/null
+++ b/gui.opam
@@ -0,0 +1,21 @@
+opam-version: "2.0"
+synopsis: "A Graphical User Interface for XXX"
+maintainer: "XXX"
+description: """
+sasa is a *Self-stabilizing Algorithms SimulAtor*. XXX
+"""
+authors: [ "XXX" ]
+license: "CeCILL"
+homepage: "https://gricad-gitlab.univ-grenoble-alpes.fr/verimag/synchrone/sasa"
+dev-repo: "https://gricad-gitlab.univ-grenoble-alpes.fr/verimag/synchrone/sasa.git"
+bug-reports: "https://gricad-gitlab.univ-grenoble-alpes.fr/verimag/synchrone/sasa/issues"
+build:  [make "build"]
+install:  [make "install"]
+depends: [
+  "lablgtk3"
+  "sasa"
+]
+depexts: [
+  ["graphviz" "emacs" "gnuplot" "zathura"]
+]
+post-messages: ["The last version can be obtained via (opam repo add) http://www-verimag.imag.fr/DIST-TOOLS/SYNCHRONE/opam-repository/ "]
diff --git a/tools/daemongui/dune b/tools/daemongui/dune
index a18ca44..1a63067 100644
--- a/tools/daemongui/dune
+++ b/tools/daemongui/dune
@@ -9,6 +9,6 @@
  (section bin)
  (package gui)
  (files
-  (daemongui.exe as daemongui)
+  (gui.exe as daemongui)
  )
 )
diff --git a/tools/daemongui/gui.ml b/tools/daemongui/gui.ml
index 73469d9..191f824 100644
--- a/tools/daemongui/gui.ml
+++ b/tools/daemongui/gui.ml
@@ -1,3 +1,4 @@
+
 open GMain
 open GdkKeysyms
 
@@ -92,7 +93,7 @@ let rdbg_count_nodes (): int =
 Extrait le nom et l'état des noeuds
 @return liste de tuples (nom, etat, activable)
 *)
-let rec rdbg_nodes_info (): (string * string * bool) list =
+let  rdbg_nodes_info (): (string * string * bool) list =
   (* récupère une liste qui dit si chaque état de chaque noeud est activable/pas activable *)
 
   let cmd = " String.concat \";\" (List.map (fun (n,v) -> Printf.sprintf \"%s=%s\" (String.sub n 5 (String.length n - 5)) (val_to_string string_of_float v)) (List.filter (fun (n,v) -> String.length n > 5 && String.sub n 0 5 = \"Enab_\") !e.data));;" in
-- 
GitLab


From f2c146d9052ce7844774be38776d43b8f8f25a52 Mon Sep 17 00:00:00 2001
From: Guillaume Raffin <theelectronwill@gmail.com>
Date: Mon, 22 Mar 2021 22:32:01 +0100
Subject: [PATCH 05/27] Les scripts bash

---
 tools/daemongui/.gitignore |  1 +
 tools/daemongui/build.sh   |  3 +++
 tools/daemongui/run.sh     | 10 ++++++++++
 3 files changed, 14 insertions(+)
 create mode 100755 tools/daemongui/build.sh
 create mode 100755 tools/daemongui/run.sh

diff --git a/tools/daemongui/.gitignore b/tools/daemongui/.gitignore
index b095bbf..a7f2cfc 100644
--- a/tools/daemongui/.gitignore
+++ b/tools/daemongui/.gitignore
@@ -1 +1,2 @@
 gui
+!*.sh
diff --git a/tools/daemongui/build.sh b/tools/daemongui/build.sh
new file mode 100755
index 0000000..ee5aacc
--- /dev/null
+++ b/tools/daemongui/build.sh
@@ -0,0 +1,3 @@
+#!/bin/bash
+
+ocamlfind ocamlc str.cma -g -thread -package lablgtk3 -linkpkg gui.ml -o gui
diff --git a/tools/daemongui/run.sh b/tools/daemongui/run.sh
new file mode 100755
index 0000000..1e5e1c9
--- /dev/null
+++ b/tools/daemongui/run.sh
@@ -0,0 +1,10 @@
+#!/bin/bash
+
+set -e
+cd $(dirname "$0")
+exe=$(readlink -f ./gui)
+
+./build.sh
+cd ../../test/coloring
+"$exe" -sut "sasa -custd ring.dot" --missing-vars-last
+#"$exe" -sut "sasa ring.dot"
-- 
GitLab


From 12e571b0e473cce5b1847218a669714cdba7722b Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Wed, 24 Mar 2021 11:56:17 +0100
Subject: [PATCH 06/27] Add a daemongui.ml similar to gui.ml except that

to try it :

cd test/coloring
echo "(* Do not edit me ; edit mv_hook.ml instead! *)" > include.ml
echo "#use \"../../tools/rdbg4sasa/daemongui.ml\";;" >> include.ml
make grid4.ml
ledit rdbg --missing-vars-last  -env "sasa grid4.dot -custd"
---
 tools/rdbg4sasa/daemongui.ml | 161 +++++++++++++++++++++++++++++++++++
 tools/rdbg4sasa/dune         |   2 +-
 2 files changed, 162 insertions(+), 1 deletion(-)
 create mode 100644 tools/rdbg4sasa/daemongui.ml

diff --git a/tools/rdbg4sasa/daemongui.ml b/tools/rdbg4sasa/daemongui.ml
new file mode 100644
index 0000000..aa1de50
--- /dev/null
+++ b/tools/rdbg4sasa/daemongui.ml
@@ -0,0 +1,161 @@
+
+#thread
+#require "lablgtk3"
+
+open GMain
+open GdkKeysyms
+open RdbgEvent
+open Data
+
+(** Extrait le nom et l'état des noeuds
+@return liste de tuples (nom, etat, activable)
+*)
+let rdbg_nodes_info e: (string * string * bool) list =
+  (* récupère une liste qui dit si chaque état de chaque noeud est activable/pas activable *)
+  let enabled =
+    List.filter (fun (n,v) -> String.length n > 5 && String.sub n 0 5 = "Enab_") e.data
+  in  
+  let split_var (str, value) =
+    let v = match value with B v -> v | _  -> assert false in
+    let p, label =
+      match String.split_on_char '_' str with
+      | [] | _::[] | _::_::[] -> assert false
+      | _::x::y::_ -> x, y
+    in
+    p, label,v
+  in    
+  List.map split_var enabled
+
+(** Hashtable qui dit pour chaque noeud s'il est activable (càd s'il a un état activable) ou non.
+On considère que les états sont mutuellement exclusifs. *)
+let rdbg_nodes_enabled e =
+  let table = Hashtbl.create 8 in
+  List.iter (fun (node, state, enabled) ->
+      let prev_enab =
+        match Hashtbl.find_opt table node with
+        | None -> false
+        | Some e -> e
+      in
+      Hashtbl.replace table node (prev_enab || enabled)
+    )
+    (rdbg_nodes_info e);
+  table
+
+let daemongui_activate = Hashtbl.create 1
+
+(** Met en place le hook  *)
+let init_rdbg_hook () =
+  let daemongui sl =
+    let sl = List.filter (fun (n,v) -> String.length n > 5 && String.sub n 0 5 = "Enab_") sl in
+    let res = List.map (fun (n,enabled) ->
+        (* n est de la forme Enab_node_state, enabled est un Data.v *)
+        let str = String.sub n 5 ((String.length n)-5) in
+        let node_name = List.hd (String.split_on_char '_' str) in
+        let to_activate = match Hashtbl.find_opt daemongui_activate node_name with
+          | None -> false
+          | Some x -> x
+        in
+        let activate = match enabled with
+          | B true -> B to_activate
+          | _ -> B false
+        in
+        (str, activate)
+      ) sl
+    in
+    Some res
+  in
+  rdbg_mv_hook := Some daemongui
+
+(** Met à jour le hook pour un noeud  *)
+let update_rdbg_hook node activate =
+  Hashtbl.replace daemongui_activate node activate
+
+(* GTK3 *)    
+let main () =
+  let _locale = GtkMain.Main.init () in 
+  let _thread = GtkThread.start () in
+  let window = GWindow.window
+      (*       ~width:320 ~height:240 *)
+      ~title:"Daemon GUI"
+      ~show:true () in
+  let vbox = GPack.vbox ~packing:window#add () in
+  ignore (window#connect#destroy ~callback: (
+      fun () ->
+        quit (); (* quit rdbg, this will stop the readloop below *)
+        Main.quit () (* terminate gtk *)
+    ));
+
+  (* création du rdbg_mv_hook et de tout ce qu'il faut autour *)
+  init_rdbg_hook ();
+
+  (* 1 case par noeud : activer/pas activer *)
+  (* NB : lablgtk3 ne propose pas le FlowBox (pourtant dispo dans GTK >= 3.12) *)
+  let container = GPack.hbox ~packing:vbox#add () in
+  let nodes_table = rdbg_nodes_enabled !e in
+  let nodes_enabled = Hashtbl.to_seq nodes_table in
+  let n = Hashtbl.length nodes_table in
+
+  let checkboxes_map = Hashtbl.create n in
+  Seq.iter (fun (name, enabled) ->
+      (* cf. classe toggle_button de lablgtk3 *)
+      let checkbox = GButton.check_button ~label:name ~packing:container#add () in
+      (* Quand on coche/décoche, met à jour le rdbg_mv_hook *)
+      ignore(checkbox#connect#toggled ~callback: (fun () ->
+          update_rdbg_hook name checkbox#active
+        ));
+      checkbox#set_sensitive enabled; (* désactive la box si le noeud n'est pas activable *)
+      checkbox#set_active false; (* décoche la case *)
+      Hashtbl.add checkboxes_map name checkbox
+    ) nodes_enabled;
+
+  let update_checkbox node enabled =
+    let checkbox = Hashtbl.find checkboxes_map node in
+    checkbox#set_sensitive enabled
+  in
+  
+  (* Affichage d'informations *)
+  let scrolled = GBin.scrolled_window ~border_width:10
+      ~shadow_type:`OUT ~height:250 ~packing:vbox#add ()
+  in
+  let gtext = GText.view ~wrap_mode:`CHAR ~height:50 ~editable:false ~width:50
+      ~packing: scrolled#add () ~cursor_visible:true
+  in
+  let gtext_content = ref "Noeuds activables :" in
+  gtext#buffer#set_text !gtext_content;
+  let print_gui str =
+    let txt = Printf.sprintf "%s\n%s" !gtext_content str in
+    gtext#buffer#set_text txt;
+    gtext_content := txt;
+  in
+  Seq.iter (fun (name, enabled) ->
+      print_gui (Printf.sprintf "%s : %B" name enabled);
+    ) nodes_enabled;
+
+  (* Boutons de contrôle de la simulation *)
+  let hbox = GPack.hbox ~packing:vbox#add () in
+  let update_all_checkboxes () =
+    print_gui "Nouveaux noeuds activables :";
+    Seq.iter (fun (name, enabled) ->
+        update_checkbox name enabled;
+        print_gui (Printf.sprintf "%s : %B" name enabled);
+      )
+      (Hashtbl.to_seq (rdbg_nodes_enabled !e))
+  in
+  let rdbg_btn label cmd =
+    let btn = GButton.button ~label:label ~packing:hbox#add () in
+    btn#misc#set_tooltip_text "tooltip";
+    ignore (btn#connect#clicked ~callback: (
+        fun () ->
+          cmd ();
+          print_gui (Printf.sprintf "> %s" label);
+          update_all_checkboxes ();
+      ));
+    btn
+  in
+  let _ = rdbg_btn "<<" pr in
+  let _ = rdbg_btn "<" bd in
+  let _ = rdbg_btn "G" graph_view in
+  let _ = rdbg_btn ">" sd in
+  let _ = rdbg_btn ">>" nr in
+  let _ = rdbg_btn "q" q in
+  ()
diff --git a/tools/rdbg4sasa/dune b/tools/rdbg4sasa/dune
index 2fcfde6..25cbaac 100644
--- a/tools/rdbg4sasa/dune
+++ b/tools/rdbg4sasa/dune
@@ -1,6 +1,6 @@
 
 (install
- (files sasa-rdbg-cmds.ml dot4sasa.ml)
+ (files sasa-rdbg-cmds.ml dot4sasa.ml daemongui.ml)
  (section lib)
  (package sasa)
 )
-- 
GitLab


From b08b28f6547ac7c63ed0235a5ab1b512c52e3adb Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Wed, 24 Mar 2021 18:57:55 +0100
Subject: [PATCH 07/27] =?UTF-8?q?Les=20boutons=20dans=20une=20grille=20fai?=
 =?UTF-8?q?te=20=C3=A0=20la=20main?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 tools/rdbg4sasa/daemongui.ml | 35 +++++++++++++++++++++++------------
 1 file changed, 23 insertions(+), 12 deletions(-)

diff --git a/tools/rdbg4sasa/daemongui.ml b/tools/rdbg4sasa/daemongui.ml
index aa1de50..f48746d 100644
--- a/tools/rdbg4sasa/daemongui.ml
+++ b/tools/rdbg4sasa/daemongui.ml
@@ -94,25 +94,36 @@ let main () =
   let nodes_table = rdbg_nodes_enabled !e in
   let nodes_enabled = Hashtbl.to_seq nodes_table in
   let n = Hashtbl.length nodes_table in
-
+  let m = int_of_float (sqrt (float_of_int n)) in
+  (* build manually a m x m grid *)
+  let i = ref 0 in
+  let container_ref = ref container in
   let checkboxes_map = Hashtbl.create n in
   Seq.iter (fun (name, enabled) ->
-      (* cf. classe toggle_button de lablgtk3 *)
-      let checkbox = GButton.check_button ~label:name ~packing:container#add () in
-      (* Quand on coche/décoche, met à jour le rdbg_mv_hook *)
-      ignore(checkbox#connect#toggled ~callback: (fun () ->
-          update_rdbg_hook name checkbox#active
-        ));
-      checkbox#set_sensitive enabled; (* désactive la box si le noeud n'est pas activable *)
-      checkbox#set_active false; (* décoche la case *)
-      Hashtbl.add checkboxes_map name checkbox
-    ) nodes_enabled;
+        incr i;
+        if !i > m then (
+          i := 0;
+          let new_container = GPack.hbox ~packing:vbox#add () in
+          container_ref := new_container
+        );
+        (* cf. classe toggle_button de lablgtk3 *)
+        let checkbox = GButton.check_button ~label:name ~packing:!container_ref#add () in 
+        (* Quand on coche/décoche, met à jour le rdbg_mv_hook *)
+        ignore(checkbox#connect#toggled ~callback: (fun () ->
+            update_rdbg_hook name checkbox#active
+          ));
+        checkbox#set_sensitive enabled; (* désactive la box si le noeud n'est pas activable *)
+        checkbox#set_active false; (* décoche la case *)
+        Hashtbl.add checkboxes_map name checkbox
+      )
+    nodes_enabled;
 
   let update_checkbox node enabled =
     let checkbox = Hashtbl.find checkboxes_map node in
+    if not enabled then checkbox#set_active false; (* on decoche *)
     checkbox#set_sensitive enabled
   in
-  
+
   (* Affichage d'informations *)
   let scrolled = GBin.scrolled_window ~border_width:10
       ~shadow_type:`OUT ~height:250 ~packing:vbox#add ()
-- 
GitLab


From 4b00865eb248320c77e69ba09690d93ae569fcfa Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Wed, 24 Mar 2021 21:21:17 +0100
Subject: [PATCH 08/27] Les nodes dans l'ordre + on les cache si pas enab

---
 tools/rdbg4sasa/daemongui.ml | 50 ++++++++++++++++++++----------------
 1 file changed, 28 insertions(+), 22 deletions(-)

diff --git a/tools/rdbg4sasa/daemongui.ml b/tools/rdbg4sasa/daemongui.ml
index f48746d..5b9a420 100644
--- a/tools/rdbg4sasa/daemongui.ml
+++ b/tools/rdbg4sasa/daemongui.ml
@@ -29,18 +29,22 @@ let rdbg_nodes_info e: (string * string * bool) list =
 (** Hashtable qui dit pour chaque noeud s'il est activable (càd s'il a un état activable) ou non.
 On considère que les états sont mutuellement exclusifs. *)
 let rdbg_nodes_enabled e =
-  let table = Hashtbl.create 8 in
-  List.iter (fun (node, state, enabled) ->
-      let prev_enab =
-        match Hashtbl.find_opt table node with
-        | None -> false
-        | Some e -> e
-      in
-      Hashtbl.replace table node (prev_enab || enabled)
-    )
-    (rdbg_nodes_info e);
-  table
-
+  match rdbg_nodes_info e with
+  | [] -> assert false
+  | (node, _, enab)::l -> 
+    let last, res =
+      List.fold_left
+        (fun ((p_node, p_enab), res) (node, state, enab) ->
+           if p_node = node then
+             (node, p_enab || enab), res
+           else
+             (node, enab), (p_node, p_enab)::res
+        )
+        ((node, enab), [])
+        l
+    in
+    List.rev (last::res)
+  
 let daemongui_activate = Hashtbl.create 1
 
 (** Met en place le hook  *)
@@ -91,15 +95,14 @@ let main () =
   (* 1 case par noeud : activer/pas activer *)
   (* NB : lablgtk3 ne propose pas le FlowBox (pourtant dispo dans GTK >= 3.12) *)
   let container = GPack.hbox ~packing:vbox#add () in
-  let nodes_table = rdbg_nodes_enabled !e in
-  let nodes_enabled = Hashtbl.to_seq nodes_table in
-  let n = Hashtbl.length nodes_table in
+  let nodes_enabled = rdbg_nodes_enabled !e in
+  let n = List.length nodes_enabled in
   let m = int_of_float (sqrt (float_of_int n)) in
   (* build manually a m x m grid *)
   let i = ref 0 in
   let container_ref = ref container in
   let checkboxes_map = Hashtbl.create n in
-  Seq.iter (fun (name, enabled) ->
+  List.iter (fun (name, enabled) ->
         incr i;
         if !i > m then (
           i := 0;
@@ -120,7 +123,10 @@ let main () =
 
   let update_checkbox node enabled =
     let checkbox = Hashtbl.find checkboxes_map node in
-    if not enabled then checkbox#set_active false; (* on decoche *)
+    if not enabled then (
+      checkbox#set_active false; (* on decoche *)
+      checkbox#misc#hide ()
+    );
     checkbox#set_sensitive enabled
   in
 
@@ -138,19 +144,19 @@ let main () =
     gtext#buffer#set_text txt;
     gtext_content := txt;
   in
-  Seq.iter (fun (name, enabled) ->
-      print_gui (Printf.sprintf "%s : %B" name enabled);
-    ) nodes_enabled;
+  List.iter
+    (fun (name, enabled) -> print_gui (Printf.sprintf "%s : %B" name enabled))
+    nodes_enabled;
 
   (* Boutons de contrôle de la simulation *)
   let hbox = GPack.hbox ~packing:vbox#add () in
   let update_all_checkboxes () =
     print_gui "Nouveaux noeuds activables :";
-    Seq.iter (fun (name, enabled) ->
+    List.iter (fun (name, enabled) ->
         update_checkbox name enabled;
         print_gui (Printf.sprintf "%s : %B" name enabled);
       )
-      (Hashtbl.to_seq (rdbg_nodes_enabled !e))
+      (rdbg_nodes_enabled !e)
   in
   let rdbg_btn label cmd =
     let btn = GButton.button ~label:label ~packing:hbox#add () in
-- 
GitLab


From e7daec8b0c0cfb7b8fac5d549647fc35208cf521 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Thu, 25 Mar 2021 11:28:44 +0100
Subject: [PATCH 09/27] Mise en place de differents modes de simulations (en
 cours)

---
 tools/rdbg4sasa/daemongui.ml | 230 +++++++++++++++++++++++++----------
 1 file changed, 167 insertions(+), 63 deletions(-)

diff --git a/tools/rdbg4sasa/daemongui.ml b/tools/rdbg4sasa/daemongui.ml
index 5b9a420..d913ed4 100644
--- a/tools/rdbg4sasa/daemongui.ml
+++ b/tools/rdbg4sasa/daemongui.ml
@@ -26,8 +26,8 @@ let rdbg_nodes_info e: (string * string * bool) list =
   in    
   List.map split_var enabled
 
-(** Hashtable qui dit pour chaque noeud s'il est activable (càd s'il a un état activable) ou non.
-On considère que les états sont mutuellement exclusifs. *)
+(** Liste qui dit  pour chaque  noeud s'il  est activable.  On suppose
+   qu'ils sont groupés. *)
 let rdbg_nodes_enabled e =
   match rdbg_nodes_info e with
   | [] -> assert false
@@ -45,11 +45,13 @@ let rdbg_nodes_enabled e =
     in
     List.rev (last::res)
   
-let daemongui_activate = Hashtbl.create 1
+type daemon_kind = D | S | C | LC | ManualCentral | Manual 
+let daemon_kind = ref ManualCentral
 
 (** Met en place le hook  *)
+let daemongui_activate = Hashtbl.create 1
 let init_rdbg_hook () =
-  let daemongui sl =
+  let guidaemon sl =
     let sl = List.filter (fun (n,v) -> String.length n > 5 && String.sub n 0 5 = "Enab_") sl in
     let res = List.map (fun (n,enabled) ->
         (* n est de la forme Enab_node_state, enabled est un Data.v *)
@@ -68,11 +70,8 @@ let init_rdbg_hook () =
     in
     Some res
   in
-  rdbg_mv_hook := Some daemongui
+  rdbg_mv_hook := Some guidaemon
 
-(** Met à jour le hook pour un noeud  *)
-let update_rdbg_hook node activate =
-  Hashtbl.replace daemongui_activate node activate
 
 (* GTK3 *)    
 let main () =
@@ -89,90 +88,195 @@ let main () =
         Main.quit () (* terminate gtk *)
     ));
 
+  (* Affichage d'informations *)
+  let gtext_content = ref "" in
+
   (* 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_manual = GPack.hbox ~packing:vbox#add () in
+  let dk_dd = GButton.radio_button  ~active:(!daemon_kind=D)
+      ~label:"Distributed" ~packing:daemon_box#add ()
+  in
+  let dk_cd = GButton.radio_button ~active:(!daemon_kind=C)
+      ~label:"Central" ~group:dk_dd#group ~packing:daemon_box#add ()
+  in
+  let dk_lcd = GButton.radio_button  ~active:(!daemon_kind=LC)
+      ~label:"Locally Central" ~group:dk_dd#group ~packing:daemon_box#add ()
+  in
+  let dk_sd = GButton.radio_button  ~active:(!daemon_kind=S)
+      ~label:"Synchronous" ~group:dk_dd#group ~packing:daemon_box#add ()
+  in
+  let dk_manual = GButton.radio_button  ~active:(!daemon_kind=Manual)
+      ~label:"Manual" ~group:dk_dd#group ~packing:daemon_box_manual#add ()
+  in
+  let dk_manual_central = GButton.radio_button  ~active:(!daemon_kind=ManualCentral)
+      ~label:"Manual Central" ~group:dk_dd#group ~packing:daemon_box_manual#add ()
+  in
+  let scrolled = GBin.scrolled_window ~border_width:10
+      ~shadow_type:`OUT ~height:250 ~packing:vbox#add ()
+  in
+  let gtext = GText.view ~wrap_mode:`CHAR ~height:50 ~editable:false ~width:50
+      ~packing: scrolled#add () ~cursor_visible:true
+  in
+  dk_dd#misc#set_tooltip_text (Printf.sprintf "Set the automatic distributed mode");
+  dk_sd#misc#set_tooltip_text (Printf.sprintf "Set the automatic synchronous mode");
+  dk_cd#misc#set_tooltip_text (Printf.sprintf "Set the automatic central mode");
+  dk_lcd#misc#set_tooltip_text (Printf.sprintf "Set the automatic locally central mode");
+  dk_manual#misc#set_tooltip_text (Printf.sprintf "Set the manual mode");
+  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  *)
+  let update_rdbg_hook node activate =
+    match !daemon_kind with
+    | D | S | C | LC -> assert false (* 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
+  in
+
   (* 1 case par noeud : activer/pas activer *)
   (* NB : lablgtk3 ne propose pas le FlowBox (pourtant dispo dans GTK >= 3.12) *)
-  let container = GPack.hbox ~packing:vbox#add () in
-  let nodes_enabled = rdbg_nodes_enabled !e in
   let n = List.length nodes_enabled in
   let m = int_of_float (sqrt (float_of_int n)) in
+  (* Des checkbox pour le mode Manuel *)
   (* build manually a m x m grid *)
   let i = ref 0 in
-  let container_ref = ref container in
-  let checkboxes_map = Hashtbl.create n in
+  let checkbox_grid = GPack.vbox ~packing:vbox#add () in
+  let checkbox_line = GPack.hbox ~packing:checkbox_grid#add () in
+
+  let checkbox_line_ref = ref checkbox_line in
+  let checkbox_map = Hashtbl.create n in
   List.iter (fun (name, enabled) ->
-        incr i;
-        if !i > m then (
-          i := 0;
-          let new_container = GPack.hbox ~packing:vbox#add () in
-          container_ref := new_container
-        );
-        (* cf. classe toggle_button de lablgtk3 *)
-        let checkbox = GButton.check_button ~label:name ~packing:!container_ref#add () in 
-        (* Quand on coche/décoche, met à jour le rdbg_mv_hook *)
-        ignore(checkbox#connect#toggled ~callback: (fun () ->
-            update_rdbg_hook name checkbox#active
-          ));
-        checkbox#set_sensitive enabled; (* désactive la box si le noeud n'est pas activable *)
-        checkbox#set_active false; (* décoche la case *)
-        Hashtbl.add checkboxes_map name checkbox
-      )
+      incr i;
+      if !i > m then (
+        i := 1;
+        let new_checkbox_line = GPack.hbox ~packing:checkbox_grid#add () in
+        checkbox_line_ref := new_checkbox_line;
+      );
+      (* cf. classe toggle_button de lablgtk3 *)
+      let checkbox = GButton.check_button ~label:name ~packing:!checkbox_line_ref#add () in
+      (* Quand on coche/décoche, met à jour le rdbg_mv_hook *)
+      checkbox#misc#set_tooltip_text (Printf.sprintf "check to activate %s at the next step" name);
+      ignore(checkbox#connect#toggled
+               ~callback: (fun () -> update_rdbg_hook name checkbox#active));
+      checkbox#set_sensitive enabled; (* désactive la box si le noeud n'est pas activable *)
+      checkbox#set_active false; (* décoche la case *)
+      Hashtbl.add checkbox_map name checkbox;
+    )
+    nodes_enabled;
+  (* Des boutons pour le mode Manuel Central *)
+  let pushbox_grid = GPack.vbox ~packing:vbox#add () in
+  let pushbox_line = GPack.hbox ~packing:pushbox_grid#add () in
+  let pushbox_line_ref = ref pushbox_line in
+  let pushbox_map = Hashtbl.create n in
+  i := 0;
+  List.iter (fun (name, enabled) ->
+      incr i;
+      if !i > m then (
+        i := 1;
+        let new_pushbox_line = GPack.hbox ~packing:pushbox_grid#add () in
+        pushbox_line_ref := new_pushbox_line
+      );
+      (* cf. classe toggle_button de lablgtk3 *)
+      let pushbox = GButton.button ~label:name ~packing:!pushbox_line_ref#add () in
+      pushbox#misc#set_tooltip_text (Printf.sprintf "Press to activate %s" name);
+      (* Quand on appuie, met à jour le rdbg_mv_hook *)
+      ignore(pushbox#event#connect#button_press
+               ~callback: (fun _ -> update_rdbg_hook name true; sd(); false));
+      Hashtbl.add pushbox_map name pushbox
+    )
     nodes_enabled;
 
   let update_checkbox node enabled =
-    let checkbox = Hashtbl.find checkboxes_map node in
-    if not enabled then (
-      checkbox#set_active false; (* on decoche *)
-      checkbox#misc#hide ()
-    );
-    checkbox#set_sensitive enabled
+    match !daemon_kind with
+    | Manual ->
+      checkbox_grid#misc#show();
+      pushbox_grid#misc#hide();
+      let checkbox = Hashtbl.find checkbox_map node in
+      if not enabled then (
+        checkbox#set_active false; (* on decoche *)
+        checkbox#misc#hide ()
+      );
+      checkbox#set_sensitive enabled
+    | ManualCentral ->
+      checkbox_grid#misc#hide();
+      pushbox_grid#misc#show();
+      let pushbox = Hashtbl.find pushbox_map node in
+      if not enabled then (pushbox#misc#hide ());
+      pushbox#set_sensitive enabled
+    | D -> assert false (* todo *)
+    | S -> assert false (* todo *)
+    | C -> assert false (* todo *)
+    | LC -> assert false (* todo *)
   in
-
-  (* Affichage d'informations *)
-  let scrolled = GBin.scrolled_window ~border_width:10
-      ~shadow_type:`OUT ~height:250 ~packing:vbox#add ()
-  in
-  let gtext = GText.view ~wrap_mode:`CHAR ~height:50 ~editable:false ~width:50
-      ~packing: scrolled#add () ~cursor_visible:true
+  let update_all_checkboxes () =
+    List.iter (fun (name, enabled) -> update_checkbox name enabled) (rdbg_nodes_enabled !e)
   in
-  let gtext_content = ref "Noeuds activables :" in
+  update_all_checkboxes ();
+  let set_dd_mode () = daemon_kind := D; update_all_checkboxes () in
+  let set_sd_mode () = daemon_kind := S; update_all_checkboxes () in
+  let set_cd_mode () = daemon_kind := C; update_all_checkboxes () in
+  let set_lcd_mode () = daemon_kind := LC; update_all_checkboxes () in
+  let set_manual_mode () = daemon_kind := Manual; update_all_checkboxes ()  in
+  let set_manual_central_mode () = daemon_kind := ManualCentral; update_all_checkboxes ()  in
+  ignore(dk_dd#connect#clicked ~callback:set_dd_mode);
+  ignore(dk_sd#connect#clicked ~callback:set_sd_mode);
+  ignore(dk_cd#connect#clicked ~callback:set_cd_mode);
+  ignore(dk_lcd#connect#clicked ~callback:set_lcd_mode);
+  ignore(dk_manual#connect#clicked ~callback:set_manual_mode);
+  ignore(dk_manual_central#connect#clicked ~callback:set_manual_central_mode);
+  (* Affichage d'informations *)
   gtext#buffer#set_text !gtext_content;
   let print_gui str =
-    let txt = Printf.sprintf "%s\n%s" !gtext_content str in
+    let txt = Printf.sprintf "%s\n%s" str (str_of_sasa_event true !e) in
     gtext#buffer#set_text txt;
     gtext_content := txt;
   in
-  List.iter
-    (fun (name, enabled) -> print_gui (Printf.sprintf "%s : %B" name enabled))
-    nodes_enabled;
+  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
-  let update_all_checkboxes () =
-    print_gui "Nouveaux noeuds activables :";
-    List.iter (fun (name, enabled) ->
-        update_checkbox name enabled;
-        print_gui (Printf.sprintf "%s : %B" name enabled);
-      )
-      (rdbg_nodes_enabled !e)
-  in
-  let rdbg_btn label cmd =
+  let rdbg_btn label tip cmd =
     let btn = GButton.button ~label:label ~packing:hbox#add () in
-    btn#misc#set_tooltip_text "tooltip";
+    btn#misc#set_tooltip_text tip;
     ignore (btn#connect#clicked ~callback: (
         fun () ->
           cmd ();
-          print_gui (Printf.sprintf "> %s" label);
+          print_gui (Printf.sprintf "%s" label);
           update_all_checkboxes ();
       ));
     btn
   in
-  let _ = rdbg_btn "<<" pr in
-  let _ = rdbg_btn "<" bd in
-  let _ = rdbg_btn "G" graph_view in
-  let _ = rdbg_btn ">" sd in
-  let _ = rdbg_btn ">>" nr in
-  let _ = rdbg_btn "q" q 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 round" nr in
+  let _ = rdbg_btn "q" "end the session" q in
   ()
+
+let m = main 
-- 
GitLab


From 0c31269a89f16ae859bd516b17059d95b5b1c81c Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Thu, 25 Mar 2021 14:25:19 +0100
Subject: [PATCH 10/27] =?UTF-8?q?Am=C3=A9lioration=20de=20la=20coh=C3=A9re?=
 =?UTF-8?q?nce=20de=20l'affichage=20des=20infos?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 tools/rdbg4sasa/daemongui.ml      | 46 +++++++++++++++++++++----------
 tools/rdbg4sasa/sasa-rdbg-cmds.ml | 13 +++++----
 2 files changed, 39 insertions(+), 20 deletions(-)

diff --git a/tools/rdbg4sasa/daemongui.ml b/tools/rdbg4sasa/daemongui.ml
index d913ed4..5fb57ff 100644
--- a/tools/rdbg4sasa/daemongui.ml
+++ b/tools/rdbg4sasa/daemongui.ml
@@ -48,6 +48,11 @@ let rdbg_nodes_enabled e =
 type daemon_kind = D | S | C | LC | ManualCentral | Manual 
 let daemon_kind = ref ManualCentral
 
+let refresh_fun_tbl = Hashtbl.create 1
+let _ = Hashtbl.add refresh_fun_tbl "update dot" d
+let refresh () =
+  Hashtbl.iter (fun str f -> f()) refresh_fun_tbl
+  
 (** Met en place le hook  *)
 let daemongui_activate = Hashtbl.create 1
 let init_rdbg_hook () =
@@ -132,7 +137,8 @@ let main () =
   (** Met à jour le hook pour un noeud  *)
   let update_rdbg_hook node activate =
     match !daemon_kind with
-    | D | S | C | LC -> assert false (* todo *)
+    | 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;
@@ -199,7 +205,11 @@ let main () =
       pushbox#misc#set_tooltip_text (Printf.sprintf "Press to activate %s" name);
       (* Quand on appuie, met à jour le rdbg_mv_hook *)
       ignore(pushbox#event#connect#button_press
-               ~callback: (fun _ -> update_rdbg_hook name true; sd(); false));
+               ~callback: (fun _ ->
+                   update_rdbg_hook name true;
+                   sd();
+                   refresh ();
+                   false));
       Hashtbl.add pushbox_map name pushbox
     )
     nodes_enabled;
@@ -221,21 +231,22 @@ let main () =
       let pushbox = Hashtbl.find pushbox_map node in
       if not enabled then (pushbox#misc#hide ());
       pushbox#set_sensitive enabled
-    | D -> assert false (* todo *)
-    | S -> assert false (* todo *)
-    | C -> assert false (* todo *)
-    | LC -> assert false (* todo *)
+    | D -> gtext#buffer#set_text  "finish me" (* todo *)
+    | S -> gtext#buffer#set_text  "finish me" (* todo *)
+    | C -> gtext#buffer#set_text  "finish me" (* todo *)
+    | LC -> gtext#buffer#set_text "finish me" (* todo *)
   in
   let update_all_checkboxes () =
     List.iter (fun (name, enabled) -> update_checkbox name enabled) (rdbg_nodes_enabled !e)
   in
-  update_all_checkboxes ();
-  let set_dd_mode () = daemon_kind := D; update_all_checkboxes () in
-  let set_sd_mode () = daemon_kind := S; update_all_checkboxes () in
-  let set_cd_mode () = daemon_kind := C; update_all_checkboxes () in
-  let set_lcd_mode () = daemon_kind := LC; update_all_checkboxes () in
-  let set_manual_mode () = daemon_kind := Manual; update_all_checkboxes ()  in
-  let set_manual_central_mode () = daemon_kind := ManualCentral; update_all_checkboxes ()  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_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);
   ignore(dk_sd#connect#clicked ~callback:set_sd_mode);
   ignore(dk_cd#connect#clicked ~callback:set_cd_mode);
@@ -267,7 +278,7 @@ let main () =
         fun () ->
           cmd ();
           print_gui (Printf.sprintf "%s" label);
-          update_all_checkboxes ();
+          refresh ();
       ));
     btn
   in
@@ -277,6 +288,11 @@ let main () =
   let _ = rdbg_btn ">" "next step" sd in
   let _ = rdbg_btn ">>" "next round" nr in
   let _ = rdbg_btn "q" "end the session" q in
-  ()
+  refresh ()
 
 let m = main 
+(* todo
+- cacher les boutons de rounds en mode manuel
+- faire les modes automatiques
+ - définir des bouton compteurs pour stocker la priorité
+ *)
diff --git a/tools/rdbg4sasa/sasa-rdbg-cmds.ml b/tools/rdbg4sasa/sasa-rdbg-cmds.ml
index edd7f2e..7a68566 100644
--- a/tools/rdbg4sasa/sasa-rdbg-cmds.ml
+++ b/tools/rdbg4sasa/sasa-rdbg-cmds.ml
@@ -16,10 +16,10 @@ let _ = Hashtbl.add roundtbl 1 (1,true);;
 
 (**********************************************************************)
 (* redefine (more meaningful) step and back-step for sasa *)
-let sasa_step e = next_cond e (fun ne -> ne.kind = Ltop)
-let sasa_bstep e = rev_cond e (fun ne -> ne.kind = Ltop);;
-let s () = 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 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 p =
   try Topology.read dotfile
@@ -137,7 +137,10 @@ let update_round_nb e =
   | Some (n,_) -> roundnb := n
 
 (* go to next and previous rounds  *)
-let next_round e = next_cond e round;;
+let next_round e =
+  let ne = next_cond e round in
+  if ne.kind = e.kind then ne else next e
+  
 let nr () = e:=next_round !e; store !e.nb; !dot_view ();;
 let pr () =
   e:=goto_last_ckpt !e.nb;
-- 
GitLab


From 7e73a716118f779331de66e319c9fb9baaf831f1 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Thu, 25 Mar 2021 15:23:35 +0100
Subject: [PATCH 11/27] =?UTF-8?q?Ajout=20des=20boutons=20de=20priorit?=
 =?UTF-8?q?=C3=A9s=20pour=20les=20modes=20(semi-)automatiques?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 tools/rdbg4sasa/daemongui.ml | 56 ++++++++++++++++++++++++++++++++----
 1 file changed, 51 insertions(+), 5 deletions(-)

diff --git a/tools/rdbg4sasa/daemongui.ml b/tools/rdbg4sasa/daemongui.ml
index 5fb57ff..ee174e9 100644
--- a/tools/rdbg4sasa/daemongui.ml
+++ b/tools/rdbg4sasa/daemongui.ml
@@ -161,6 +161,7 @@ let main () =
   (* NB : lablgtk3 ne propose pas le FlowBox (pourtant dispo dans GTK >= 3.12) *)
   let n = List.length nodes_enabled in
   let m = int_of_float (sqrt (float_of_int n)) in
+
   (* Des checkbox pour le mode Manuel *)
   (* build manually a m x m grid *)
   let i = ref 0 in
@@ -187,6 +188,7 @@ let main () =
       Hashtbl.add checkbox_map name checkbox;
     )
     nodes_enabled;
+
   (* Des boutons pour le mode Manuel Central *)
   let pushbox_grid = GPack.vbox ~packing:vbox#add () in
   let pushbox_line = GPack.hbox ~packing:pushbox_grid#add () in
@@ -214,11 +216,50 @@ let main () =
     )
     nodes_enabled;
 
+  (* Des compteurs pour les modes automatiques *)
+  let counter_grid = GPack.vbox ~packing:vbox#add () in
+  let counter_line = GPack.hbox ~packing:counter_grid#add () in
+  let counter_line_ref = ref counter_line in
+  let counter_map = Hashtbl.create n in
+  i := 0;
+  List.iter (fun (name, enabled) ->
+      incr i;
+      if !i > m then (
+        i := 1;
+        let new_counter_line = GPack.hbox ~packing:counter_grid#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
+      let incB = GButton.button ~label:"+" ~packing:incr_container#add () in
+      let adj = GData.adjustment ~lower:0. ~upper:100. ~step_incr:1. ~page_incr:10. () in
+
+      decB#connect#clicked ~callback:(fun () -> adj#set_value (float(counter#get-1)));
+      incB#connect#clicked ~callback:(fun () -> adj#set_value (float(counter#get+1)));
+      adj#connect#value_changed ~callback:(fun () -> counter#set (truncate adj#value));
+      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
+    )
+    nodes_enabled;
+
   let update_checkbox node enabled =
     match !daemon_kind with
     | Manual ->
       checkbox_grid#misc#show();
       pushbox_grid#misc#hide();
+      counter_grid#misc#hide();
       let checkbox = Hashtbl.find checkbox_map node in
       if not enabled then (
         checkbox#set_active false; (* on decoche *)
@@ -228,19 +269,24 @@ let main () =
     | ManualCentral ->
       checkbox_grid#misc#hide();
       pushbox_grid#misc#show();
+      counter_grid#misc#hide();
       let pushbox = Hashtbl.find pushbox_map node in
       if not enabled then (pushbox#misc#hide ());
       pushbox#set_sensitive enabled
-    | D -> gtext#buffer#set_text  "finish me" (* todo *)
-    | S -> gtext#buffer#set_text  "finish me" (* todo *)
-    | C -> gtext#buffer#set_text  "finish me" (* todo *)
-    | LC -> gtext#buffer#set_text "finish me" (* todo *)
+    | LC | C | D ->
+      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)
   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
-- 
GitLab


From d0353e2ca25381b08e4f1b9f09b891f834529888 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Thu, 25 Mar 2021 16:23:38 +0100
Subject: [PATCH 12/27] Ajout de scrollbars

---
 tools/rdbg4sasa/daemongui.ml | 41 ++++++++++++++++++++++++------------
 1 file changed, 27 insertions(+), 14 deletions(-)

diff --git a/tools/rdbg4sasa/daemongui.ml b/tools/rdbg4sasa/daemongui.ml
index ee174e9..b0d5e6f 100644
--- a/tools/rdbg4sasa/daemongui.ml
+++ b/tools/rdbg4sasa/daemongui.ml
@@ -120,7 +120,7 @@ let main () =
       ~label:"Manual Central" ~group:dk_dd#group ~packing:daemon_box_manual#add ()
   in
   let scrolled = GBin.scrolled_window ~border_width:10
-      ~shadow_type:`OUT ~height:250 ~packing:vbox#add ()
+      ~shadow_type:`OUT ~height:150 ~packing:vbox#add ()
   in
   let gtext = GText.view ~wrap_mode:`CHAR ~height:50 ~editable:false ~width:50
       ~packing: scrolled#add () ~cursor_visible:true
@@ -166,7 +166,12 @@ 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_line = GPack.hbox ~packing:checkbox_grid#add () in
+  let checkbox_scrolled_grid = GBin.scrolled_window ~border_width:10   ~hpolicy:`AUTOMATIC 
+      ~vpolicy:`AUTOMATIC
+      ~shadow_type:`OUT ~packing:checkbox_grid#add ()
+  in
+  let checkbox_scrolled_grid_box = GPack.vbox ~packing:checkbox_scrolled_grid#add () in
+  let checkbox_line = GPack.hbox ~packing:checkbox_scrolled_grid_box#add () in
 
   let checkbox_line_ref = ref checkbox_line in
   let checkbox_map = Hashtbl.create n in
@@ -174,7 +179,7 @@ let main () =
       incr i;
       if !i > m then (
         i := 1;
-        let new_checkbox_line = GPack.hbox ~packing:checkbox_grid#add () in
+        let new_checkbox_line = GPack.hbox ~packing:checkbox_scrolled_grid_box#add () in
         checkbox_line_ref := new_checkbox_line;
       );
       (* cf. classe toggle_button de lablgtk3 *)
@@ -191,7 +196,12 @@ let main () =
 
   (* Des boutons pour le mode Manuel Central *)
   let pushbox_grid = GPack.vbox ~packing:vbox#add () in
-  let pushbox_line = GPack.hbox ~packing:pushbox_grid#add () in
+  let pushbox_scrolled_grid = GBin.scrolled_window ~border_width:10 ~hpolicy:`AUTOMATIC 
+      ~vpolicy:`AUTOMATIC
+      ~shadow_type:`OUT ~packing:pushbox_grid#add ()
+  in
+  let pushbox_scrolled_grid_box = GPack.vbox  ~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
   i := 0;
@@ -199,7 +209,7 @@ let main () =
       incr i;
       if !i > m then (
         i := 1;
-        let new_pushbox_line = GPack.hbox ~packing:pushbox_grid#add () in
+        let new_pushbox_line = GPack.hbox ~packing:pushbox_scrolled_grid_box#add () in
         pushbox_line_ref := new_pushbox_line
       );
       (* cf. classe toggle_button de lablgtk3 *)
@@ -218,7 +228,12 @@ let main () =
 
   (* Des compteurs pour les modes automatiques *)
   let counter_grid = GPack.vbox ~packing:vbox#add () in
-  let counter_line = GPack.hbox ~packing:counter_grid#add () in
+  let counter_scrolled_grid = GBin.scrolled_window ~border_width:10 ~hpolicy:`AUTOMATIC 
+      ~vpolicy:`AUTOMATIC 
+      ~shadow_type:`OUT ~packing:counter_grid#add ()
+  in
+  let counter_scrolled_grid_box = GPack.vbox ~packing:counter_scrolled_grid#add () in
+  let counter_line = GPack.hbox ~packing:counter_scrolled_grid_box#add () in
   let counter_line_ref = ref counter_line in
   let counter_map = Hashtbl.create n in
   i := 0;
@@ -226,7 +241,7 @@ let main () =
       incr i;
       if !i > m then (
         i := 1;
-        let new_counter_line = GPack.hbox ~packing:counter_grid#add () in
+        let new_counter_line = GPack.hbox ~packing:counter_scrolled_grid_box#add () in
         counter_line_ref := new_counter_line
       );
       
@@ -242,13 +257,11 @@ let main () =
       let counter_lbl = GMisc.label  ~packing:counter_container#pack () in
       let incB = GButton.button ~label:"+" ~packing:incr_container#add () in
       let adj = GData.adjustment ~lower:0. ~upper:100. ~step_incr:1. ~page_incr:10. () in
-
-      decB#connect#clicked ~callback:(fun () -> adj#set_value (float(counter#get-1)));
-      incB#connect#clicked ~callback:(fun () -> adj#set_value (float(counter#get+1)));
-      adj#connect#value_changed ~callback:(fun () -> counter#set (truncate adj#value));
-      counter#connect#changed ~callback:(fun n -> counter_lbl#set_text (string_of_int n));
+      ignore (decB#connect#clicked ~callback:(fun () -> adj#set_value (float(counter#get-1))));
+      ignore (incB#connect#clicked ~callback:(fun () -> adj#set_value (float(counter#get+1))));
+      ignore (adj#connect#value_changed ~callback:(fun () -> counter#set (truncate adj#value)));
+      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
     )
@@ -340,5 +353,5 @@ let m = main
 (* todo
 - cacher les boutons de rounds en mode manuel
 - faire les modes automatiques
- - définir des bouton compteurs pour stocker la priorité
+- reglage de la taille des boites 
  *)
-- 
GitLab


From 8ab1b2a0258ee52184e8229987beadca475f8a53 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Mon, 29 Mar 2021 15:20:15 +0200
Subject: [PATCH 13/27] daemon synchrone semi-auto

---
 test/Makefile.dot                 |   4 +-
 tools/rdbg4sasa/daemongui.ml      | 162 +++++++++++++++++++-----------
 tools/rdbg4sasa/sasa-rdbg-cmds.ml |   2 +-
 3 files changed, 107 insertions(+), 61 deletions(-)

diff --git a/test/Makefile.dot b/test/Makefile.dot
index 03b8593..7cbb79e 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 b0d5e6f..4192fb4 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 7a68566..ca33262 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
-- 
GitLab


From b28286898f81f34f82ca1cf762925dba2f030b22 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Fri, 2 Apr 2021 10:34:41 +0200
Subject: [PATCH 14/27] chore

---
 test/coloring/my-rdbg-tuning.ml | 5 +++--
 tools/rdbg4sasa/daemongui.ml    | 6 ++++--
 2 files changed, 7 insertions(+), 4 deletions(-)

diff --git a/test/coloring/my-rdbg-tuning.ml b/test/coloring/my-rdbg-tuning.ml
index e1e9215..24a13f0 100644
--- a/test/coloring/my-rdbg-tuning.ml
+++ b/test/coloring/my-rdbg-tuning.ml
@@ -3,10 +3,11 @@
 #use "rdbg-cmds.ml";;
 #use "sasa-rdbg-cmds.ml";;
 
-#use "include.ml";;
+#use "include.ml";; 
 
 let _ =
   del_hook "print_event";
-  add_hook "print_event" (print_event)
+  add_hook "print_event" (print_event);
+  main()
 
 let pp () = List.assoc "potential" !e.data;;
diff --git a/tools/rdbg4sasa/daemongui.ml b/tools/rdbg4sasa/daemongui.ml
index 4192fb4..59a596d 100644
--- a/tools/rdbg4sasa/daemongui.ml
+++ b/tools/rdbg4sasa/daemongui.ml
@@ -326,7 +326,7 @@ let main () =
   ignore(dk_manual_central#connect#clicked ~callback:set_manual_central_mode);
   (* Affichage d'informations *)
   gtext#buffer#set_text !gtext_content;
-  let print_gui str =
+  let _print_gui str =
     let txt = Printf.sprintf "%s\n%s" str (str_of_sasa_event true !e) in
     gtext#buffer#set_text txt;
     gtext_content := txt;
@@ -399,5 +399,7 @@ let m = main
 - cacher le bouton step en mode manuel central 
 - faire les modes automatiques
 - reglage de la taille des boites 
-
+- utiliser les GEdit.spin_button ?
+    cf lablgtk/examples/spin.ml
+    https://lazka.github.io/pgi-docs/Gtk-3.0/classes/SpinButton.html#Gtk.SpinButton
  *)
-- 
GitLab


From 272e76b34223a7095846232f0008c743b5fa4e59 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Thu, 6 May 2021 10:16:45 +0200
Subject: [PATCH 15/27] Merge the 2 sasa/rdbg GUI

---
 tools/rdbg4sasa/daemongui.ml      | 436 ++++++++++++++++++++++++------
 tools/rdbg4sasa/sasa-rdbg-cmds.ml |  23 +-
 tools/rdbgui4sasa/dune            |   2 +-
 tools/rdbgui4sasa/rdbgui.ml       | 323 +---------------------
 4 files changed, 372 insertions(+), 412 deletions(-)

diff --git a/tools/rdbg4sasa/daemongui.ml b/tools/rdbg4sasa/daemongui.ml
index 59a596d..a97ac8e 100644
--- a/tools/rdbg4sasa/daemongui.ml
+++ b/tools/rdbg4sasa/daemongui.ml
@@ -77,25 +77,7 @@ let init_rdbg_hook () =
   in
   rdbg_mv_hook := Some guidaemon
 
-
-(* GTK3 *)    
-let main () =
-  let _locale = GtkMain.Main.init () in 
-  let _thread = GtkThread.start () in
-  let window = GWindow.window
-      (*       ~width:320 ~height:240 *)
-      ~title:"Daemon GUI"
-      ~show:true () 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 *)
-        Main.quit () (* terminate gtk *)
-    ));
-
-  (* Affichage d'informations *)
-  let gtext_content = ref "" in
-
+let custom_daemon gtext vbox =
   (* création du rdbg_mv_hook et de tout ce qu'il faut autour *)
   init_rdbg_hook ();
 
@@ -122,9 +104,6 @@ let main () =
   let scrolled = GBin.scrolled_window ~border_width:10
       ~shadow_type:`OUT ~height:150 ~packing:vbox#add ()
   in
-  let gtext = GText.view ~wrap_mode:`CHAR ~height:50 ~editable:false ~width:50
-      ~packing: scrolled#add () ~cursor_visible:true
-  in
   dk_dd#misc#set_tooltip_text (Printf.sprintf "Set the automatic distributed mode");
   dk_sd#misc#set_tooltip_text (Printf.sprintf "Set the automatic synchronous mode");
   dk_cd#misc#set_tooltip_text (Printf.sprintf "Set the automatic central mode");
@@ -325,75 +304,360 @@ let main () =
   ignore(dk_manual#connect#clicked ~callback:set_manual_mode);
   ignore(dk_manual_central#connect#clicked ~callback:set_manual_central_mode);
   (* Affichage d'informations *)
-  gtext#buffer#set_text !gtext_content;
-  let _print_gui str =
-    let txt = Printf.sprintf "%s\n%s" str (str_of_sasa_event true !e) in
-    gtext#buffer#set_text txt;
-    gtext_content := txt;
-  in
-
-  (* Boutons de contrôle de la simulation *)
-  let hbox = GPack.hbox ~packing:vbox#add () in
-  let rdbg_btn label tip cmd =
-    let btn = GButton.button ~label:label ~packing:hbox#add () in
-    btn#misc#set_tooltip_text tip;
-    ignore (btn#connect#clicked ~callback: (
-        fun () ->
-          cmd ();
-          refresh ();
-      ));
-    btn
-  in
-  let rec get_higher_prioriry nl =
-    let prio n =
-      let counter = Hashtbl.find counter_map n in
-      counter#get
+  (*   gtext#buffer#set_text !gtext_content; *)
+  
+   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 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
+    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
-    aux 0 [] nl
+   step
+
+let prefix =
+  try
+    let opam_dir = Unix.getenv "OPAM_SWITCH_PREFIX" in
+    opam_dir
+   with Not_found -> "$HOME/sasa/"
+
+let lib_prefix = prefix ^ "/lib/sasa"
+let libui_prefix = prefix ^ "/lib/rdbgui4sasa"
+
+let oc_stdin = stdout
+let ic_stdout = stdin
+  
+  (* GTK3 *)    
+let main () =
+  let _locale = GtkMain.Main.init () in 
+  let _thread = GtkThread.start () in
+  let window = GWindow.window
+      (*       ~width:320 ~height:240 *)
+      ~title:"A rdbg GUI for sasa"
+      ~show:true ()
   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" step in
-  let _ = rdbg_btn ">>" "next round" nr in
-  let _ = rdbg_btn "q" "end the session" q in
+  let w = GPack.vbox ~packing:window#add () ~homogeneous:false in
+  let box = GPack.vbox ~packing: w#add () in
+  let gbox = GPack.hbox ~packing: box#add () in
+  let gbox2 = GPack.hbox ~packing: box#add () in
+  let sw1 = GBin.scrolled_window ~border_width:10 ~shadow_type:`IN  ~height:30 ~width:50
+      ~packing:box#add ()
+  in
+  let sw2 = GBin.scrolled_window ~border_width:10 ~shadow_type:`OUT ~height:250
+      ~packing:box#add ()
+  in
+  sw1#misc#set_tooltip_text "This window displays the commands sent to the rdbg cli";
+  sw2#misc#set_tooltip_text "This window displays commands outputs";
+  let text_in = GText.view ~wrap_mode:`CHAR ~height:250 ~editable:true ~width:50
+      ~packing: sw1#add () ~cursor_visible:true
+  in  
+  let text_out = GText.view ~wrap_mode:`CHAR ~height:250 ~editable:false 
+      ~packing: sw2#add () ~cursor_visible:true 
+  in 
+  let p str =
+    text_out#set_buffer (GText.buffer ~text:str ());
+    Printf.fprintf oc_stdin "%s\n%!" str;
+    Printf.printf "%s\n%!" str;
+  in
+
+  Printf.fprintf oc_stdin "#require \"sasa\";;\n%!" ;
+  (*   Printf.fprintf oc_stdin "#use \"sasa-rdbg-cmds.ml\";;\n%!"; *)
+  Printf.fprintf oc_stdin "print_sasa_event false !e;;\n%!"; (* print the first event *)
+  let bbox = GPack.hbox ~packing: box#add () in
+
+  let change_label button str =
+    let icon = button#image in
+    button#set_label str;
+    button#set_image icon
+  in
+  let button_cb cmd () =
+    cmd ();
+    let txt = Printf.sprintf "%s" (str_of_sasa_event false !e) in
+    text_out#buffer#set_text txt
+  in
+  let button_cb_string cmd () =
+    let txt = Printf.sprintf "%s" (cmd ()) in
+    text_out#buffer#set_text txt
+  in
+
+  let back_step_button =
+    GButton.button ~use_mnemonic:true ~stock:`GO_BACK ~packing:bbox#add  ()
+  in
+  back_step_button#misc#set_tooltip_text "Move BACKWARD to the previous STEP";
+  change_label back_step_button "Ste_p";
+  ignore (back_step_button#connect#clicked ~callback:(button_cb bd));
+
+  let step_button =
+    GButton.button ~use_mnemonic:true ~packing:bbox#add ~stock:`GO_FORWARD ()
+  in
+  step_button#misc#set_tooltip_text "Move FORWARD to the next STEP";
+  change_label step_button "_Step";
+  ignore (step_button#connect#clicked ~callback:(button_cb sd));
+
+  let back_round_button =
+    GButton.button ~packing:bbox#add ~stock:`MEDIA_PREVIOUS  ~use_mnemonic:true 
+      ~label:"back round" ()
+  in
+  back_round_button#misc#set_tooltip_text "Move BACKWARD to the previous ROUND";
+  change_label back_round_button "Roun_d";
+  ignore (back_round_button#connect#clicked ~callback:(button_cb pr));
+
+  let round_button =
+    GButton.button  ~use_mnemonic:true ~stock:`MEDIA_FORWARD
+      ~packing:bbox#add ~label:"round" ()
+  in 
+  round_button#misc#set_tooltip_text "Move FORWARD to the next ROUND";
+  change_label round_button "_Round";
+  ignore (round_button#connect#clicked ~callback:(button_cb nr));
+
+  let legitimate () = 
+    let legitimate_button = GButton.button ~use_mnemonic:true
+        ~packing:bbox#add () in
+    legitimate_button#misc#set_tooltip_text
+      "Move FORWARD until a legitimate configuration is reached (silence by default)";
+    let image = GMisc.image ~file:(libui_prefix^"/chut_small.svg") () in
+    legitimate_button#set_image image#coerce; 
+    (*     change_label legitimate_button "Silen_t"; *)
+    ignore (legitimate_button#connect#clicked ~callback:(button_cb legitimate))
+
+  in
+  legitimate ();
+
+  let graph () = 
+    let graph_button = GButton.button  ~use_mnemonic:true  ~packing:bbox#add () in
+    graph_button#misc#set_tooltip_text
+      "Visualize the Topology states: Green=Enabled ; Gold=Active";
+    let image = GMisc.image ~file:(libui_prefix^"/graph_small.png") () in
+    graph_button#set_image image#coerce; 
+    ignore (graph_button#connect#clicked ~callback:(button_cb graph_view));
+
+  in
+  graph ();
+
+  let viol_oracle () = 
+    let viol_button = GButton.button  ~use_mnemonic:true ~stock:`OK
+        ~packing:bbox#add () in
+    viol_button#misc#set_tooltip_text
+      "Move FORWARD until an oracle is violated";
+    (*     let image = GMisc.image ~file:"../rdbg-utils/oracle_small.jpg" () in *)
+    (*     viol_button#set_image image#coerce;  *)
+    change_label viol_button "_Oracle";
+    ignore (viol_button#connect#clicked ~callback:(button_cb_string viol_string))
+  in
+  (*   if args.oracles <> [] then *)
+  viol_oracle ();
+
+  let undo_button = GButton.button  ~use_mnemonic:true  ~stock:`UNDO
+      ~packing:bbox#add ~label:"undo" ()
+  in
+  undo_button#misc#set_tooltip_text "Undo the last move";
+  ignore (undo_button#connect#clicked ~callback:(button_cb (fun () -> u();d())));
+
+  let restart_button = GButton.button  ~use_mnemonic:true  ~stock:`REFRESH
+      ~packing:bbox#add ~label:"restart" ()
+  in
+  restart_button#misc#set_tooltip_text "Restart from the beginning";
+  change_label restart_button "Restar_t";
+  ignore (restart_button#connect#clicked ~callback:(button_cb (fun ()-> r();d())));
+
+  let info_button =
+    GButton.button ~use_mnemonic:true ~stock:`INFO ~packing:bbox#add ~label:"_Info" ()
+  in
+  change_label info_button "_Info";
+  info_button#misc#set_tooltip_text "Get information about the current session";
+  ignore (info_button#connect#clicked ~callback:(button_cb_string info_string));
+
+  let quit_button =
+    GButton.button ~use_mnemonic:true ~stock:`QUIT ~packing:bbox#add ~label:"_Quit" ()
+  in
+  quit_button#misc#set_tooltip_text "Quit RDBGUI";
+  ignore (quit_button#connect#clicked ~callback: (fun() -> Stdlib.exit 0));
+
+
+  let dot_button = GButton.radio_button ~packing:gbox#add ~label:"dot" () in
+  let fd_button = GButton.radio_button ~packing:gbox#add
+      ~group:dot_button#group ~label:"fdp" ()
+  in
+  let sf_button = GButton.radio_button ~packing:gbox#add 
+      ~group:dot_button#group ~label:"sfdp" ()
+  in
+  let ne_button = GButton.radio_button ~packing:gbox#add 
+      ~active:true ~group:dot_button#group ~label:"neato" ()
+  in
+  let tw_button = GButton.radio_button ~packing:gbox#add 
+      ~group:dot_button#group ~label:"twopi" ()
+  in
+  let ci_button = GButton.radio_button ~packing:gbox#add 
+      ~group:dot_button#group ~label:"circo" ()
+  in
+  let pa_button = GButton.radio_button ~packing:gbox#add 
+      ~group:dot_button#group ~label:"patchwork" ()
+  in
+  let os_button = GButton.radio_button ~packing:gbox#add 
+      ~group:dot_button#group ~label:"osage" ()
+  in
+
+  let par_dot () = 
+    let par_dot_button = GButton.radio_button ~packing:gbox2#add 
+        ~group:dot_button#group ~label:"dot*" () in
+    let par_fd_button = GButton.radio_button ~packing:gbox2#add 
+        ~group:dot_button#group ~label:"fdp*" () in
+    let par_sf_button = GButton.radio_button ~packing:gbox2#add 
+        ~group:dot_button#group ~label:"sfdp*" () in
+    let par_ne_button = GButton.radio_button ~packing:gbox2#add 
+        ~group:dot_button#group ~label:"neato*" () in
+    let par_tw_button = GButton.radio_button ~packing:gbox2#add 
+        ~group:dot_button#group ~label:"twopi*" () in
+    let par_ci_button = GButton.radio_button ~packing:gbox2#add 
+        ~group:dot_button#group ~label:"circo*" () in
+    let par_pa_button = GButton.radio_button ~packing:gbox2#add 
+        ~group:dot_button#group ~label:"patchwork*" () in
+    let par_os_button = GButton.radio_button ~packing:gbox2#add 
+        ~group:dot_button#group ~label:"osage*" ()
+    in
+    par_dot_button#misc#set_tooltip_text
+      "Use dot, but show only links to the parent (works if State.t contains a 'par:int' field)";
+    par_fd_button#misc#set_tooltip_text
+      "Use fdp, but show only links to the parent (works if State.t contains a 'par:int' field)";
+    par_sf_button#misc#set_tooltip_text
+      "Use sfdp, but show only links to the parent (works if State.t contains a 'par:int' field)";
+    par_ne_button#misc#set_tooltip_text
+      "Use neato, but show only links to the parent (works if State.t contains a 'par:int' field)";
+    par_tw_button#misc#set_tooltip_text
+      "Use twopi, but show only links to the parent (works if State.t contains a 'par:int' field)";
+    par_ci_button#misc#set_tooltip_text
+      "Use circo, but show only links to the parent (works if State.t contains a 'par:int' field)";
+    par_pa_button#misc#set_tooltip_text
+      "Use patchwork, but show only links to the parent (works if State.t contains a 'par:int' field)";
+    par_os_button#misc#set_tooltip_text
+      "Use osage, but show only links to the parent (works if State.t contains a 'par:int' field)";
+    ignore (par_dot_button#connect#clicked
+              ~callback:(fun () ->
+                p ((par_dot_button#misc#tooltip_text)^"\n"^(help_string "d_par"));
+                dot_view := d_par; !dot_view()));
+    ignore (par_fd_button#connect#clicked
+              ~callback:(fun () ->
+                p ((par_fd_button#misc#tooltip_text)^"\n"^(help_string "fd_par"));
+                 dot_view := fd_par; !dot_view()));
+    ignore (par_sf_button#connect#clicked
+              ~callback:(fun () ->
+                p ((par_sf_button#misc#tooltip_text)^"\n"^(help_string "sf_par"));
+                 dot_view := sf_par; !dot_view()));
+    ignore (par_ne_button#connect#clicked
+              ~callback:(fun () ->
+                p ((par_ne_button#misc#tooltip_text)^"\n"^(help_string "ne_par"));
+                 dot_view := ne_par; !dot_view()));
+    ignore (par_tw_button#connect#clicked
+              ~callback:(fun () ->
+                p ((par_tw_button#misc#tooltip_text)^"\n"^(help_string "tw_par"));
+                 dot_view := tw_par; !dot_view()));
+    ignore (par_ci_button#connect#clicked
+              ~callback:(fun () ->
+                p ((par_ci_button#misc#tooltip_text)^"\n"^(help_string "ci_par"));
+                 dot_view := ci_par; !dot_view()));
+    ignore (par_pa_button#connect#clicked
+              ~callback:(fun () ->
+                p ((par_pa_button#misc#tooltip_text)^"\n"^(help_string "pa_par"));
+                 dot_view := pa_par; !dot_view()));
+    ignore (par_os_button#connect#clicked
+              ~callback:(fun () ->
+                p ((par_os_button#misc#tooltip_text)^"\n"^(help_string "os_par"));
+                 dot_view := os_par; !dot_view()))
+  in
+
+  let have_parent () = (* is there a parent field in the state ? *)
+    (* List.exists (fun (v,_) -> Str.string_match (Str.regexp ".*_par.*") v 0) !e.data *)
+    true
+  in
+  if have_parent () then par_dot ();
+  dot_button#misc#set_tooltip_text "Use the dot engine to display the graph";
+  fd_button#misc#set_tooltip_text "Use the fdp engine to display the graph";
+  sf_button#misc#set_tooltip_text "Use the sfdp engine to display the graph";
+  ne_button#misc#set_tooltip_text "Use the neato engine to display the graph";
+  tw_button#misc#set_tooltip_text "Use the twopi engine to display the graph";
+  ci_button#misc#set_tooltip_text "Use the circo engine to display the graph";
+  pa_button#misc#set_tooltip_text "Use the patchwork engine to display the graph";
+  os_button#misc#set_tooltip_text "Use the osage engine to display the graph";
+
+  ignore (dot_button#connect#clicked
+            ~callback:(fun () ->
+                p ((dot_button#misc#tooltip_text)^"\n"^(help_string "d"));
+                dot_view:=dot; !dot_view()));
+  ignore (fd_button#connect#clicked
+            ~callback:(fun () ->
+                p ((fd_button#misc#tooltip_text)^"\n"^(help_string "fd"));
+                dot_view:=fd; !dot_view()));
+  ignore (sf_button#connect#clicked
+            ~callback:(fun () ->
+                p ((sf_button#misc#tooltip_text)^"\n"^(help_string "sf"));
+                dot_view:=sf; !dot_view()));
+  ignore (ne_button#connect#clicked
+            ~callback:(fun () ->
+                p ((ne_button#misc#tooltip_text)^"\n"^(help_string "ne"));
+                dot_view:=ne; !dot_view()));
+  ignore (tw_button#connect#clicked
+            ~callback:(fun () ->
+                p ((tw_button#misc#tooltip_text)^"\n"^(help_string "tw"));
+                dot_view:=tw; !dot_view()));
+  ignore (ci_button#connect#clicked
+            ~callback:(fun () ->
+                p ((ci_button#misc#tooltip_text)^"\n"^(help_string "ci"));
+                dot_view:=ci; !dot_view()));
+  ignore (pa_button#connect#clicked
+            ~callback:(fun () ->
+                p ((pa_button#misc#tooltip_text)^"\n"^(help_string "pa"));
+                dot_view:=pa; !dot_view()));
+  ignore (os_button#connect#clicked
+            ~callback:(fun () ->
+                p ((os_button#misc#tooltip_text)^"\n"^(help_string "os"));
+                dot_view:=os; !dot_view()));
+  ignore (window#connect#destroy ~callback: (
+      fun () ->
+        quit (); (* quit rdbg, this will stop the readloop below *)
+        Main.quit () (* terminate gtk *)
+    ));
+
+  (* Affichage d'informations *)
+  (*     let gtext_content = ref "" in *)
+
+  let step = custom_daemon text_out w in
   refresh ()
 
-let m = main 
+let gui = main 
 (* todo
 - cacher les boutons de rounds en mode manuel
 - cacher le bouton step en mode manuel central 
diff --git a/tools/rdbg4sasa/sasa-rdbg-cmds.ml b/tools/rdbg4sasa/sasa-rdbg-cmds.ml
index ca33262..03bf1a8 100644
--- a/tools/rdbg4sasa/sasa-rdbg-cmds.ml
+++ b/tools/rdbg4sasa/sasa-rdbg-cmds.ml
@@ -223,13 +223,18 @@ let goto_next_false_oracle e =
                         List.mem ("ok", Bool) e.outputs  &&
                         not (vb "ok" e))
 
-let viol () =
+let viol_string () =
   if args.oracles <> [] then (
-    e:=goto_next_false_oracle !e; !dot_view ()
+    e:=goto_next_false_oracle !e; !dot_view (); "An oracle has been violated. Cf the .rif file"
   ) else (
-    Printf.printf "No oracle is set.\n%!"
+    "No oracle is set."
   )
 ;;
+let viol () = Printf.printf "%s\n%!" (viol_string ())
+
+let _ = add_doc_entry
+    "viol" "unit -> unit" "Move forward until the oracle is violated"
+    "sasa" "sasa-rdbg-cmds.ml"
 
 (**********************************************************************)
 (* Move forward until silence *)
@@ -283,8 +288,16 @@ let _ =
   add_doc_entry "nd" "unit -> unit" "go to the next event and update the network" "sasa" "sasa-rdbg-cmds.ml";
   add_doc_entry "bd" "unit -> unit" "go to the previous event and update the network" "sasa" "sasa-rdbg-cmds.ml";
   add_doc_entry "nr" "unit -> unit" "go to the next round and update the network" "sasa" "sasa-rdbg-cmds.ml";
-  add_doc_entry "pr" "unit -> unit" "go to the previous round and update the network" "sasa" "sasa-rdbg-cmds.ml"
-  ;;
+  add_doc_entry "pr" "unit -> unit" "go to the previous round and update the network" "sasa" "sasa-rdbg-cmds.ml";
+  add_doc_entry "d_par" "unit -> unit" "cf d (for topology with a parent field)" "sasa" "sasa-rdbg-cmds.ml";
+  add_doc_entry "ne_par" "unit -> unit" "cf ne (for topology with a parent field)" "sasa" "sasa-rdbg-cmds.ml";
+  add_doc_entry "tw_par" "unit -> unit" "cf tw (for topology with a parent field)" "sasa" "sasa-rdbg-cmds.ml";
+  add_doc_entry "ci_par" "unit -> unit" "cf ci (for topology with a parent field)" "sasa" "sasa-rdbg-cmds.ml";
+  add_doc_entry "fd_par" "unit -> unit" "cf fd (for topology with a parent field)" "sasa" "sasa-rdbg-cmds.ml";
+  add_doc_entry "sf_par" "unit -> unit" "cf sf (for topology with a parent field)" "sasa" "sasa-rdbg-cmds.ml";
+  add_doc_entry "pa_par" "unit -> unit" "cf pa (for topology with a parent field)" "sasa" "sasa-rdbg-cmds.ml";
+  add_doc_entry "os_par" "unit -> unit" "cf os (for topology with a parent field)" "sasa" "sasa-rdbg-cmds.ml";
+  ()
 
 let l () =
   l();
diff --git a/tools/rdbgui4sasa/dune b/tools/rdbgui4sasa/dune
index 900d465..4373acc 100644
--- a/tools/rdbgui4sasa/dune
+++ b/tools/rdbgui4sasa/dune
@@ -13,7 +13,7 @@
  )
 )
 (install
- (files chut_small.svg graph_small.png)
+ (files chut_small.svg graph_small.png gui2use.ml)
  (section lib)
  (package rdbgui4sasa)
 )
diff --git a/tools/rdbgui4sasa/rdbgui.ml b/tools/rdbgui4sasa/rdbgui.ml
index 848b262..fffe0ca 100644
--- a/tools/rdbgui4sasa/rdbgui.ml
+++ b/tools/rdbgui4sasa/rdbgui.ml
@@ -1,328 +1,12 @@
 
-
 let quote str = if String.contains str ' ' then ("\""^str^"\"") else str
 let rdbg_cmd =
   String.concat " " ("rdbg"::(List.tl (List.map quote (Array.to_list Sys.argv))))
 
-(* let oc_stdin = Unix.open_process_out rdbg_cmd  *)
-let ic_stdout, oc_stdin = Unix.open_process rdbg_cmd  
-(* let ic_stdout, oc_stdin, ic_stderr =
-   Unix.open_process_full rdbg_cmd (Unix.environment()) *)
-
-let _ =
-  Unix.set_nonblock (Unix.descr_of_in_channel ic_stdout);
-(*   Unix.set_nonblock (Unix.descr_of_in_channel ic_stderr) *)
-  ()
-(* let p str = Printf.printf "%s\n%!" str *)
-
-
-let read_stdout ic =
-  let buff = Bytes.create 256 in
-  let res  = ref "" in
-  let cond = ref true in
-  Unix.sleepf  0.5;
-  while !cond do
-    try
-      let n = Stdlib.input ic buff 0 256 in
-      res := !res ^ (Bytes.sub_string buff 0 n);
-      if n < 256 then cond := false;
-    with Sys_blocked_io -> cond := false
-  done;
-  if !res <> "" then Printf.printf "%s%!" !res;
-  !res
-
-
-let prefix =
-  try
-    let opam_dir = Unix.getenv "OPAM_SWITCH_PREFIX" in
-    opam_dir
-   with Not_found -> "$HOME/sasa/"
-
-let lib_prefix = prefix ^ "/lib/sasa"
-let libui_prefix = prefix ^ "/lib/rdbgui4sasa"
-
-
-let gui str =
-  Printf.fprintf oc_stdin "%s\n" str; (* sent the session choice *)
-  (*   Printf.fprintf oc_stdin "#require \"sasa\";;\n%!" ; *)
-  (*   Printf.fprintf oc_stdin "#use \"sasa-rdbg-cmds.ml\";;\n%!"; *)
-  Printf.fprintf oc_stdin
-    "del_hook \"print_event\"; add_hook \"print_event\" (print_sasa_event false);;\n%!";
-  (*   Printf.fprintf oc_stdin "print_sasa_event false !e;;\n"; (* print the first event *) *)
-  
-  let _locale = GMain.init () in
-  let _thread = GtkThread.start() in
-  let w = GWindow.window ~show:true ~title: "A rdbg GUI for sasa" () in
-  let box = GPack.vbox ~packing: w#add () in
-  let gbox = GPack.hbox ~packing: box#add () in
-  let gbox2 = GPack.hbox ~packing: box#add () in
-  let sw1 = GBin.scrolled_window ~border_width:10 ~shadow_type:`IN  ~height:30 ~width:50
-      ~packing:box#add ()
-  in
-  let sw2 = GBin.scrolled_window ~border_width:10 ~shadow_type:`OUT ~height:250
-      ~packing:box#add ()
-  in
-  sw1#misc#set_tooltip_text "This window displays the commands sent to the rdbg cli";
-  sw2#misc#set_tooltip_text "This window displays commands outputs";
-  let text1 = GText.view ~wrap_mode:`CHAR ~height:50 ~editable:false ~width:50
-      ~packing: sw1#add () ~cursor_visible:true
-  in  
-  let text2 = GText.view ~wrap_mode:`CHAR ~height:250 ~editable:false
-      ~packing: sw2#add () ~cursor_visible:true
-  in
-  (*   text2#place_cursor_onscreen (); *)
-  (*   let text3 = GText.view ~editable:false ~packing: box#add () in  *)
-
-  (*   let input_buff = Buffer.create 100 in *)
-  let p str =
-    (* Buffer.add_string input_buff (str^"\n"); *)
-    (* text1#set_buffer (GText.buffer ~text:(Buffer.contents input_buff) ());  *)
-    text1#set_buffer (GText.buffer ~text:str ());
-    Printf.fprintf oc_stdin "%s\n%!" str;
-    Printf.printf "%s\n%!" str;
-  in
-  (*   p str; *)
-  Printf.fprintf oc_stdin "#require \"sasa\";;\n%!" ;
-  (*   Printf.fprintf oc_stdin "#use \"sasa-rdbg-cmds.ml\";;\n%!"; *)
-  Printf.fprintf oc_stdin "print_sasa_event false !e;;\n%!"; (* print the first event *)
-
-  let readloop () =
-    while true do
-      let str = read_line () in
-      p str;
-      if str="q" then exit 0;
-    done;
-  in
-  (*   let str = input_line ic_stdout in *)
-  (*   let n_buff = GText.buffer ~text:str () in *)
-  (*   text#set_buffer n_buff; *)
-
-  
-  
-  let bbox = GPack.hbox ~packing: box#add () in
-
-  let change_label button str =
-    let icon = button#image in
-    button#set_label str;
-    button#set_image icon
-  in
-
-  let back_step_button =
-    GButton.button ~use_mnemonic:true ~stock:`GO_BACK ~packing:bbox#add
-      ~label:"back step" ()
-  in
-  back_step_button#misc#set_tooltip_text "Move BACKWARD to the previous STEP";
-  change_label back_step_button "Ste_p";
-  ignore (back_step_button#connect#clicked ~callback:(fun () -> p "bd"));
-
-  let step_button =
-    GButton.button ~use_mnemonic:true ~packing:bbox#add ~stock:`GO_FORWARD
-      ~label:"step" ()
-  in
-  step_button#misc#set_tooltip_text "Move FORWARD to the next STEP";
-  change_label step_button "_Step";
-  ignore (step_button#connect#clicked ~callback:(fun () -> p "sd"));
-
-  let back_round_button =
-    GButton.button ~packing:bbox#add ~stock:`MEDIA_PREVIOUS  ~use_mnemonic:true 
-      ~label:"back round" ()
-  in
-  back_round_button#misc#set_tooltip_text "Move BACKWARD to the previous ROUND";
-  change_label back_round_button "Roun_d";
-  ignore (back_round_button#connect#clicked ~callback:(fun () -> p "pr" ));
-
-  let round_button =
-    GButton.button  ~use_mnemonic:true ~stock:`MEDIA_FORWARD
-      ~packing:bbox#add ~label:"round" ()
-  in 
-  round_button#misc#set_tooltip_text "Move FORWARD to the next ROUND";
-  change_label round_button "_Round";
-  ignore (round_button#connect#clicked ~callback:(fun () -> p "nr"));
-
-  let legitimate () = 
-    let legitimate_button = GButton.button ~use_mnemonic:true
-        ~packing:bbox#add () in
-    legitimate_button#misc#set_tooltip_text
-      "Move FORWARD until a legitimate configuration is reached (silence by default)";
-    let image = GMisc.image ~file:(libui_prefix^"/chut_small.svg") () in
-    legitimate_button#set_image image#coerce; 
-    (*     change_label legitimate_button "Silen_t"; *)
-    ignore (legitimate_button#connect#clicked ~callback:(fun () -> p "legitimate"))
-
-  in
-  legitimate ();
-
-  let graph () = 
-    let graph_button = GButton.button  ~use_mnemonic:true  ~packing:bbox#add () in
-    graph_button#misc#set_tooltip_text
-      "Visualize the Topology states: Green=Enabled ; Gold=Active";
-    let image = GMisc.image ~file:(libui_prefix^"/graph_small.png") () in
-    graph_button#set_image image#coerce; 
-    ignore (graph_button#connect#clicked ~callback: (fun () -> p "graph_view" ));
-
-  in
-  graph ();
-
-  let viol_oracle () = 
-    let viol_button = GButton.button  ~use_mnemonic:true ~stock:`OK
-        ~packing:bbox#add () in
-    viol_button#misc#set_tooltip_text
-      "Move FORWARD until an oracle states something wrong happened";
-    (*     let image = GMisc.image ~file:"../rdbg-utils/oracle_small.jpg" () in *)
-    (*     viol_button#set_image image#coerce;  *)
-    change_label viol_button "_Oracle";
-    ignore (viol_button#connect#clicked ~callback:(fun () -> p "viol"))
-  in
-  (*   if args.oracles <> [] then *)
-  viol_oracle ();
-
-  let undo_button = GButton.button  ~use_mnemonic:true  ~stock:`UNDO
-      ~packing:bbox#add ~label:"undo" ()
-  in
-  undo_button#misc#set_tooltip_text "Undo the last move";
-  ignore (undo_button#connect#clicked ~callback:(fun () -> p "u\nd"));
-
-  let restart_button = GButton.button  ~use_mnemonic:true  ~stock:`REFRESH
-      ~packing:bbox#add ~label:"restart" ()
-  in
-  restart_button#misc#set_tooltip_text "Restart from the beginning";
-  change_label restart_button "Restar_t";
-  ignore (restart_button#connect#clicked ~callback:(fun ()-> p "r\nd"));
-
-  let info_button =
-    GButton.button ~use_mnemonic:true ~stock:`INFO ~packing:bbox#add ~label:"_Info" ()
-  in
-  change_label info_button "_Info";
-  info_button#misc#set_tooltip_text "Get information about the current session";
-  ignore (info_button#connect#clicked ~callback: (fun() -> p "i"));
-
-  let quit_button =
-    GButton.button ~use_mnemonic:true ~stock:`QUIT ~packing:bbox#add ~label:"bye" ()
-  in
-  quit_button#misc#set_tooltip_text "Quit RDBGUI";
-  ignore (quit_button#connect#clicked ~callback: (fun() -> p "q"; exit 0));
-
-
-  let dot_button = GButton.radio_button ~packing:gbox#add ~label:"dot" () in
-  let fd_button = GButton.radio_button ~packing:gbox#add
-      ~group:dot_button#group ~label:"fdp" ()
-  in
-  let sf_button = GButton.radio_button ~packing:gbox#add 
-      ~group:dot_button#group ~label:"sfdp" ()
-  in
-  let ne_button = GButton.radio_button ~packing:gbox#add 
-      ~active:true ~group:dot_button#group ~label:"neato" ()
-  in
-  let tw_button = GButton.radio_button ~packing:gbox#add 
-      ~group:dot_button#group ~label:"twopi" ()
-  in
-  let ci_button = GButton.radio_button ~packing:gbox#add 
-      ~group:dot_button#group ~label:"circo" ()
-  in
-  let pa_button = GButton.radio_button ~packing:gbox#add 
-      ~group:dot_button#group ~label:"patchwork" ()
-  in
-  let os_button = GButton.radio_button ~packing:gbox#add 
-      ~group:dot_button#group ~label:"osage" ()
-  in
-
-  let par_dot () = 
-    let par_dot_button = GButton.radio_button ~packing:gbox2#add 
-        ~group:dot_button#group ~label:"dot*" () in
-    let par_fd_button = GButton.radio_button ~packing:gbox2#add 
-        ~group:dot_button#group ~label:"fdp*" () in
-    let par_sf_button = GButton.radio_button ~packing:gbox2#add 
-        ~group:dot_button#group ~label:"sfdp*" () in
-    let par_ne_button = GButton.radio_button ~packing:gbox2#add 
-        ~group:dot_button#group ~label:"neato*" () in
-    let par_tw_button = GButton.radio_button ~packing:gbox2#add 
-        ~group:dot_button#group ~label:"twopi*" () in
-    let par_ci_button = GButton.radio_button ~packing:gbox2#add 
-        ~group:dot_button#group ~label:"circo*" () in
-    let par_pa_button = GButton.radio_button ~packing:gbox2#add 
-        ~group:dot_button#group ~label:"patchwork*" () in
-    let par_os_button = GButton.radio_button ~packing:gbox2#add 
-        ~group:dot_button#group ~label:"osage*" ()
-    in
-    par_dot_button#misc#set_tooltip_text "Use dot, but show only links to the parent (works if State.t contains a 'par:int' field)";
-    par_fd_button#misc#set_tooltip_text "Use fdp, but show only links to the parent (works if State.t contains a 'par:int' field)";
-    par_sf_button#misc#set_tooltip_text "Use sfdp, but show only links to the parent (works if State.t contains a 'par:int' field)";
-    par_ne_button#misc#set_tooltip_text "Use neato, but show only links to the parent (works if State.t contains a 'par:int' field)";
-    par_tw_button#misc#set_tooltip_text "Use twopi, but show only links to the parent (works if State.t contains a 'par:int' field)";
-    par_ci_button#misc#set_tooltip_text "Use circo, but show only links to the parent (works if State.t contains a 'par:int' field)";
-    par_pa_button#misc#set_tooltip_text "Use patchwork, but show only links to the parent (works if State.t contains a 'par:int' field)";
-    par_os_button#misc#set_tooltip_text "Use osage, but show only links to the parent (works if State.t contains a 'par:int' field)";
-    ignore (par_dot_button#connect#clicked
-              ~callback:(fun () -> p "dot_view := d_par; !dot_view();;"));
-    ignore (par_fd_button#connect#clicked
-              ~callback:(fun () -> p "dot_view := fd_par; !dot_view();;"));
-    ignore (par_sf_button#connect#clicked
-              ~callback:(fun () -> p "dot_view := sf_par; !dot_view();;"));
-    ignore (par_ne_button#connect#clicked
-              ~callback:(fun () -> p "dot_view := ne_par; !dot_view();;"));
-    ignore (par_tw_button#connect#clicked
-              ~callback:(fun () -> p "dot_view := tw_par; !dot_view();;"));
-    ignore (par_ci_button#connect#clicked
-              ~callback:(fun () -> p "dot_view := ci_par; !dot_view();;"));
-    ignore (par_pa_button#connect#clicked
-              ~callback:(fun () -> p "dot_view := pa_par; !dot_view();;"));
-    ignore (par_os_button#connect#clicked
-              ~callback:(fun () -> p "dot_view := os_par; !dot_view();;"))
-  in
-
-  let have_parent () = (* is there a parent field in the state ? *)
-    (* List.exists (fun (v,_) -> Str.string_match (Str.regexp ".*_par.*") v 0) !e.data *)
-    true
-  in
-  if have_parent () then par_dot ();
-  dot_button#misc#set_tooltip_text "Use the dot engine to display the graph";
-  fd_button#misc#set_tooltip_text "Use the fdp engine to display the graph";
-  sf_button#misc#set_tooltip_text "Use the sfdp engine to display the graph";
-  ne_button#misc#set_tooltip_text "Use the neato engine to display the graph";
-  tw_button#misc#set_tooltip_text "Use the twopi engine to display the graph";
-  ci_button#misc#set_tooltip_text "Use the circo engine to display the graph";
-  pa_button#misc#set_tooltip_text "Use the patchwork engine to display the graph";
-  os_button#misc#set_tooltip_text "Use the osage engine to display the graph";
-
-  ignore (dot_button#connect#clicked
-            ~callback:(fun () -> p "dot_view:=dot; !dot_view();;"));
-  ignore (fd_button#connect#clicked
-            ~callback:(fun () -> p "dot_view:=fd; !dot_view();;"));
-  ignore (sf_button#connect#clicked
-            ~callback:(fun () -> p "dot_view:=sf; !dot_view();;"));
-  ignore (ne_button#connect#clicked
-            ~callback:(fun () -> p "dot_view:=ne; !dot_view();;"));
-  ignore (tw_button#connect#clicked
-            ~callback:(fun () -> p "dot_view:=tw; !dot_view();;"));
-  ignore (ci_button#connect#clicked
-            ~callback:(fun () -> p "dot_view:=ci; !dot_view();;"));
-  ignore (pa_button#connect#clicked
-            ~callback:(fun () -> p "dot_view:=pa; !dot_view();;"));
-  ignore (os_button#connect#clicked
-            ~callback:(fun () -> p "dot_view:=os; !dot_view();;"));
-
-  ignore (read_stdout ic_stdout);  
-  let rec read_stdout_loop () =
-    let res = read_stdout ic_stdout in
-    let res = Str.global_replace (Str.regexp_string "(rdbg) ") "" res in 
-    if res <> "" then text2#set_buffer (GText.buffer ~text:res ());
-    (*     let res = read_stdout ic_stderr in *)
-    (*     if res <> "" then text3#set_buffer (GText.buffer ~text:res ()); *)
-    read_stdout_loop ()
-  in
-
-  let _ = Thread.create read_stdout_loop () in
-
-  (*   ignore (Sys.command "rdbg"); *)
-  readloop ()  
-  (*   GMain.main ()  *)
-;;
-
-
 let welcome () =
   Printf.printf "rdbgui4sasa is a GUI wrapper around rdbg when used with sasa\n";
-  Printf.printf "you can thus replace rdbg by rdbgui4sasa, but sasa *must be* involved in the session\n";
-  Printf.printf "Example: \n";
+  Printf.printf "you can thus replace rdbg by rdbgui4sasa, but sasa *must be* ";
+  Printf.printf "involved in the session\nExample: \n";
   Printf.printf "   rdbgui4sasa -sut \"sasa g.dot\"\n";
   Printf.printf "   rdbgui4sasa -h\n\n";
   flush stdout
@@ -331,5 +15,4 @@ let _ =
   let n = Array.length Sys.argv in
   welcome ();
   if n = 1 && Mypervasives.ls "rdbg-session" "ml" = [] then exit 0;
-  ignore (read_stdout ic_stdout);  
-  gui (read_line ()) (* read the session choice *)
+  Sys.command rdbg_cmd
-- 
GitLab


From a3b9e5c77f661dadb645e146aed42ccc008d1b21 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Thu, 6 May 2021 11:22:07 +0200
Subject: [PATCH 16/27] The rdbgui4sasa program now loads the gui

---
 test/coloring/my-rdbg-tuning.ml | 3 +--
 tools/rdbg4sasa/daemongui.ml    | 5 +++++
 tools/rdbgui4sasa/rdbgui.ml     | 3 ++-
 3 files changed, 8 insertions(+), 3 deletions(-)

diff --git a/test/coloring/my-rdbg-tuning.ml b/test/coloring/my-rdbg-tuning.ml
index 24a13f0..b7eaf70 100644
--- a/test/coloring/my-rdbg-tuning.ml
+++ b/test/coloring/my-rdbg-tuning.ml
@@ -7,7 +7,6 @@
 
 let _ =
   del_hook "print_event";
-  add_hook "print_event" (print_event);
-  main()
+  add_hook "print_event" (print_event)
 
 let pp () = List.assoc "potential" !e.data;;
diff --git a/tools/rdbg4sasa/daemongui.ml b/tools/rdbg4sasa/daemongui.ml
index a97ac8e..328930f 100644
--- a/tools/rdbg4sasa/daemongui.ml
+++ b/tools/rdbg4sasa/daemongui.ml
@@ -659,6 +659,9 @@ let main () =
 
 let gui = main 
 (* todo
+- renommer ce fichier
+- lire les commandes dans text_in
+- ne pas afficher la bouton demons custom pour les sessions pas custom
 - cacher les boutons de rounds en mode manuel
 - cacher le bouton step en mode manuel central 
 - faire les modes automatiques
@@ -667,3 +670,5 @@ let gui = main
     cf lablgtk/examples/spin.ml
     https://lazka.github.io/pgi-docs/Gtk-3.0/classes/SpinButton.html#Gtk.SpinButton
  *)
+;;
+gui()
diff --git a/tools/rdbgui4sasa/rdbgui.ml b/tools/rdbgui4sasa/rdbgui.ml
index fffe0ca..288f89a 100644
--- a/tools/rdbgui4sasa/rdbgui.ml
+++ b/tools/rdbgui4sasa/rdbgui.ml
@@ -1,7 +1,8 @@
 
 let quote str = if String.contains str ' ' then ("\""^str^"\"") else str
 let rdbg_cmd =
-  String.concat " " ("rdbg"::(List.tl (List.map quote (Array.to_list Sys.argv))))
+  String.concat " " ("rdbg"::(List.tl (List.map quote (Array.to_list Sys.argv)))) ^
+  " --ocaml-cmd \"#use \\\"daemongui.ml\\\";;\""
 
 let welcome () =
   Printf.printf "rdbgui4sasa is a GUI wrapper around rdbg when used with sasa\n";
-- 
GitLab


From 4260d18d221e32a9279cea160955047496d2bffb Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Thu, 6 May 2021 13:31:00 +0200
Subject: [PATCH 17/27] Rename the gui file

---
 tools/rdbg4sasa/dune                        | 2 +-
 tools/rdbg4sasa/{daemongui.ml => gtkgui.ml} | 2 +-
 tools/rdbgui4sasa/rdbgui.ml                 | 2 +-
 3 files changed, 3 insertions(+), 3 deletions(-)
 rename tools/rdbg4sasa/{daemongui.ml => gtkgui.ml} (99%)

diff --git a/tools/rdbg4sasa/dune b/tools/rdbg4sasa/dune
index 25cbaac..c128797 100644
--- a/tools/rdbg4sasa/dune
+++ b/tools/rdbg4sasa/dune
@@ -1,6 +1,6 @@
 
 (install
- (files sasa-rdbg-cmds.ml dot4sasa.ml daemongui.ml)
+ (files sasa-rdbg-cmds.ml dot4sasa.ml gtkgui.ml)
  (section lib)
  (package sasa)
 )
diff --git a/tools/rdbg4sasa/daemongui.ml b/tools/rdbg4sasa/gtkgui.ml
similarity index 99%
rename from tools/rdbg4sasa/daemongui.ml
rename to tools/rdbg4sasa/gtkgui.ml
index 328930f..a51d347 100644
--- a/tools/rdbg4sasa/daemongui.ml
+++ b/tools/rdbg4sasa/gtkgui.ml
@@ -659,7 +659,7 @@ let main () =
 
 let gui = main 
 (* todo
-- renommer ce fichier
+- couper les grosses fonctions en morceaux
 - lire les commandes dans text_in
 - ne pas afficher la bouton demons custom pour les sessions pas custom
 - cacher les boutons de rounds en mode manuel
diff --git a/tools/rdbgui4sasa/rdbgui.ml b/tools/rdbgui4sasa/rdbgui.ml
index 288f89a..3e05a4e 100644
--- a/tools/rdbgui4sasa/rdbgui.ml
+++ b/tools/rdbgui4sasa/rdbgui.ml
@@ -2,7 +2,7 @@
 let quote str = if String.contains str ' ' then ("\""^str^"\"") else str
 let rdbg_cmd =
   String.concat " " ("rdbg"::(List.tl (List.map quote (Array.to_list Sys.argv)))) ^
-  " --ocaml-cmd \"#use \\\"daemongui.ml\\\";;\""
+  " --ocaml-cmd \"#use \\\"gtkgui.ml\\\";;\""
 
 let welcome () =
   Printf.printf "rdbgui4sasa is a GUI wrapper around rdbg when used with sasa\n";
-- 
GitLab


From 2bd9b9e90f5cb2895b3d952712880345101c4d5d Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Thu, 6 May 2021 14:40:23 +0200
Subject: [PATCH 18/27] Only display custum mode buttons if sasa uses -custd

---
 test/coloring/Makefile      |  8 +++---
 tools/rdbg4sasa/gtkgui.ml   | 56 ++++++++++++++++++++++---------------
 tools/rdbgui4sasa/rdbgui.ml |  8 ++++--
 3 files changed, 44 insertions(+), 28 deletions(-)

diff --git a/test/coloring/Makefile b/test/coloring/Makefile
index 40cb20b..9275840 100644
--- a/test/coloring/Makefile
+++ b/test/coloring/Makefile
@@ -1,4 +1,4 @@
-# Time-stamp: <modified the 04/05/2021 (at 11:11) by Erwan Jahier>
+# Time-stamp: <modified the 06/05/2021 (at 14:39) by Erwan Jahier>
 
 
 sasa=$(DIR)/bin/sasa   -l 100
@@ -58,11 +58,11 @@ rdbgui-demo: grid10.ml
 
 rdbg-luciole: grid4.ml
 	echo "" > include.ml
-	rdbg --luciole -sut "sasa -rif grid4.dot --custom-daemon" --missing-vars-last
+	rdbg --luciole -sut "sasa -rif grid4.dot --custom-daemon"
 
-rdbgui-luciole: grid4.ml
+rdbgui-custd: grid4.ml
 	echo "" > include.ml
-	rdbgui4sasa --luciole -sut "sasa -rif grid4.dot --custom-daemon" --missing-vars-last
+	rdbgui4sasa -sut "sasa -rif grid4.dot --custom-daemon" 
 
 
 rdbg3: ring.ml
diff --git a/tools/rdbg4sasa/gtkgui.ml b/tools/rdbg4sasa/gtkgui.ml
index a51d347..99c97d3 100644
--- a/tools/rdbg4sasa/gtkgui.ml
+++ b/tools/rdbg4sasa/gtkgui.ml
@@ -399,15 +399,27 @@ let main () =
   Printf.fprintf oc_stdin "print_sasa_event false !e;;\n%!"; (* print the first event *)
   let bbox = GPack.hbox ~packing: box#add () in
 
+  let ze_step =
+    if custom_mode then
+      custom_daemon text_out w
+    else
+      s
+  in
+  let step () =
+    ze_step();
+    d()
+  in
   let change_label button str =
     let icon = button#image in
     button#set_label str;
-    button#set_image icon
+    button#set_image icon;
+    refresh ()
   in
   let button_cb cmd () =
     cmd ();
     let txt = Printf.sprintf "%s" (str_of_sasa_event false !e) in
-    text_out#buffer#set_text txt
+    text_out#buffer#set_text txt;
+    refresh ()
   in
   let button_cb_string cmd () =
     let txt = Printf.sprintf "%s" (cmd ()) in
@@ -426,7 +438,7 @@ let main () =
   in
   step_button#misc#set_tooltip_text "Move FORWARD to the next STEP";
   change_label step_button "_Step";
-  ignore (step_button#connect#clicked ~callback:(button_cb sd));
+  ignore (step_button#connect#clicked ~callback:(button_cb step));
 
   let back_round_button =
     GButton.button ~packing:bbox#add ~stock:`MEDIA_PREVIOUS  ~use_mnemonic:true 
@@ -567,36 +579,36 @@ let main () =
       "Use osage, but show only links to the parent (works if State.t contains a 'par:int' field)";
     ignore (par_dot_button#connect#clicked
               ~callback:(fun () ->
-                p ((par_dot_button#misc#tooltip_text)^"\n"^(help_string "d_par"));
-                dot_view := d_par; !dot_view()));
+                  p ((par_dot_button#misc#tooltip_text)^"\n"^(help_string "d_par"));
+                  dot_view := d_par; !dot_view()));
     ignore (par_fd_button#connect#clicked
               ~callback:(fun () ->
-                p ((par_fd_button#misc#tooltip_text)^"\n"^(help_string "fd_par"));
-                 dot_view := fd_par; !dot_view()));
+                  p ((par_fd_button#misc#tooltip_text)^"\n"^(help_string "fd_par"));
+                  dot_view := fd_par; !dot_view()));
     ignore (par_sf_button#connect#clicked
               ~callback:(fun () ->
-                p ((par_sf_button#misc#tooltip_text)^"\n"^(help_string "sf_par"));
-                 dot_view := sf_par; !dot_view()));
+                  p ((par_sf_button#misc#tooltip_text)^"\n"^(help_string "sf_par"));
+                  dot_view := sf_par; !dot_view()));
     ignore (par_ne_button#connect#clicked
               ~callback:(fun () ->
-                p ((par_ne_button#misc#tooltip_text)^"\n"^(help_string "ne_par"));
-                 dot_view := ne_par; !dot_view()));
+                  p ((par_ne_button#misc#tooltip_text)^"\n"^(help_string "ne_par"));
+                  dot_view := ne_par; !dot_view()));
     ignore (par_tw_button#connect#clicked
               ~callback:(fun () ->
-                p ((par_tw_button#misc#tooltip_text)^"\n"^(help_string "tw_par"));
-                 dot_view := tw_par; !dot_view()));
+                  p ((par_tw_button#misc#tooltip_text)^"\n"^(help_string "tw_par"));
+                  dot_view := tw_par; !dot_view()));
     ignore (par_ci_button#connect#clicked
               ~callback:(fun () ->
-                p ((par_ci_button#misc#tooltip_text)^"\n"^(help_string "ci_par"));
-                 dot_view := ci_par; !dot_view()));
+                  p ((par_ci_button#misc#tooltip_text)^"\n"^(help_string "ci_par"));
+                  dot_view := ci_par; !dot_view()));
     ignore (par_pa_button#connect#clicked
               ~callback:(fun () ->
-                p ((par_pa_button#misc#tooltip_text)^"\n"^(help_string "pa_par"));
-                 dot_view := pa_par; !dot_view()));
+                  p ((par_pa_button#misc#tooltip_text)^"\n"^(help_string "pa_par"));
+                  dot_view := pa_par; !dot_view()));
     ignore (par_os_button#connect#clicked
               ~callback:(fun () ->
-                p ((par_os_button#misc#tooltip_text)^"\n"^(help_string "os_par"));
-                 dot_view := os_par; !dot_view()))
+                  p ((par_os_button#misc#tooltip_text)^"\n"^(help_string "os_par"));
+                  dot_view := os_par; !dot_view()))
   in
 
   let have_parent () = (* is there a parent field in the state ? *)
@@ -654,14 +666,13 @@ let main () =
   (* Affichage d'informations *)
   (*     let gtext_content = ref "" in *)
 
-  let step = custom_daemon text_out w in
   refresh ()
 
 let gui = main 
 (* todo
 - couper les grosses fonctions en morceaux
+- cacher les messages issus du #use
 - lire les commandes dans text_in
-- ne pas afficher la bouton demons custom pour les sessions pas custom
 - cacher les boutons de rounds en mode manuel
 - cacher le bouton step en mode manuel central 
 - faire les modes automatiques
@@ -671,4 +682,5 @@ let gui = main
     https://lazka.github.io/pgi-docs/Gtk-3.0/classes/SpinButton.html#Gtk.SpinButton
  *)
 ;;
-gui()
+
+gui();;
diff --git a/tools/rdbgui4sasa/rdbgui.ml b/tools/rdbgui4sasa/rdbgui.ml
index 3e05a4e..e068a4e 100644
--- a/tools/rdbgui4sasa/rdbgui.ml
+++ b/tools/rdbgui4sasa/rdbgui.ml
@@ -1,8 +1,12 @@
 
 let quote str = if String.contains str ' ' then ("\""^str^"\"") else str
+
+let gui =
+  Printf.sprintf " --ocaml-cmd \"#use \\\"gtkgui.ml\\\";;\""
+
 let rdbg_cmd =
-  String.concat " " ("rdbg"::(List.tl (List.map quote (Array.to_list Sys.argv)))) ^
-  " --ocaml-cmd \"#use \\\"gtkgui.ml\\\";;\""
+  String.concat " " ("rdbg"::(List.tl (List.map quote (Array.to_list Sys.argv)))) ^ gui
+  
 
 let welcome () =
   Printf.printf "rdbgui4sasa is a GUI wrapper around rdbg when used with sasa\n";
-- 
GitLab


From a8ec5783295ab1f5c90db13e7e812f28eb4d8864 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Thu, 6 May 2021 14:57:41 +0200
Subject: [PATCH 19/27] Hide some buttons in some modes when they are useless
 (e.g., step button in Manual mode)

---
 tools/rdbg4sasa/gtkgui.ml | 49 ++++++++++++++++++++++-----------------
 1 file changed, 28 insertions(+), 21 deletions(-)

diff --git a/tools/rdbg4sasa/gtkgui.ml b/tools/rdbg4sasa/gtkgui.ml
index 99c97d3..de60147 100644
--- a/tools/rdbg4sasa/gtkgui.ml
+++ b/tools/rdbg4sasa/gtkgui.ml
@@ -77,7 +77,7 @@ let init_rdbg_hook () =
   in
   rdbg_mv_hook := Some guidaemon
 
-let custom_daemon gtext vbox =
+let custom_daemon gtext vbox step_button round_button =
   (* création du rdbg_mv_hook et de tout ce qu'il faut autour *)
   init_rdbg_hook ();
 
@@ -255,6 +255,9 @@ let custom_daemon gtext vbox =
   let update_checkbox node enabled =
     match !daemon_kind with
     | Manual ->
+      step_button#misc#show();
+      round_button#misc#hide();
+      
       checkbox_grid#misc#show();
       pushbox_grid#misc#hide();
       counter_grid#misc#hide();
@@ -267,6 +270,9 @@ let custom_daemon gtext vbox =
       );
       checkbox#set_sensitive enabled
     | ManualCentral ->
+      step_button#misc#hide();
+      round_button#misc#hide();
+
       checkbox_grid#misc#hide();
       pushbox_grid#misc#show();
       counter_grid#misc#hide();
@@ -277,6 +283,9 @@ let custom_daemon gtext vbox =
         pushbox#misc#hide ();
       pushbox#set_sensitive enabled
     | Distributed | Synchronous | Central | LocCentral ->
+      step_button#misc#show();
+      round_button#misc#show();
+
       checkbox_grid#misc#hide();
       pushbox_grid#misc#hide();
       counter_grid#misc#show()
@@ -399,16 +408,6 @@ let main () =
   Printf.fprintf oc_stdin "print_sasa_event false !e;;\n%!"; (* print the first event *)
   let bbox = GPack.hbox ~packing: box#add () in
 
-  let ze_step =
-    if custom_mode then
-      custom_daemon text_out w
-    else
-      s
-  in
-  let step () =
-    ze_step();
-    d()
-  in
   let change_label button str =
     let icon = button#image in
     button#set_label str;
@@ -436,25 +435,35 @@ let main () =
   let step_button =
     GButton.button ~use_mnemonic:true ~packing:bbox#add ~stock:`GO_FORWARD ()
   in
-  step_button#misc#set_tooltip_text "Move FORWARD to the next STEP";
-  change_label step_button "_Step";
-  ignore (step_button#connect#clicked ~callback:(button_cb step));
-
   let back_round_button =
     GButton.button ~packing:bbox#add ~stock:`MEDIA_PREVIOUS  ~use_mnemonic:true 
       ~label:"back round" ()
   in
-  back_round_button#misc#set_tooltip_text "Move BACKWARD to the previous ROUND";
-  change_label back_round_button "Roun_d";
-  ignore (back_round_button#connect#clicked ~callback:(button_cb pr));
-
   let round_button =
     GButton.button  ~use_mnemonic:true ~stock:`MEDIA_FORWARD
       ~packing:bbox#add ~label:"round" ()
   in 
+  let ze_step =
+    if custom_mode then
+      custom_daemon text_out w step_button round_button 
+    else
+      s
+  in
+  let step () =
+    ze_step();
+    d()
+  in
+
+  step_button#misc#set_tooltip_text "Move FORWARD to the next STEP";
+  change_label step_button "_Step";
+  ignore (step_button#connect#clicked ~callback:(button_cb step));
   round_button#misc#set_tooltip_text "Move FORWARD to the next ROUND";
   change_label round_button "_Round";
   ignore (round_button#connect#clicked ~callback:(button_cb nr));
+  back_round_button#misc#set_tooltip_text "Move BACKWARD to the previous ROUND";
+  change_label back_round_button "Roun_d";
+  ignore (back_round_button#connect#clicked ~callback:(button_cb pr));
+
 
   let legitimate () = 
     let legitimate_button = GButton.button ~use_mnemonic:true
@@ -673,8 +682,6 @@ let gui = main
 - couper les grosses fonctions en morceaux
 - cacher les messages issus du #use
 - lire les commandes dans text_in
-- 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 
 - utiliser les GEdit.spin_button ?
-- 
GitLab


From e47b23f9d239e22171aca74a910db75a87e7734d Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Fri, 7 May 2021 11:57:49 +0200
Subject: [PATCH 20/27] Refactoring

---
 tools/rdbg4sasa/gtkgui.ml | 336 ++++++++++++++------------------------
 1 file changed, 125 insertions(+), 211 deletions(-)

diff --git a/tools/rdbg4sasa/gtkgui.ml b/tools/rdbg4sasa/gtkgui.ml
index de60147..afc53cf 100644
--- a/tools/rdbg4sasa/gtkgui.ml
+++ b/tools/rdbg4sasa/gtkgui.ml
@@ -1,3 +1,4 @@
+(* Time-stamp: <modified the 07/05/2021 (at 09:27) by Erwan Jahier> *)
 
 #thread
 #require "lablgtk3"
@@ -82,28 +83,20 @@ let custom_daemon gtext vbox step_button round_button =
   init_rdbg_hook ();
 
   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=Distributed)
       ~label:"Distributed" ~packing:daemon_box#add ()
   in
-  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=LocCentral)
-      ~label:"Locally Central" ~group:dk_dd#group ~packing:daemon_box#add ()
-  in
-  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)
-      ~label:"Manual" ~group:dk_dd#group ~packing:daemon_box_manual#add ()
-  in
-  let dk_manual_central = GButton.radio_button  ~active:(!daemon_kind=ManualCentral)
-      ~label:"Manual Central" ~group:dk_dd#group ~packing:daemon_box_manual#add ()
-  in
-  let scrolled = GBin.scrolled_window ~border_width:10
-      ~shadow_type:`OUT ~height:150 ~packing:vbox#add ()
-  in
+  let make_but act lbl = GButton.radio_button ~active:act ~label:lbl
+      ~group:dk_dd#group ~packing:daemon_box#add ()
+  in
+  let dk_cd =  make_but (!daemon_kind=Central) "Central" in
+  let dk_lcd = make_but (!daemon_kind=LocCentral) "Locally Central" in
+  let dk_sd = make_but  (!daemon_kind=Synchronous) "Synchronous" in
+  let dk_manual = make_but (!daemon_kind=Manual) "Manual" in
+  let dk_manual_central = make_but (!daemon_kind=ManualCentral) "Manual Central" in
+  (*   let _scrolled = GBin.scrolled_window ~border_width:10 *)
+  (*       ~shadow_type:`OUT ~height:150 ~packing:vbox#add () *)
+  (*   in *)
   dk_dd#misc#set_tooltip_text (Printf.sprintf "Set the automatic distributed mode");
   dk_sd#misc#set_tooltip_text (Printf.sprintf "Set the automatic synchronous mode");
   dk_cd#misc#set_tooltip_text (Printf.sprintf "Set the automatic central mode");
@@ -185,7 +178,7 @@ let custom_daemon gtext vbox step_button round_button =
       ~height:300
       ~shadow_type:`OUT ~packing:pushbox_grid#add ()
   in
-  let pushbox_scrolled_grid_box = GPack.vbox  ~homogeneous:true ~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
@@ -369,7 +362,8 @@ let libui_prefix = prefix ^ "/lib/rdbgui4sasa"
 
 let oc_stdin = stdout
 let ic_stdout = stdin
-  
+
+open GButton
   (* GTK3 *)    
 let main () =
   let _locale = GtkMain.Main.init () in 
@@ -383,17 +377,10 @@ let main () =
   let box = GPack.vbox ~packing: w#add () in
   let gbox = GPack.hbox ~packing: box#add () in
   let gbox2 = GPack.hbox ~packing: box#add () in
-  let sw1 = GBin.scrolled_window ~border_width:10 ~shadow_type:`IN  ~height:30 ~width:50
-      ~packing:box#add ()
-  in
   let sw2 = GBin.scrolled_window ~border_width:10 ~shadow_type:`OUT ~height:250
       ~packing:box#add ()
   in
-  sw1#misc#set_tooltip_text "This window displays the commands sent to the rdbg cli";
   sw2#misc#set_tooltip_text "This window displays commands outputs";
-  let text_in = GText.view ~wrap_mode:`CHAR ~height:250 ~editable:true ~width:50
-      ~packing: sw1#add () ~cursor_visible:true
-  in  
   let text_out = GText.view ~wrap_mode:`CHAR ~height:250 ~editable:false 
       ~packing: sw2#add () ~cursor_visible:true 
   in 
@@ -402,10 +389,33 @@ let main () =
     Printf.fprintf oc_stdin "%s\n%!" str;
     Printf.printf "%s\n%!" str;
   in
+  (* It should be better to rely on the gtk event handler 
 
-  Printf.fprintf oc_stdin "#require \"sasa\";;\n%!" ;
-  (*   Printf.fprintf oc_stdin "#use \"sasa-rdbg-cmds.ml\";;\n%!"; *)
-  Printf.fprintf oc_stdin "print_sasa_event false !e;;\n%!"; (* print the first event *)
+     let sw1 = GBin.scrolled_window ~border_width:10 ~shadow_type:`IN  ~height:30 ~width:50
+      ~packing:box#add ()
+     in
+     sw1#misc#set_tooltip_text "This window displays the commands sent to the rdbg cli";
+     let text_in = GText.view ~wrap_mode:`CHAR ~height:250 ~editable:true ~width:50
+      ~packing: sw1#add () ~cursor_visible:true
+     in
+     let rec read_text_in () =
+     let buff = text_in#buffer#get_text () in
+     let size = String.length buff in
+     if size >0 then (
+      let last =  String.get buff (size - 1) in
+      if last = '\n' then (
+        Printf.fprintf oc_stdin "%s\n%!" buff;
+        Printf.printf "%s\n%!" buff;
+        text_in#set_buffer (GText.buffer ~text:"(rdbg) " ())
+      ) else ()
+     );
+     Unix.sleepf 0.1;
+     read_text_in ()
+     in
+     let _ = Thread.create read_text_in () in
+  *)
+  (* Printf.fprintf oc_stdin "#use \"sasa-rdbg-cmds.ml\";;\n%!"; *)
+  (* Printf.fprintf oc_stdin "print_sasa_event false !e;;\n%!"; (* print the first event *) *)
   let bbox = GPack.hbox ~packing: box#add () in
 
   let change_label button str =
@@ -425,23 +435,17 @@ let main () =
     text_out#buffer#set_text txt
   in
 
-  let back_step_button =
-    GButton.button ~use_mnemonic:true ~stock:`GO_BACK ~packing:bbox#add  ()
-  in
+  let back_step_button = button ~use_mnemonic:true ~stock:`GO_BACK ~packing:bbox#add () in
   back_step_button#misc#set_tooltip_text "Move BACKWARD to the previous STEP";
   change_label back_step_button "Ste_p";
   ignore (back_step_button#connect#clicked ~callback:(button_cb bd));
 
-  let step_button =
-    GButton.button ~use_mnemonic:true ~packing:bbox#add ~stock:`GO_FORWARD ()
-  in
+  let step_button = button ~use_mnemonic:true ~packing:bbox#add ~stock:`GO_FORWARD ()  in
   let back_round_button =
-    GButton.button ~packing:bbox#add ~stock:`MEDIA_PREVIOUS  ~use_mnemonic:true 
-      ~label:"back round" ()
+    button ~packing:bbox#add ~stock:`MEDIA_PREVIOUS  ~use_mnemonic:true ~label:"back round" ()
   in
   let round_button =
-    GButton.button  ~use_mnemonic:true ~stock:`MEDIA_FORWARD
-      ~packing:bbox#add ~label:"round" ()
+    button  ~use_mnemonic:true ~stock:`MEDIA_FORWARD ~packing:bbox#add ~label:"round" ()
   in 
   let ze_step =
     if custom_mode then
@@ -464,10 +468,8 @@ let main () =
   change_label back_round_button "Roun_d";
   ignore (back_round_button#connect#clicked ~callback:(button_cb pr));
 
-
   let legitimate () = 
-    let legitimate_button = GButton.button ~use_mnemonic:true
-        ~packing:bbox#add () in
+    let legitimate_button = button ~use_mnemonic:true ~packing:bbox#add () in
     legitimate_button#misc#set_tooltip_text
       "Move FORWARD until a legitimate configuration is reached (silence by default)";
     let image = GMisc.image ~file:(libui_prefix^"/chut_small.svg") () in
@@ -479,7 +481,7 @@ let main () =
   legitimate ();
 
   let graph () = 
-    let graph_button = GButton.button  ~use_mnemonic:true  ~packing:bbox#add () in
+    let graph_button = button  ~use_mnemonic:true  ~packing:bbox#add () in
     graph_button#misc#set_tooltip_text
       "Visualize the Topology states: Green=Enabled ; Gold=Active";
     let image = GMisc.image ~file:(libui_prefix^"/graph_small.png") () in
@@ -489,142 +491,76 @@ let main () =
   in
   graph ();
 
-  let viol_oracle () = 
-    let viol_button = GButton.button  ~use_mnemonic:true ~stock:`OK
-        ~packing:bbox#add () in
-    viol_button#misc#set_tooltip_text
-      "Move FORWARD until an oracle is violated";
-    (*     let image = GMisc.image ~file:"../rdbg-utils/oracle_small.jpg" () in *)
-    (*     viol_button#set_image image#coerce;  *)
-    change_label viol_button "_Oracle";
-    ignore (viol_button#connect#clicked ~callback:(button_cb_string viol_string))
-  in
-  (*   if args.oracles <> [] then *)
-  viol_oracle ();
-
-  let undo_button = GButton.button  ~use_mnemonic:true  ~stock:`UNDO
-      ~packing:bbox#add ~label:"undo" ()
-  in
-  undo_button#misc#set_tooltip_text "Undo the last move";
-  ignore (undo_button#connect#clicked ~callback:(button_cb (fun () -> u();d())));
-
-  let restart_button = GButton.button  ~use_mnemonic:true  ~stock:`REFRESH
-      ~packing:bbox#add ~label:"restart" ()
-  in
-  restart_button#misc#set_tooltip_text "Restart from the beginning";
-  change_label restart_button "Restar_t";
-  ignore (restart_button#connect#clicked ~callback:(button_cb (fun ()-> r();d())));
-
-  let info_button =
-    GButton.button ~use_mnemonic:true ~stock:`INFO ~packing:bbox#add ~label:"_Info" ()
-  in
-  change_label info_button "_Info";
-  info_button#misc#set_tooltip_text "Get information about the current session";
-  ignore (info_button#connect#clicked ~callback:(button_cb_string info_string));
-
-  let quit_button =
-    GButton.button ~use_mnemonic:true ~stock:`QUIT ~packing:bbox#add ~label:"_Quit" ()
-  in
-  quit_button#misc#set_tooltip_text "Quit RDBGUI";
-  ignore (quit_button#connect#clicked ~callback: (fun() -> Stdlib.exit 0));
-
-
-  let dot_button = GButton.radio_button ~packing:gbox#add ~label:"dot" () in
-  let fd_button = GButton.radio_button ~packing:gbox#add
-      ~group:dot_button#group ~label:"fdp" ()
-  in
-  let sf_button = GButton.radio_button ~packing:gbox#add 
-      ~group:dot_button#group ~label:"sfdp" ()
-  in
-  let ne_button = GButton.radio_button ~packing:gbox#add 
-      ~active:true ~group:dot_button#group ~label:"neato" ()
-  in
-  let tw_button = GButton.radio_button ~packing:gbox#add 
-      ~group:dot_button#group ~label:"twopi" ()
-  in
-  let ci_button = GButton.radio_button ~packing:gbox#add 
-      ~group:dot_button#group ~label:"circo" ()
-  in
-  let pa_button = GButton.radio_button ~packing:gbox#add 
-      ~group:dot_button#group ~label:"patchwork" ()
-  in
-  let os_button = GButton.radio_button ~packing:gbox#add 
-      ~group:dot_button#group ~label:"osage" ()
-  in
-
-  let par_dot () = 
-    let par_dot_button = GButton.radio_button ~packing:gbox2#add 
-        ~group:dot_button#group ~label:"dot*" () in
-    let par_fd_button = GButton.radio_button ~packing:gbox2#add 
-        ~group:dot_button#group ~label:"fdp*" () in
-    let par_sf_button = GButton.radio_button ~packing:gbox2#add 
-        ~group:dot_button#group ~label:"sfdp*" () in
-    let par_ne_button = GButton.radio_button ~packing:gbox2#add 
-        ~group:dot_button#group ~label:"neato*" () in
-    let par_tw_button = GButton.radio_button ~packing:gbox2#add 
-        ~group:dot_button#group ~label:"twopi*" () in
-    let par_ci_button = GButton.radio_button ~packing:gbox2#add 
-        ~group:dot_button#group ~label:"circo*" () in
-    let par_pa_button = GButton.radio_button ~packing:gbox2#add 
-        ~group:dot_button#group ~label:"patchwork*" () in
-    let par_os_button = GButton.radio_button ~packing:gbox2#add 
-        ~group:dot_button#group ~label:"osage*" ()
-    in
-    par_dot_button#misc#set_tooltip_text
-      "Use dot, but show only links to the parent (works if State.t contains a 'par:int' field)";
-    par_fd_button#misc#set_tooltip_text
-      "Use fdp, but show only links to the parent (works if State.t contains a 'par:int' field)";
-    par_sf_button#misc#set_tooltip_text
-      "Use sfdp, but show only links to the parent (works if State.t contains a 'par:int' field)";
-    par_ne_button#misc#set_tooltip_text
-      "Use neato, but show only links to the parent (works if State.t contains a 'par:int' field)";
-    par_tw_button#misc#set_tooltip_text
-      "Use twopi, but show only links to the parent (works if State.t contains a 'par:int' field)";
-    par_ci_button#misc#set_tooltip_text
-      "Use circo, but show only links to the parent (works if State.t contains a 'par:int' field)";
-    par_pa_button#misc#set_tooltip_text
-      "Use patchwork, but show only links to the parent (works if State.t contains a 'par:int' field)";
-    par_os_button#misc#set_tooltip_text
-      "Use osage, but show only links to the parent (works if State.t contains a 'par:int' field)";
-    ignore (par_dot_button#connect#clicked
-              ~callback:(fun () ->
-                  p ((par_dot_button#misc#tooltip_text)^"\n"^(help_string "d_par"));
-                  dot_view := d_par; !dot_view()));
-    ignore (par_fd_button#connect#clicked
-              ~callback:(fun () ->
-                  p ((par_fd_button#misc#tooltip_text)^"\n"^(help_string "fd_par"));
-                  dot_view := fd_par; !dot_view()));
-    ignore (par_sf_button#connect#clicked
-              ~callback:(fun () ->
-                  p ((par_sf_button#misc#tooltip_text)^"\n"^(help_string "sf_par"));
-                  dot_view := sf_par; !dot_view()));
-    ignore (par_ne_button#connect#clicked
-              ~callback:(fun () ->
-                  p ((par_ne_button#misc#tooltip_text)^"\n"^(help_string "ne_par"));
-                  dot_view := ne_par; !dot_view()));
-    ignore (par_tw_button#connect#clicked
-              ~callback:(fun () ->
-                  p ((par_tw_button#misc#tooltip_text)^"\n"^(help_string "tw_par"));
-                  dot_view := tw_par; !dot_view()));
-    ignore (par_ci_button#connect#clicked
-              ~callback:(fun () ->
-                  p ((par_ci_button#misc#tooltip_text)^"\n"^(help_string "ci_par"));
-                  dot_view := ci_par; !dot_view()));
-    ignore (par_pa_button#connect#clicked
-              ~callback:(fun () ->
-                  p ((par_pa_button#misc#tooltip_text)^"\n"^(help_string "pa_par"));
-                  dot_view := pa_par; !dot_view()));
-    ignore (par_os_button#connect#clicked
-              ~callback:(fun () ->
-                  p ((par_os_button#misc#tooltip_text)^"\n"^(help_string "os_par"));
-                  dot_view := os_par; !dot_view()))
+  let make_button stock lbl msg cmd =
+    let butt = button ~use_mnemonic:true ~stock:stock ~packing:bbox#add ~label:lbl () in
+    butt#misc#set_tooltip_text msg;
+    change_label butt lbl;
+    ignore (butt#connect#clicked ~callback:cmd);
+    butt
+  in
+  if args.oracles <> [] then (
+    ignore (make_button `OK "_Oracle" "Move FORWARD until an oracle is violated"
+      (*     let image = GMisc.image ~file:"../rdbg-utils/oracle_small.jpg" () in *)
+      (*     viol_button#set_image image#coerce;  *)
+            (button_cb_string viol_string))
+  );
+  let _ = make_button `UNDO "_Undo" "Undo the last move" (button_cb (fun ()->u();d())) in
+  let _ = make_button `REFRESH "Restar_t" "Restart from the beginning"
+      (button_cb (fun ()-> r();d()))
+  in
+  let _ = make_button `INFO "_Info" "Get information about the current session"
+      (button_cb_string info_string)
+  in
+  let _ = make_button `QUIT "_Quit" "Quit RDBGUI" (fun() -> p "bye"; Stdlib.exit 0) in
+  let dot_button = radio_button ~packing:gbox#add ~label:"dot" () in
+  let make_but active lbl = radio_button ~packing:gbox#add
+      ~active:active ~group:dot_button#group ~label:lbl ()
+  in
+  let fd_button = make_but false "fdp" in
+  let sf_button = make_but false "sfdp" in
+  let ne_button = make_but true "neato" in
+  let tw_button = make_but false "twopi" in
+  let ci_button = make_but false "circo" in
+  let pa_button = make_but false "patchwork" in
+  let os_button = make_but false "osage" in
+
+  let connect button str cmd =
+    ignore (button#connect#clicked
+              ~callback:(fun () -> p ((button#misc#tooltip_text)^"\n"^(help_string str));
+                          dot_view := cmd; !dot_view()))
   in
-
   let have_parent () = (* is there a parent field in the state ? *)
-    (* List.exists (fun (v,_) -> Str.string_match (Str.regexp ".*_par.*") v 0) !e.data *)
-    true
+    List.exists (fun (v,_) -> Str.string_match (Str.regexp ".*_par.*") v 0) !e.data 
   in
-  if have_parent () then par_dot ();
+  if have_parent () then (
+    let make_but lbl = GButton.radio_button ~packing:gbox2#add 
+        ~group:dot_button#group ~label:lbl ()
+    in
+    let par_dot_button = make_but "dot*" in
+    let par_fd_button = make_but "fdp*" in
+    let par_sf_button = make_but "sfdp*" in
+    let par_ne_button = make_but "neato*" in
+    let par_tw_button = make_but "twopi*" in
+    let par_ci_button = make_but "circo*" in
+    let par_pa_button = make_but "patchwork*" in
+    let par_os_button = make_but "osage*" in
+    par_dot_button#misc#set_tooltip_text "Use dot, but show only links to the parent";
+    par_fd_button#misc#set_tooltip_text  "Use fdp, but show only links to the parent";
+    par_sf_button#misc#set_tooltip_text  "Use sfdp, but show only links to the parent";
+    par_ne_button#misc#set_tooltip_text  "Use neato, but show only links to the parent";
+    par_tw_button#misc#set_tooltip_text  "Use twopi, but show only links to the parent";
+    par_ci_button#misc#set_tooltip_text  "Use circo, but show only links to the parent";
+    par_pa_button#misc#set_tooltip_text  "Use patchwork, but show only links to the parent";
+    par_os_button#misc#set_tooltip_text  "Use osage, but show only links to the parent";
+    connect par_dot_button "d_par" d_par;
+    connect par_fd_button "fd_par" fd_par;
+    connect par_sf_button "sf_par" sf_par;
+    connect par_ne_button "ne_par" ne_par;
+    connect par_tw_button "tw_par" tw_par;
+    connect par_ci_button "ci_par" ci_par;
+    connect par_pa_button "pa_par" pa_par;
+    connect par_os_button "os_par" os_par;
+  );
   dot_button#misc#set_tooltip_text "Use the dot engine to display the graph";
   fd_button#misc#set_tooltip_text "Use the fdp engine to display the graph";
   sf_button#misc#set_tooltip_text "Use the sfdp engine to display the graph";
@@ -634,38 +570,15 @@ let main () =
   pa_button#misc#set_tooltip_text "Use the patchwork engine to display the graph";
   os_button#misc#set_tooltip_text "Use the osage engine to display the graph";
 
-  ignore (dot_button#connect#clicked
-            ~callback:(fun () ->
-                p ((dot_button#misc#tooltip_text)^"\n"^(help_string "d"));
-                dot_view:=dot; !dot_view()));
-  ignore (fd_button#connect#clicked
-            ~callback:(fun () ->
-                p ((fd_button#misc#tooltip_text)^"\n"^(help_string "fd"));
-                dot_view:=fd; !dot_view()));
-  ignore (sf_button#connect#clicked
-            ~callback:(fun () ->
-                p ((sf_button#misc#tooltip_text)^"\n"^(help_string "sf"));
-                dot_view:=sf; !dot_view()));
-  ignore (ne_button#connect#clicked
-            ~callback:(fun () ->
-                p ((ne_button#misc#tooltip_text)^"\n"^(help_string "ne"));
-                dot_view:=ne; !dot_view()));
-  ignore (tw_button#connect#clicked
-            ~callback:(fun () ->
-                p ((tw_button#misc#tooltip_text)^"\n"^(help_string "tw"));
-                dot_view:=tw; !dot_view()));
-  ignore (ci_button#connect#clicked
-            ~callback:(fun () ->
-                p ((ci_button#misc#tooltip_text)^"\n"^(help_string "ci"));
-                dot_view:=ci; !dot_view()));
-  ignore (pa_button#connect#clicked
-            ~callback:(fun () ->
-                p ((pa_button#misc#tooltip_text)^"\n"^(help_string "pa"));
-                dot_view:=pa; !dot_view()));
-  ignore (os_button#connect#clicked
-            ~callback:(fun () ->
-                p ((os_button#misc#tooltip_text)^"\n"^(help_string "os"));
-                dot_view:=os; !dot_view()));
+  connect dot_button "d" dot;
+  connect fd_button "fd" fd;
+  connect sf_button "sf" sf;
+  connect ne_button "ne" ne;
+  connect tw_button "tw" tw;
+  connect ci_button "ci" ci;
+  connect pa_button "pa" pa;
+  connect os_button "os" os;
+
   ignore (window#connect#destroy ~callback: (
       fun () ->
         quit (); (* quit rdbg, this will stop the readloop below *)
@@ -679,9 +592,10 @@ let main () =
 
 let gui = main 
 (* todo
+- boutons gnuplot-rif et sim2chro
 - couper les grosses fonctions en morceaux
 - cacher les messages issus du #use
-- lire les commandes dans text_in
+- lire les commandes dans text_in (comment ? c'est rdbgtop qui lance gtk maintenant...)
 - faire les modes automatiques
 - reglage de la taille des boites 
 - utiliser les GEdit.spin_button ?
-- 
GitLab


From f3b04bdb2fdb2ffd1c652d7d603a4c3d84dc96f4 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Fri, 7 May 2021 13:26:30 +0200
Subject: [PATCH 21/27] Add a 2 chronogram viewer buttons

---
 tools/rdbg4sasa/gtkgui.ml | 13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

diff --git a/tools/rdbg4sasa/gtkgui.ml b/tools/rdbg4sasa/gtkgui.ml
index afc53cf..3f15caa 100644
--- a/tools/rdbg4sasa/gtkgui.ml
+++ b/tools/rdbg4sasa/gtkgui.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/05/2021 (at 09:27) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/05/2021 (at 13:27) by Erwan Jahier> *)
 
 #thread
 #require "lablgtk3"
@@ -508,10 +508,19 @@ let main () =
   let _ = make_button `REFRESH "Restar_t" "Restart from the beginning"
       (button_cb (fun ()-> r();d()))
   in
+  let _ = make_button `MEDIA_PLAY "_Sim2chro" "Launch sim2chro on the generated data (so far)"
+      (button_cb (fun ()->sim2chro ()))
+  in
+  let _ = make_button `MEDIA_PLAY "_Gnuplot" "Launch gnuplot-rif on the generated data (so far)"
+      (button_cb (fun ()->gnuplot ()))
+  in
   let _ = make_button `INFO "_Info" "Get information about the current session"
       (button_cb_string info_string)
   in
+
   let _ = make_button `QUIT "_Quit" "Quit RDBGUI" (fun() -> p "bye"; Stdlib.exit 0) in
+
+  
   let dot_button = radio_button ~packing:gbox#add ~label:"dot" () in
   let make_but active lbl = radio_button ~packing:gbox#add
       ~active:active ~group:dot_button#group ~label:lbl ()
@@ -592,7 +601,7 @@ let main () =
 
 let gui = main 
 (* todo
-- boutons gnuplot-rif et sim2chro
+- les oracles sont violés en silence
 - couper les grosses fonctions en morceaux
 - cacher les messages issus du #use
 - lire les commandes dans text_in (comment ? c'est rdbgtop qui lance gtk maintenant...)
-- 
GitLab


From 6435eae3a56b7a22eb26e63d5b00d22eb0c14263 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Fri, 7 May 2021 15:13:18 +0200
Subject: [PATCH 22/27] Implement the automatic Central daemon

---
 lib/sasacore/daemon.mli   |   5 +-
 tools/rdbg4sasa/gtkgui.ml | 104 ++++++++++++++++++--------------------
 2 files changed, 54 insertions(+), 55 deletions(-)

diff --git a/lib/sasacore/daemon.mli b/lib/sasacore/daemon.mli
index 1c5d94f..ae3471a 100644
--- a/lib/sasacore/daemon.mli
+++ b/lib/sasacore/daemon.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 03/05/2021 (at 16:16) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/05/2021 (at 13:43) by Erwan Jahier> *)
 
 type t =
   | Synchronous (* select all actions *) 
@@ -49,3 +49,6 @@ val f : bool -> bool -> t -> 'v Process.t list ->
   'v Env.t -> 'v pna list list -> bool list list ->
   (string -> string -> bool) -> bool list list * 'v pna list
 
+
+(** Used in gtkgui.ml *)
+val central: 'a list list -> 'a list
diff --git a/tools/rdbg4sasa/gtkgui.ml b/tools/rdbg4sasa/gtkgui.ml
index 3f15caa..826dd06 100644
--- a/tools/rdbg4sasa/gtkgui.ml
+++ b/tools/rdbg4sasa/gtkgui.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/05/2021 (at 13:27) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/05/2021 (at 15:18) by Erwan Jahier> *)
 
 #thread
 #require "lablgtk3"
@@ -78,7 +78,7 @@ let init_rdbg_hook () =
   in
   rdbg_mv_hook := Some guidaemon
 
-let custom_daemon gtext vbox step_button round_button =
+let custom_daemon p gtext vbox step_button round_button =
   (* création du rdbg_mv_hook et de tout ce qu'il faut autour *)
   init_rdbg_hook ();
 
@@ -109,20 +109,13 @@ let custom_daemon gtext vbox step_button round_button =
   (** 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
-     | Distributed | Synchronous | Central | LocCentral -> 
+     | 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;
-              )
-           )
+           (fun n status -> Hashtbl.replace daemongui_activate n (n = node && status))
            daemongui_activate;
        )
      | Manual ->
@@ -250,7 +243,7 @@ let custom_daemon gtext vbox step_button round_button =
     | Manual ->
       step_button#misc#show();
       round_button#misc#hide();
-      
+
       checkbox_grid#misc#show();
       pushbox_grid#misc#hide();
       counter_grid#misc#hide();
@@ -307,49 +300,52 @@ let custom_daemon gtext vbox step_button round_button =
   ignore(dk_manual_central#connect#clicked ~callback:set_manual_central_mode);
   (* Affichage d'informations *)
   (*   gtext#buffer#set_text !gtext_content; *)
-  
-   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 ()
+  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
-   step
+    aux 0 [] nl
+  in
+  let step () =
+    match !daemon_kind with
+    | Distributed -> 
+      p  "finish me"
+    | Synchronous -> (
+        let nodes_enabled = rdbg_nodes_enabled !e in
+        let nodes = get_higher_prioriry nodes_enabled in
+        List.iter (fun (n,_) -> Hashtbl.replace daemongui_activate n (List.mem n nodes))
+          nodes_enabled;
+        sd ();
+        gtext#buffer#set_text  ("Synchronous step : " ^ (String.concat "," nodes))
+      )
+    | Central  ->
+      let nodes_enabled = rdbg_nodes_enabled !e in
+      let nodes = List.filter (fun (_,b) -> b) nodes_enabled in
+      let nodes = get_higher_prioriry nodes_enabled in
+      let to_activate = Daemon.central [nodes]  in
+      Hashtbl.clear daemongui_activate;
+      List.iter (fun n ->  Hashtbl.replace daemongui_activate n true) to_activate;
+      sd ();
+      p  ("Central step : " ^  (String.concat "," to_activate))
+      
+    | LocCentral -> 
+      p  "finish me"
+
+    | ManualCentral -> () (* SNO *)
+    | Manual -> sd ()
+  in
+  step
 
 let prefix =
   try
@@ -449,7 +445,7 @@ let main () =
   in 
   let ze_step =
     if custom_mode then
-      custom_daemon text_out w step_button round_button 
+      custom_daemon p text_out w step_button round_button 
     else
       s
   in
-- 
GitLab


From cae2ab6b1eb1f34d60339e0405408bead99554e4 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Fri, 7 May 2021 16:23:12 +0200
Subject: [PATCH 23/27] Implement the automatic distributed daemon (and fix the
 automatic synchronous one)

---
 lib/sasacore/daemon.mli   |  3 ++-
 tools/rdbg4sasa/gtkgui.ml | 43 ++++++++++++++++++++++++---------------
 2 files changed, 29 insertions(+), 17 deletions(-)

diff --git a/lib/sasacore/daemon.mli b/lib/sasacore/daemon.mli
index ae3471a..a4f058f 100644
--- a/lib/sasacore/daemon.mli
+++ b/lib/sasacore/daemon.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/05/2021 (at 13:43) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/05/2021 (at 15:25) by Erwan Jahier> *)
 
 type t =
   | Synchronous (* select all actions *) 
@@ -52,3 +52,4 @@ val f : bool -> bool -> t -> 'v Process.t list ->
 
 (** Used in gtkgui.ml *)
 val central: 'a list list -> 'a list
+val distributed: 'a list list -> 'a list
diff --git a/tools/rdbg4sasa/gtkgui.ml b/tools/rdbg4sasa/gtkgui.ml
index 826dd06..91fac17 100644
--- a/tools/rdbg4sasa/gtkgui.ml
+++ b/tools/rdbg4sasa/gtkgui.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/05/2021 (at 15:18) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/05/2021 (at 16:20) by Erwan Jahier> *)
 
 #thread
 #require "lablgtk3"
@@ -27,15 +27,20 @@ let rdbg_nodes_info e: (string * string * bool) list =
   in    
   List.map split_var enabled
 
-(** Liste qui dit  pour chaque  noeud s'il  est activable.  On suppose
-   qu'ils sont groupés. *)
+(** Liste  qui dit pour chaque  noeud s'il est activable.   On suppose
+   qu'ils sont groupés.
+
+    XXX  On  suppose aussi  qu'au  plus  une  action par  process  est
+   enabled.  Les  demons  dans  sasa,  font  mieux.  Mais  ici,  c'est
+   raisonnable si on ne veut pas avoir nb_actions fois plus de boutons
+   ! (alors que ca n'arrive jamais) *)
 let rdbg_nodes_enabled e =
   match rdbg_nodes_info e with
   | [] -> assert false
-  | (node, _, enab)::l -> 
+  | (node, _action, enab)::l ->
     let last, res =
       List.fold_left
-        (fun ((p_node, p_enab), res) (node, state, enab) ->
+        (fun ((p_node, p_enab), res) (node, _action, enab) ->
            if p_node = node then
              (node, p_enab || enab), res
            else
@@ -45,6 +50,7 @@ let rdbg_nodes_enabled e =
         l
     in
     List.rev (last::res)
+
   
 type daemon_kind = Distributed | Synchronous | Central | LocCentral | ManualCentral | Manual 
 let daemon_kind = ref ManualCentral
@@ -318,27 +324,32 @@ let custom_daemon p gtext vbox step_button round_button =
     aux 0 [] nl
   in
   let step () =
+    let nodes_enabled = rdbg_nodes_enabled !e in
+    let nodes = List.filter (fun (_,b) -> b) nodes_enabled in
+    let nodes = get_higher_prioriry nodes_enabled in
     match !daemon_kind with
     | Distributed -> 
-      p  "finish me"
+      let nodes = List.map (fun x -> [x]) nodes in
+      let to_activate = Daemon.distributed nodes in
+      Hashtbl.clear daemongui_activate;
+      List.iter (fun n ->  Hashtbl.replace daemongui_activate n true) to_activate;
+      sd ();
+
+      p  ("Distributed step : " ^  (String.concat "," to_activate))
     | Synchronous -> (
-        let nodes_enabled = rdbg_nodes_enabled !e in
-        let nodes = get_higher_prioriry nodes_enabled in
-        List.iter (fun (n,_) -> Hashtbl.replace daemongui_activate n (List.mem n nodes))
-          nodes_enabled;
+        Hashtbl.clear daemongui_activate;
+        List.iter (fun n -> Hashtbl.replace daemongui_activate n true) nodes;
         sd ();
-        gtext#buffer#set_text  ("Synchronous step : " ^ (String.concat "," nodes))
+        p  ("Synchronous step : " ^ (String.concat "," nodes))
       )
     | Central  ->
-      let nodes_enabled = rdbg_nodes_enabled !e in
-      let nodes = List.filter (fun (_,b) -> b) nodes_enabled in
-      let nodes = get_higher_prioriry nodes_enabled in
-      let to_activate = Daemon.central [nodes]  in
+      let nodes = List.map (fun x -> [x]) nodes in
+      let to_activate = Daemon.central nodes  in
       Hashtbl.clear daemongui_activate;
       List.iter (fun n ->  Hashtbl.replace daemongui_activate n true) to_activate;
       sd ();
       p  ("Central step : " ^  (String.concat "," to_activate))
-      
+
     | LocCentral -> 
       p  "finish me"
 
-- 
GitLab


From 749a8ea69a2c9b61c4ac80394e4127c662e5af02 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Fri, 7 May 2021 17:09:16 +0200
Subject: [PATCH 24/27] Implement the automatic locally central daemon

---
 lib/sasacore/daemon.ml    | 27 ++++++++++++++++++++++++---
 lib/sasacore/daemon.mli   |  5 ++++-
 tools/rdbg4sasa/gtkgui.ml | 24 +++++++++++++++++-------
 3 files changed, 45 insertions(+), 11 deletions(-)

diff --git a/lib/sasacore/daemon.ml b/lib/sasacore/daemon.ml
index e4f2a3e..ffa1ebc 100644
--- a/lib/sasacore/daemon.ml
+++ b/lib/sasacore/daemon.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 03/05/2021 (at 16:16) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/05/2021 (at 16:43) by Erwan Jahier> *)
 
 type t =
   | Synchronous (* select all actions *) 
@@ -54,7 +54,7 @@ let (synchrone: 'a list list -> 'a list) = fun all ->
 
 XXX this daemon is not fair: it is biased by the degree of nodes.
 *)
-let (locally_central: 'v pna list list -> 'v pna list) =
+let (locally_central_pna: 'v pna list list -> 'v pna list) =
   fun all ->
     let remove_one_conflict al =
       let _a, al = random_list2 al in
@@ -74,6 +74,27 @@ let (locally_central: 'v pna list list -> 'v pna list) =
       let al = distributed all in
       remove_conflicts al
 
+(* Somewhat duplicate the previous one. Hard to avoid... *)
+let (locally_central: ('v * 'v list) list list -> 'v list) =
+  fun all ->
+    let remove_one_conflict al =
+      let _a, al = random_list2 al in
+      al
+    in
+    let rec remove_conflicts al =
+      let activated_pids = List.map (fun (pid,_) -> pid) al in
+      let conflicts, ok = List.partition (fun (_p,nl) ->
+          List.exists (fun n -> List.mem n activated_pids) nl
+        ) al
+      in
+      if conflicts = [] then ok else
+        let conflicts = remove_one_conflict conflicts in
+        ok @ (remove_conflicts conflicts)
+    in
+    if all = [] then [] else
+      let al = distributed all in
+      fst (List.split (remove_conflicts al))
+
 let rec map3 f l1 l2 l3 =
   match (l1, l2, l3) with
     ([], [], []) -> []
@@ -137,7 +158,7 @@ let (f: bool -> bool -> t -> 'v Process.t list ->
     let al = central nall in
     get_activate_val al pl, al
   | LocallyCentral ->
-    let al = locally_central nall in
+    let al = locally_central_pna nall in
     get_activate_val al pl, al
   | Distributed ->
     let al = distributed nall in
diff --git a/lib/sasacore/daemon.mli b/lib/sasacore/daemon.mli
index a4f058f..6a71adb 100644
--- a/lib/sasacore/daemon.mli
+++ b/lib/sasacore/daemon.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/05/2021 (at 15:25) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/05/2021 (at 16:42) by Erwan Jahier> *)
 
 type t =
   | Synchronous (* select all actions *) 
@@ -53,3 +53,6 @@ val f : bool -> bool -> t -> 'v Process.t list ->
 (** Used in gtkgui.ml *)
 val central: 'a list list -> 'a list
 val distributed: 'a list list -> 'a list
+
+(* pid + its neighbors in input *)
+val locally_central: ('v * 'v list) list list -> 'v list
diff --git a/tools/rdbg4sasa/gtkgui.ml b/tools/rdbg4sasa/gtkgui.ml
index 91fac17..dfeee2b 100644
--- a/tools/rdbg4sasa/gtkgui.ml
+++ b/tools/rdbg4sasa/gtkgui.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/05/2021 (at 16:20) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/05/2021 (at 17:08) by Erwan Jahier> *)
 
 #thread
 #require "lablgtk3"
@@ -326,7 +326,7 @@ let custom_daemon p gtext vbox step_button round_button =
   let step () =
     let nodes_enabled = rdbg_nodes_enabled !e in
     let nodes = List.filter (fun (_,b) -> b) nodes_enabled in
-    let nodes = get_higher_prioriry nodes_enabled in
+    let nodes = get_higher_prioriry nodes in
     match !daemon_kind with
     | Distributed -> 
       let nodes = List.map (fun x -> [x]) nodes in
@@ -334,8 +334,7 @@ let custom_daemon p gtext vbox step_button round_button =
       Hashtbl.clear daemongui_activate;
       List.iter (fun n ->  Hashtbl.replace daemongui_activate n true) to_activate;
       sd ();
-
-      p  ("Distributed step : " ^  (String.concat "," to_activate))
+      p ("Distributed step : " ^  (String.concat "," to_activate))
     | Synchronous -> (
         Hashtbl.clear daemongui_activate;
         List.iter (fun n -> Hashtbl.replace daemongui_activate n true) nodes;
@@ -350,8 +349,20 @@ let custom_daemon p gtext vbox step_button round_button =
       sd ();
       p  ("Central step : " ^  (String.concat "," to_activate))
 
-    | LocCentral -> 
-      p  "finish me"
+    | LocCentral ->
+      let get_neigbors x =
+        let succ = snd (List.split (topology.succ x)) in
+        let pred = topology.pred x in
+        let res = List.fold_left (fun acc x -> if List.mem x acc then acc else x::acc) succ pred in
+        (* p (Printf.sprintf "voisins(%s)=%s\n" x (String.concat "," res)); *)
+        res
+      in
+      let nodes = List.map (fun x -> [x, get_neigbors x]) nodes in
+      let to_activate = Daemon.locally_central nodes in
+      Hashtbl.clear daemongui_activate;
+      List.iter (fun n ->  Hashtbl.replace daemongui_activate n true) to_activate;
+      sd ();
+      p  "Locally central step: finish me"
 
     | ManualCentral -> () (* SNO *)
     | Manual -> sd ()
@@ -612,7 +623,6 @@ let gui = main
 - couper les grosses fonctions en morceaux
 - cacher les messages issus du #use
 - lire les commandes dans text_in (comment ? c'est rdbgtop qui lance gtk maintenant...)
-- faire les modes automatiques
 - reglage de la taille des boites 
 - utiliser les GEdit.spin_button ?
     cf lablgtk/examples/spin.ml
-- 
GitLab


From c498c9532060b1584c7582af61721a180ece2d76 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Fri, 7 May 2021 17:22:41 +0200
Subject: [PATCH 25/27] Refactoring

---
 tools/rdbg4sasa/gtkgui.ml | 43 +++++++++++----------------------------
 1 file changed, 12 insertions(+), 31 deletions(-)

diff --git a/tools/rdbg4sasa/gtkgui.ml b/tools/rdbg4sasa/gtkgui.ml
index dfeee2b..6abbd6f 100644
--- a/tools/rdbg4sasa/gtkgui.ml
+++ b/tools/rdbg4sasa/gtkgui.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/05/2021 (at 17:08) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/05/2021 (at 17:21) by Erwan Jahier> *)
 
 #thread
 #require "lablgtk3"
@@ -100,9 +100,6 @@ let custom_daemon p gtext vbox step_button round_button =
   let dk_sd = make_but  (!daemon_kind=Synchronous) "Synchronous" in
   let dk_manual = make_but (!daemon_kind=Manual) "Manual" in
   let dk_manual_central = make_but (!daemon_kind=ManualCentral) "Manual Central" in
-  (*   let _scrolled = GBin.scrolled_window ~border_width:10 *)
-  (*       ~shadow_type:`OUT ~height:150 ~packing:vbox#add () *)
-  (*   in *)
   dk_dd#misc#set_tooltip_text (Printf.sprintf "Set the automatic distributed mode");
   dk_sd#misc#set_tooltip_text (Printf.sprintf "Set the automatic synchronous mode");
   dk_cd#misc#set_tooltip_text (Printf.sprintf "Set the automatic central mode");
@@ -244,43 +241,30 @@ let custom_daemon p gtext vbox step_button round_button =
     )
     nodes_enabled;
 
+  let hide b = b#misc#hide() in
+  let show b = b#misc#show() in
   let update_checkbox node enabled =
     match !daemon_kind with
     | Manual ->
-      step_button#misc#show();
-      round_button#misc#hide();
-
-      checkbox_grid#misc#show();
-      pushbox_grid#misc#hide();
-      counter_grid#misc#hide();
+      show step_button;  show checkbox_grid;
+      hide round_button; hide pushbox_grid;   hide counter_grid;
       let checkbox = Hashtbl.find checkbox_map node in
       if enabled then
-        checkbox#misc#show ()
+        show checkbox
       else (
         checkbox#set_active false; (* on decoche *)
-        checkbox#misc#hide ()
+        hide checkbox
       );
       checkbox#set_sensitive enabled
     | ManualCentral ->
-      step_button#misc#hide();
-      round_button#misc#hide();
-
-      checkbox_grid#misc#hide();
-      pushbox_grid#misc#show();
-      counter_grid#misc#hide();
+      hide step_button; hide round_button; hide checkbox_grid; hide counter_grid;
+      show pushbox_grid;
       let pushbox = Hashtbl.find pushbox_map node in
-      if enabled then
-        pushbox#misc#show ()
-      else
-        pushbox#misc#hide ();
+      if enabled then show pushbox else hide pushbox;
       pushbox#set_sensitive enabled
     | Distributed | Synchronous | Central | LocCentral ->
-      step_button#misc#show();
-      round_button#misc#show();
-
-      checkbox_grid#misc#hide();
-      pushbox_grid#misc#hide();
-      counter_grid#misc#show()
+      show step_button; show round_button; show counter_grid;
+      hide checkbox_grid; hide pushbox_grid;
   in
   let update_all_checkboxes () =
     let nodes_enabled = rdbg_nodes_enabled !e in
@@ -612,9 +596,6 @@ let main () =
         Main.quit () (* terminate gtk *)
     ));
 
-  (* Affichage d'informations *)
-  (*     let gtext_content = ref "" in *)
-
   refresh ()
 
 let gui = main 
-- 
GitLab


From b7da290bd39728e127b8fb5498685596e0dfe5bb Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Fri, 7 May 2021 19:22:47 +0200
Subject: [PATCH 26/27] Refactoring

---
 tools/rdbg4sasa/gtkgui.ml | 71 ++++++++++++++++++++-------------------
 1 file changed, 36 insertions(+), 35 deletions(-)

diff --git a/tools/rdbg4sasa/gtkgui.ml b/tools/rdbg4sasa/gtkgui.ml
index 6abbd6f..3b9f5a0 100644
--- a/tools/rdbg4sasa/gtkgui.ml
+++ b/tools/rdbg4sasa/gtkgui.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/05/2021 (at 17:21) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/05/2021 (at 17:28) by Erwan Jahier> *)
 
 #thread
 #require "lablgtk3"
@@ -84,6 +84,8 @@ let init_rdbg_hook () =
   in
   rdbg_mv_hook := Some guidaemon
 
+let set_tooltip b = b#misc#set_tooltip_text 
+
 let custom_daemon p gtext vbox step_button round_button =
   (* création du rdbg_mv_hook et de tout ce qu'il faut autour *)
   init_rdbg_hook ();
@@ -100,12 +102,12 @@ let custom_daemon p gtext vbox step_button round_button =
   let dk_sd = make_but  (!daemon_kind=Synchronous) "Synchronous" in
   let dk_manual = make_but (!daemon_kind=Manual) "Manual" in
   let dk_manual_central = make_but (!daemon_kind=ManualCentral) "Manual Central" in
-  dk_dd#misc#set_tooltip_text (Printf.sprintf "Set the automatic distributed mode");
-  dk_sd#misc#set_tooltip_text (Printf.sprintf "Set the automatic synchronous mode");
-  dk_cd#misc#set_tooltip_text (Printf.sprintf "Set the automatic central mode");
-  dk_lcd#misc#set_tooltip_text (Printf.sprintf "Set the automatic locally central mode");
-  dk_manual#misc#set_tooltip_text (Printf.sprintf "Set the manual mode");
-  dk_manual_central#misc#set_tooltip_text (Printf.sprintf "Set the manual central mode");
+  set_tooltip dk_dd (Printf.sprintf "Set the automatic distributed mode");
+  set_tooltip dk_sd (Printf.sprintf "Set the automatic synchronous mode");
+  set_tooltip dk_cd (Printf.sprintf "Set the automatic central mode");
+  set_tooltip dk_lcd (Printf.sprintf "Set the automatic locally central mode");
+  set_tooltip dk_manual (Printf.sprintf "Set the manual mode");
+  set_tooltip dk_manual_central (Printf.sprintf "Set the manual central mode");
 
   let nodes_enabled = rdbg_nodes_enabled !e in
 
@@ -158,7 +160,7 @@ let custom_daemon p gtext vbox step_button round_button =
       (* cf. classe toggle_button de lablgtk3 *)
       let checkbox = GButton.check_button ~label:name ~packing:!checkbox_line_ref#add () in
       (* Quand on coche/décoche, met à jour le rdbg_mv_hook *)
-      checkbox#misc#set_tooltip_text (Printf.sprintf "check to activate %s at the next step" name);
+      set_tooltip checkbox (Printf.sprintf "check to activate %s at the next step" name);
       ignore(checkbox#connect#toggled
                ~callback: (fun () -> update_rdbg_hook name checkbox#active));
       checkbox#set_sensitive enabled; (* désactive la box si le noeud n'est pas activable *)
@@ -188,7 +190,7 @@ let custom_daemon p gtext vbox step_button round_button =
       );
       (* cf. classe toggle_button de lablgtk3 *)
       let pushbox = GButton.button ~label:name ~packing:!pushbox_line_ref#add () in
-      pushbox#misc#set_tooltip_text (Printf.sprintf "Press to activate %s" name);
+      set_tooltip pushbox (Printf.sprintf "Press to activate %s" name);
       (* Quand on appuie, met à jour le rdbg_mv_hook *)
       ignore(pushbox#event#connect#button_press
                ~callback: (fun _ ->
@@ -236,7 +238,7 @@ let custom_daemon p gtext vbox step_button round_button =
       ignore (adj#connect#value_changed ~callback:(fun () -> counter#set (truncate adj#value)));
       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);
+      set_tooltip counter_container (Printf.sprintf "Set the priority of %s" name);
       Hashtbl.add counter_map name counter
     )
     nodes_enabled;
@@ -382,7 +384,7 @@ let main () =
   let sw2 = GBin.scrolled_window ~border_width:10 ~shadow_type:`OUT ~height:250
       ~packing:box#add ()
   in
-  sw2#misc#set_tooltip_text "This window displays commands outputs";
+  set_tooltip sw2 "This window displays commands outputs";
   let text_out = GText.view ~wrap_mode:`CHAR ~height:250 ~editable:false 
       ~packing: sw2#add () ~cursor_visible:true 
   in 
@@ -438,7 +440,7 @@ let main () =
   in
 
   let back_step_button = button ~use_mnemonic:true ~stock:`GO_BACK ~packing:bbox#add () in
-  back_step_button#misc#set_tooltip_text "Move BACKWARD to the previous STEP";
+  set_tooltip back_step_button "Move BACKWARD to the previous STEP";
   change_label back_step_button "Ste_p";
   ignore (back_step_button#connect#clicked ~callback:(button_cb bd));
 
@@ -460,19 +462,19 @@ let main () =
     d()
   in
 
-  step_button#misc#set_tooltip_text "Move FORWARD to the next STEP";
+  set_tooltip step_button "Move FORWARD to the next STEP";
   change_label step_button "_Step";
   ignore (step_button#connect#clicked ~callback:(button_cb step));
-  round_button#misc#set_tooltip_text "Move FORWARD to the next ROUND";
+  set_tooltip round_button "Move FORWARD to the next ROUND";
   change_label round_button "_Round";
   ignore (round_button#connect#clicked ~callback:(button_cb nr));
-  back_round_button#misc#set_tooltip_text "Move BACKWARD to the previous ROUND";
+  set_tooltip back_round_button "Move BACKWARD to the previous ROUND";
   change_label back_round_button "Roun_d";
   ignore (back_round_button#connect#clicked ~callback:(button_cb pr));
 
   let legitimate () = 
     let legitimate_button = button ~use_mnemonic:true ~packing:bbox#add () in
-    legitimate_button#misc#set_tooltip_text
+    set_tooltip legitimate_button
       "Move FORWARD until a legitimate configuration is reached (silence by default)";
     let image = GMisc.image ~file:(libui_prefix^"/chut_small.svg") () in
     legitimate_button#set_image image#coerce; 
@@ -484,8 +486,7 @@ let main () =
 
   let graph () = 
     let graph_button = button  ~use_mnemonic:true  ~packing:bbox#add () in
-    graph_button#misc#set_tooltip_text
-      "Visualize the Topology states: Green=Enabled ; Gold=Active";
+    set_tooltip graph_button "Visualize the Topology states: Green=Enabled ; Gold=Active";
     let image = GMisc.image ~file:(libui_prefix^"/graph_small.png") () in
     graph_button#set_image image#coerce; 
     ignore (graph_button#connect#clicked ~callback:(button_cb graph_view));
@@ -495,7 +496,7 @@ let main () =
 
   let make_button stock lbl msg cmd =
     let butt = button ~use_mnemonic:true ~stock:stock ~packing:bbox#add ~label:lbl () in
-    butt#misc#set_tooltip_text msg;
+    set_tooltip butt msg;
     change_label butt lbl;
     ignore (butt#connect#clicked ~callback:cmd);
     butt
@@ -555,14 +556,14 @@ let main () =
     let par_ci_button = make_but "circo*" in
     let par_pa_button = make_but "patchwork*" in
     let par_os_button = make_but "osage*" in
-    par_dot_button#misc#set_tooltip_text "Use dot, but show only links to the parent";
-    par_fd_button#misc#set_tooltip_text  "Use fdp, but show only links to the parent";
-    par_sf_button#misc#set_tooltip_text  "Use sfdp, but show only links to the parent";
-    par_ne_button#misc#set_tooltip_text  "Use neato, but show only links to the parent";
-    par_tw_button#misc#set_tooltip_text  "Use twopi, but show only links to the parent";
-    par_ci_button#misc#set_tooltip_text  "Use circo, but show only links to the parent";
-    par_pa_button#misc#set_tooltip_text  "Use patchwork, but show only links to the parent";
-    par_os_button#misc#set_tooltip_text  "Use osage, but show only links to the parent";
+    set_tooltip par_dot_button "Use dot, but show only links to the parent";
+    set_tooltip par_fd_button  "Use fdp, but show only links to the parent";
+    set_tooltip par_sf_button  "Use sfdp, but show only links to the parent";
+    set_tooltip par_ne_button  "Use neato, but show only links to the parent";
+    set_tooltip par_tw_button  "Use twopi, but show only links to the parent";
+    set_tooltip par_ci_button  "Use circo, but show only links to the parent";
+    set_tooltip par_pa_button  "Use patchwork, but show only links to the parent";
+    set_tooltip par_os_button  "Use osage, but show only links to the parent";
     connect par_dot_button "d_par" d_par;
     connect par_fd_button "fd_par" fd_par;
     connect par_sf_button "sf_par" sf_par;
@@ -572,14 +573,14 @@ let main () =
     connect par_pa_button "pa_par" pa_par;
     connect par_os_button "os_par" os_par;
   );
-  dot_button#misc#set_tooltip_text "Use the dot engine to display the graph";
-  fd_button#misc#set_tooltip_text "Use the fdp engine to display the graph";
-  sf_button#misc#set_tooltip_text "Use the sfdp engine to display the graph";
-  ne_button#misc#set_tooltip_text "Use the neato engine to display the graph";
-  tw_button#misc#set_tooltip_text "Use the twopi engine to display the graph";
-  ci_button#misc#set_tooltip_text "Use the circo engine to display the graph";
-  pa_button#misc#set_tooltip_text "Use the patchwork engine to display the graph";
-  os_button#misc#set_tooltip_text "Use the osage engine to display the graph";
+  set_tooltip dot_button "Use the dot engine to display the graph";
+  set_tooltip fd_button "Use the fdp engine to display the graph";
+  set_tooltip sf_button "Use the sfdp engine to display the graph";
+  set_tooltip ne_button "Use the neato engine to display the graph";
+  set_tooltip tw_button "Use the twopi engine to display the graph";
+  set_tooltip ci_button "Use the circo engine to display the graph";
+  set_tooltip pa_button "Use the patchwork engine to display the graph";
+  set_tooltip os_button "Use the osage engine to display the graph";
 
   connect dot_button "d" dot;
   connect fd_button "fd" fd;
-- 
GitLab


From 3e2fb3229611161899d226597087b42a8b0ba74c Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Fri, 7 May 2021 19:23:09 +0200
Subject: [PATCH 27/27] Chore

---
 sasa.opam              | 2 +-
 tools/rdbgui4sasa/dune | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/sasa.opam b/sasa.opam
index 9111226..c08c14d 100644
--- a/sasa.opam
+++ b/sasa.opam
@@ -23,7 +23,7 @@ depends: [
   "dune" { >= "1.11" }
   "ocamlgraph"
   "lutils"
-  "rdbg" { >= "1.184" }
+  "rdbg" { >= "1.190" }
 ]
 depopts: [
   "lustre-v6"
diff --git a/tools/rdbgui4sasa/dune b/tools/rdbgui4sasa/dune
index 4373acc..add52da 100644
--- a/tools/rdbgui4sasa/dune
+++ b/tools/rdbgui4sasa/dune
@@ -13,7 +13,7 @@
  )
 )
 (install
- (files chut_small.svg graph_small.png gui2use.ml)
+ (files chut_small.svg graph_small.png rdbgui.ml)
  (section lib)
  (package rdbgui4sasa)
 )
-- 
GitLab