Skip to content
Snippets Groups Projects
Commit 1db6a5ac authored by erwan's avatar erwan
Browse files

fix: rdbgui4sasa in salut mode

parent 8cf702ba
No related branches found
No related tags found
No related merge requests found
(* Time-stamp: <modified the 15/06/2022 (at 11:50) by Erwan Jahier> *) (* Time-stamp: <modified the 21/06/2022 (at 17:50) by Erwan Jahier> *)
#thread #thread
#require "lablgtk3" #require "lablgtk3"
...@@ -62,7 +62,8 @@ let refresh () = ...@@ -62,7 +62,8 @@ let refresh () =
Hashtbl.iter (fun str f -> f()) refresh_fun_tbl Hashtbl.iter (fun str f -> f()) refresh_fun_tbl
(** Met en place le hook *) (** Met en place le hook *)
let daemongui_activate = Hashtbl.create 1 let daemongui_activate : (string, bool) Hashtbl.t = Hashtbl.create 1
(* states whether a node should be activated *)
let (fake_val_of_type : Data.t -> Data.v) = function let (fake_val_of_type : Data.t -> Data.v) = function
| Bool -> B false | Bool -> B false
...@@ -143,8 +144,9 @@ let goto_top e = ...@@ -143,8 +144,9 @@ let goto_top e =
let init_rdbg_hook () = let init_rdbg_hook () =
let guidaemon sl = let guidaemon sl =
if sl = [] then if sl = [] then
(* when called first (salut), its activation output will be (* when called first (salut), its activation output will be
ignored, so we can give fake values for Enab ans state values *) ignored; nevertheless, we need to provide give fake values
for Enab and state values that will be ignored *)
let res = List.map (fun (n,t) -> let res = List.map (fun (n,t) ->
let v = fake_val_of_type t in let v = fake_val_of_type t in
(* Printf.printf "tossing a value for %s -> %s \n%!" n *) (* Printf.printf "tossing a value for %s -> %s \n%!" n *)
...@@ -254,7 +256,7 @@ let custom_daemon p gtext vbox step_button back_step_button round_button ...@@ -254,7 +256,7 @@ let custom_daemon p gtext vbox step_button back_step_button round_button
node (str_of_sasa_event false !e) in node (str_of_sasa_event false !e) in
(* gtext#buffer#set_text txt; *) (* gtext#buffer#set_text txt; *)
blue gtext#buffer txt; blue gtext#buffer txt;
Hashtbl.filter_map_inplace (fun n status -> Some (n = node)) daemongui_activate; Hashtbl.filter_map_inplace (fun n _prev_status -> Some (n = node)) daemongui_activate;
) )
| Manual -> | Manual ->
let txt = Printf.sprintf "Manual step: \n\n%s" (str_of_sasa_event false !e) in let txt = Printf.sprintf "Manual step: \n\n%s" (str_of_sasa_event false !e) in
...@@ -647,13 +649,13 @@ let main () = ...@@ -647,13 +649,13 @@ let main () =
e e
in in
let rec next_round_gui_loop rn = let rec next_round_gui_loop rn =
if is_silent !e then ( if is_silent ~dflt:false !e then (
if not args.salut_mode && !e.kind <> Ltop then if not args.salut_mode && !e.kind <> Ltop then
(* go to Ltop so that the round number can be updated *) (* go to Ltop so that the round number can be updated *)
e := next_cond !e (fun e -> e.kind = Ltop); e := next_cond !e (fun e -> e.kind = Ltop);
) )
else e:=a_gui_step !e; else e:=a_gui_step !e;
if (get_round !e) || is_silent !e then () else (next_round_gui_loop rn); if (get_round !e) || is_silent ~dflt:false !e then () else (next_round_gui_loop rn);
in in
let next_round_gui () = let next_round_gui () =
if !custom_mode_ref then ( if !custom_mode_ref then (
...@@ -739,14 +741,15 @@ let main () = ...@@ -739,14 +741,15 @@ let main () =
~callback:(button_cb true false back_step_gui)); ~callback:(button_cb true false back_step_gui));
let step () = let step () =
if not (is_silent !e) || (not args.salut_mode && !e.kind <> Ltop) then ( if not (is_silent ~dflt:false !e) || (not args.salut_mode && !e.kind <> Ltop) then (
Printf.printf "a_gui_step is called \n%!";
e := a_gui_step !e; e := a_gui_step !e;
d() d()
) )
in in
let rec legitimate_gui () = let rec legitimate_gui () =
if is_silent !e then () else e := a_gui_step !e; if is_silent ~dflt:false !e then () else e := a_gui_step !e;
if is_legitimate !e || is_silent !e then ( if is_legitimate !e || is_silent ~dflt:false !e then (
if not args.salut_mode && !e.kind <> Ltop then if not args.salut_mode && !e.kind <> Ltop then
e := next_cond !e (fun e -> e.kind = Ltop); e := next_cond !e (fun e -> e.kind = Ltop);
) )
......
...@@ -48,7 +48,7 @@ let enabled pl = (* returns the enabled processes *) ...@@ -48,7 +48,7 @@ let enabled pl = (* returns the enabled processes *)
(* called at each event via the time-travel hook *) (* called at each event via the time-travel hook *)
let (round : RdbgEvent.t -> bool) = let (round : RdbgEvent.t -> bool) =
fun e -> fun e ->
if e.kind=Exit && e.name = "sasa" then get_round e || is_legitimate e else false if e.kind=Exit && e.name = "sasa" then get_round e (* || is_legitimate e *) else false
let sasa_next e = let sasa_next e =
let ne = e.next () in let ne = e.next () in
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment