Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
verimag
synchrone
sasa
Commits
ef5219ea
Commit
ef5219ea
authored
Jun 25, 2021
by
erwan
Browse files
Fix: make the behavior of rdbgui4sasa more sensible
parent
cc029128
Changes
2
Hide whitespace changes
Inline
Side-by-side
tools/rdbg4sasa/gtkgui.ml
View file @
ef5219ea
(* Time-stamp: <modified the
15
/06/2021 (at 0
9
:2
1
) by Erwan Jahier> *)
(* Time-stamp: <modified the
28
/06/2021 (at
1
0:2
4
) 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
;
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment