Fix: in rdbg4sasa, round buttons and legitimate button now work

lib/sasacore/daemon.ml

-(* Time-stamp: <modified the 07/05/2021 (at 16:43) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/05/2021 (at 09:06) by Erwan Jahier> *)
 
 type t =
   | Synchronous (* select all actions *) 
@@ -147,7 +147,7 @@ let (f: bool -> bool -> t -> 'v Process.t list ->
      bool list list * 'v pna list) =
   fun dummy_input verbose_mode daemon pl neigbors_of_pid e all enab get_action_value ->
   let nall = remove_empty_list all in
-  if nall = [] then assert false (* failwith "Silent" *);
+  if nall = [] then failwith "Silent";
   if daemon <> Custom && dummy_input then
     ignore (RifRead.bool verbose_mode ((List.hd pl).pid) "");
   match daemon with

tools/rdbg4sasa/gtkgui.ml

-(* Time-stamp: <modified the 27/05/2021 (at 17:23) by Erwan Jahier> *)
+(* Time-stamp: <modified the 28/05/2021 (at 09:16) by Erwan Jahier> *)
 
 #thread
 #require "lablgtk3"
@@ -54,12 +54,6 @@ let rdbg_nodes_enabled e =
     in
     last::res
 
-(* The interesting event to start in not the first event *)
-let set_first_check_point e =
-  e.save_state e.nb;
-  RdbgStdLib.ckpt_list := [e]
-
-
 type daemon_kind = Distributed | Synchronous | Central | LocCentral | ManualCentral | Manual 
 let daemon_kind = ref ManualCentral
 
@@ -208,7 +202,6 @@ let custom_daemon p gtext vbox step_button round_button legitimate_button =
   if args.salut_mode then goto_hook_exit ();
   goto_hook_call ();
   blue_add gtext#buffer (str_of_sasa_event false !e);
-  set_first_check_point !e;
   d();
   let nodes_enabled = rdbg_nodes_enabled !e in
 
@@ -561,21 +554,12 @@ let main () =
   in
   let round_button =
     button  ~use_mnemonic:true ~stock:`MEDIA_FORWARD ~packing:bbox#add ~label:"round" ()
-  in 
-  let legitimate () = 
-    let legitimate_button = button ~use_mnemonic:true ~packing:bbox#add () in
-    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; 
-    (*     change_label legitimate_button "Silen_t"; *)
-    ignore (legitimate_button#connect#clicked ~callback:
-              (button_cb true (fun () -> legitimate(); goto_hook_call ())));
-    legitimate_button#misc#hide(); (* indeed, in the defaut mode (manual central),
-                                      it should be hided *)
-    legitimate_button
-  in
-  let legitimate_button = legitimate () in
+  in
+  let legitimate_button = button ~use_mnemonic:true ~packing:bbox#add () in
+  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; 
   
   let ze_step =
     if custom_mode then
@@ -587,8 +571,20 @@ let main () =
     ze_step();
     d()
   in
+  let rec legitimate_gui () =
+    ze_step();
+    if is_legitimate !e || is_silent !e then () else (legitimate_gui ())
+  in
+  (* change_label legitimate_button "Silen_t"; *)
+  ignore (legitimate_button#connect#clicked ~callback:
+            (button_cb true (fun () ->
+                 if custom_mode then legitimate_gui() else legitimate ())
+            )
+    );
+  legitimate_button#misc#hide(); (* indeed, in the defaut mode (manual central),
+                                     it should be hided *)
   let rec next_round_gui rn =
-    ze_step(); (* il faut un step qui mette à jour la table des rondes. c'est pas le cas ? *)
+    ze_step();
     if rn < !roundnb  || is_silent !e then () else (next_round_gui rn)
   in
 
@@ -600,9 +596,14 @@ let main () =
   ignore (round_button#connect#clicked
             ~callback:(
               button_cb true (fun () ->
-                  next_round_gui !roundnb; 
-                  if custom_mode && !e.name <> "mv_hook" && !e.kind <> Call then
-                    goto_hook_call ()))
+                  if custom_mode then (
+                    next_round_gui !roundnb;
+                    if custom_mode && !e.name <> "mv_hook" && !e.kind <> Call then
+                      goto_hook_call ()
+                  )
+                  else
+                    nr ()
+            ))
     );
   set_tooltip back_round_button "Move BACKWARD to the previous ROUND";
   change_label back_round_button "Roun_d";
@@ -628,11 +629,10 @@ let main () =
     butt
   in
   if args.oracles <> [] then (
-    let oracle_button = 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
-                 (fun () -> let str = viol_string () in goto_hook_call (); d();str))
+    let oracle_button =
+      make_button `OK "_Oracle" "Move FORWARD until an oracle is violated"
+        (button_cb_string
+           (fun () -> let str = viol_string () in goto_hook_call (); d();str))
     in
     oracle_button#misc#hide(); (* indeed, in the defaut mode (manual central), it should be hided *)
     oracle_button_ref := Some oracle_button
@@ -647,11 +647,10 @@ let main () =
                  r();
                  if args.salut_mode then
                    (* in this mode, the hook plays first to provide fake values to sasa
-                 but the hook does not need input at this first step
+                      but the hook does not need input at this first step
                     *)
                    goto_hook_exit ();
                  goto_hook_call ();
-                 set_first_check_point !e;
                  d()))
   in
   let _ = make_button `REFRESH "_New Seed" "Restart from the beginning using a New Seed"
@@ -669,7 +668,6 @@ let main () =
                     *)
                    goto_hook_exit ();
                  goto_hook_call ();
-                 set_first_check_point !e;
                  d()))
   in
   let _ = make_button `MEDIA_PLAY "_Sim2chro" "Launch sim2chro on the generated data (so far)"

tools/rdbg4sasa/sasa-rdbg-cmds.ml

@@ -155,7 +155,12 @@ let pr () =
 (* I need to overrides those *)
 
 let u () = undo (); ignore (round !e);;
-let r () = r (); roundnb := 1; Hashtbl.clear roundtbl;ignore (round !e);;
+let r () =
+  r ();
+  roundnb := 1;
+  Hashtbl.clear roundtbl;
+  ckpt_list := [!e];
+  ignore (round !e);;
 
 (**********************************************************************)
 (* print_event tuning *)
@@ -284,7 +289,7 @@ let _ = add_doc_entry
     "sasa" "sasa-rdbg-cmds.ml";
   add_doc_entry
     "is_silent" "RdbgEvent.t -> bool"
-    "is the event correspond to a silent configuration? (i.e., no enable node)"
+    "does the event correspond to a silent configuration? (i.e., no enable node)"
     "sasa" "sasa-rdbg-cmds.ml";;
 
 let is_legitimate e =
@@ -294,9 +299,14 @@ let is_legitimate e =
 
 let goto_legitimate e = next_cond e is_legitimate 
 let legitimate () =  e:=goto_legitimate !e; !dot_view ();;
-let _ = add_doc_entry
+let _ =
+  add_doc_entry
     "legitimate" "unit -> unit"
     "  Move forward until a legitimate configuration is reached (uses 'silence' by default)"
+    "sasa" "sasa-rdbg-cmds.ml";
+  add_doc_entry
+    "is_legitimate" "RdbgEvent.t -> bool"
+    "does the event correspond to a legitimate configuration?"
     "sasa" "sasa-rdbg-cmds.ml";;