diff --git a/lib/sasacore/daemon.mli b/lib/sasacore/daemon.mli index 1c5d94fbb5b2028049fe576154f6418c87709c24..ae3471ab18320c599d14ea4a745bbc2c0ed28e19 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 3f15caafb447cdc2537bdb49c1b5fa68da6bce0a..826dd061d696782f943b579d5c26a232376b9ab3 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