Skip to content

GitLab

Commit ef5219ea authored by erwan's avatar erwan
Browse files

Fix: make the behavior of rdbgui4sasa more sensible

parent cc029128
Hide whitespace changes
Inline Side-by-side
tools/rdbg4sasa/gtkgui.ml
View file @ ef5219ea
(* Time-stamp: <modified the 15/06/2021 (at 09:21) by Erwan Jahier> *)
(* Time-stamp: <modified the 28/06/2021 (at 10:24) by Erwan Jahier> *)
#thread
#require "lablgtk3"
......@@ -193,21 +193,23 @@ let init_rdbg_hook () =
let set_tooltip b = b#misc#set_tooltip_text
let start () =
(* création du rdbg_mv_hook et de tout ce qu'il faut autour *)
if !custom_mode_ref then init_rdbg_hook ();
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 *)
e:=next_cond_gen !e (fun e -> e.name="mv_hook" && e.kind=Exit) (fun e -> e.next());
if !custom_mode_ref then
e:=next_cond_gen !e (fun e -> e.name="mv_hook" && e.kind=Call) (fun e -> e.next());
e:=next_cond_gen !e (fun e -> e.name="mv_hook" && e.kind=Call) (fun e -> e.next())
else
(* internal daemon mode *)
e:=next_cond_gen !e (fun e -> e.kind=Ltop) (fun e -> e.next());
redos := [!e.nb];
ckpt_list := [!e];
round_reset !e.nb;
!e.save_state !e.nb
let restart p _ =
Seed.replay_seed := true;
let seed = Seed.get dotfile in
Seed.set seed;
p (Printf.sprintf "Restarting using the seed %d" seed);
......@@ -239,8 +241,6 @@ let custom_daemon p gtext vbox step_button back_step_button round_button
set_tooltip dk_manual (Printf.sprintf "Set the manual mode");
set_tooltip dk_manual_central (Printf.sprintf "Set the manual central mode");
start ();
blue_add gtext#buffer (str_of_sasa_event false !e);
d();
let nodes_enabled = rdbg_nodes_enabled !e in
......@@ -407,7 +407,7 @@ let custom_daemon p gtext vbox step_button back_step_button round_button
hide undo_button;
hide legitimate_button;
(match !oracle_button_ref with Some b -> hide b | None -> ());
(* hide back_step_button; *)
hide back_step_button; (* requires to store all the inputs from the last ckpt! *)
hide step_button;
hide round_button; hide checkbox_grid; hide counter_grid;
show pushbox_grid;
......@@ -420,7 +420,8 @@ let custom_daemon p gtext vbox step_button back_step_button round_button
else hide undo_button;
(match !oracle_button_ref with Some b -> show b | None -> ());
show back_step_button; show step_button; show round_button;
show counter_grid; show legitimate_button;
show counter_grid;
if not args.salut_mode then show legitimate_button; (* for the time being *)
hide checkbox_grid; hide pushbox_grid;
in
let update_all_checkboxes () =
......@@ -564,6 +565,7 @@ let main () =
in
let p str = black text_out#buffer str in
(* It should be better to rely on the gtk event handler *)
restart p ();
let bbox = GPack.hbox ~packing: box#add () in
......@@ -598,7 +600,7 @@ let main () =
let step_button = button ~use_mnemonic:true ~packing:bbox#add ~stock:`GO_FORWARD () in
let back_round_button =
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 =
button ~use_mnemonic:true ~stock:`MEDIA_FORWARD ~packing:bbox#add ~label:"round" ()
......@@ -619,6 +621,7 @@ let main () =
let undo_button = make_button `UNDO "_Undo" "Undo the last move"
(button_cb true false (fun ()->u();d()))
in
let set_daemongui_tbl =
if !custom_mode_ref then
custom_daemon p text_out w step_button back_step_button round_button
......@@ -634,11 +637,7 @@ let main () =
set_daemongui_tbl e;
let e = goto_hook_exit e in
let e = goto_hook_call e in
if not args.salut_mode && is_silent ~dflt:false e then
(* go to Ltop so that the round number can be updated *)
next_cond e (fun e -> e.kind = Ltop)
else
e
e
)
else
let e = sasa_step e in
......@@ -647,7 +646,12 @@ let main () =
e
in
let rec next_round_gui_loop rn =
if is_silent !e then () else e:=a_gui_step !e;
if is_silent !e then (
if not args.salut_mode && !e.kind <> Ltop then
(* go to Ltop so that the round number can be updated *)
e := next_cond !e (fun e -> e.kind = Ltop);
)
else e:=a_gui_step !e;
if rn < !round_st_ref.cpt || is_silent !e then () else (next_round_gui_loop rn);
in
let next_round_gui () =
......@@ -659,7 +663,7 @@ let main () =
then
e:= goto_hook_call !e
)
else (
else ( (* internal daemon mode *)
e := next_round !e
);
store !e.nb
......@@ -673,15 +677,21 @@ let main () =
if args.salut_mode then
let lnext e =
set_daemongui_tbl e;
let e = goto_top e in
let e = goto_hook_call e in
e
in
let ne = rev_cond_gen !e
(fun ne -> ne.step = !e.step-1 && ne.kind = Ltop)
lnext restore_round_nb
let ne =
rev_cond_gen !e
(fun ne ->
if ne.step = !e.step-1 && ne.kind = !e.kind then true else (
Printf.printf "%d: ne.step=%d (!e.step-1)=%d\n%!" ne.nb ne.step (!e.step-1);
false
)
)
lnext restore_round_nb
in
e:=ne
else
else (* custom sasa mode *)
let lnext e =
set_daemongui_tbl e;
if e.kind = Ltop then
......@@ -732,15 +742,25 @@ let main () =
ignore (back_step_button#connect#clicked
~callback:(button_cb true false back_step_gui));
let step () = if not (is_silent !e) then (e := a_gui_step !e; d()) in
let step () =
if not (is_silent !e) || (not args.salut_mode && !e.kind <> Ltop) then (
e := a_gui_step !e;
d()
)
in
let rec legitimate_gui () =
if is_silent !e then () else e := a_gui_step !e;
if is_legitimate !e || is_silent !e then () else (legitimate_gui ());
if is_legitimate !e || is_silent !e then (
if not args.salut_mode && !e.kind <> Ltop then
e := next_cond !e (fun e -> e.kind = Ltop);
)
else (legitimate_gui ());
in
(* change_label legitimate_button "Silen_t"; *)
ignore (legitimate_button#connect#clicked ~callback:
(button_cb true true (fun () ->
if !custom_mode_ref then legitimate_gui() else legitimate ())
if !custom_mode_ref then legitimate_gui() else
e:= next_cond !e (fun le -> is_legitimate le && le.kind=Ltop))
)
);
if !custom_mode_ref then legitimate_button#misc#hide();
......@@ -785,12 +805,17 @@ let main () =
let _ = make_button `REFRESH "_New Seed" "Restart from the beginning using a New Seed"
(button_cb true true
(fun ()->
Seed.reset();
Seed.replay_seed := false;
Seed.reset(); Seed.replay_seed := false;
let seed = Seed.get dotfile in
Seed.set (seed);
p (Printf.sprintf "Restarting using the seed %d" seed);
r();
!e.RdbgEvent.reset();
e:=RdbgStdLib.run ~call_hooks:true ();
round_reset !e.nb;
redos := [1];
ckpt_list := [!e];
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
......
tools/rdbg4sasa/sasa-rdbg-cmds.ml
View file @ ef5219ea
......@@ -236,6 +236,9 @@ let pr () =
(* won't work in semi-auto modes, but the buttons are hided *)
let u () = undo (); ignore (round !e);;
let r () =
let seed = Seed.get dotfile in
Seed.set seed;
Printf.sprintf "Restarting using the seed %d" seed;
!e.RdbgEvent.reset();
e:=RdbgStdLib.run ~call_hooks:true ();
round_reset !e.nb;
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment