Implement the automatic Central daemon

lib/sasacore/daemon.mli

-(* 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

tools/rdbg4sasa/gtkgui.ml

-(* 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