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
6b9a3b9c
Commit
6b9a3b9c
authored
May 28, 2021
by
erwan
Browse files
Fix: make the rdbgui4sasa undo button work
parent
5995fdfc
Changes
1
Hide whitespace changes
Inline
Side-by-side
tools/rdbg4sasa/gtkgui.ml
View file @
6b9a3b9c
(* Time-stamp: <modified the 28/05/2021 (at 1
0:12
) by Erwan Jahier> *)
(* Time-stamp: <modified the 28/05/2021 (at 1
1:47
) by Erwan Jahier> *)
#
thread
#
require
"lablgtk3"
...
...
@@ -103,7 +103,7 @@ let write_add color b str =
let
blue
=
write
"blue_foreground"
let
black
=
write
"black_foreground"
let
red
=
write
"red_foreground"
let
green
=
write
"green_foreground"
let
green
=
write
"green_foreground"
let
blue_add
=
write_add
"blue_foreground"
let
black_add
=
write_add
"black_foreground"
...
...
@@ -118,8 +118,9 @@ let display_event b =
(* *)
let
goto_hook_call
()
=
if
custom_mode
then
if
custom_mode
then
(
e
:=
next_cond
!
e
(
fun
e
->
e
.
name
=
"mv_hook"
&&
e
.
kind
=
Call
)
)
let
goto_hook_exit
()
=
if
custom_mode
then
...
...
@@ -293,6 +294,7 @@ let custom_daemon p gtext vbox step_button round_button legitimate_button =
goto_hook_exit
()
;
goto_hook_call
()
;
display_event
gtext
;
store
!
e
.
nb
;
refresh
()
;
false
));
Hashtbl
.
add
pushbox_map
name
pushbox
...
...
@@ -476,6 +478,7 @@ let custom_daemon p gtext vbox step_button round_button legitimate_button =
|
Manual
->
goto_hook_exit
()
;
goto_hook_call
()
;
store
!
e
.
nb
;
d
()
in
step
...
...
@@ -525,12 +528,13 @@ let main () =
button
#
set_image
icon
;
refresh
()
in
let
button_cb
display_event_flag
cmd
()
=
let
button_cb
display_event_flag
store_flag
cmd
()
=
blue
text_out
#
buffer
"From "
;
let
txt
=
Printf
.
sprintf
"
\n
%s%!"
(
str_of_sasa_event
false
!
e
)
in
(* text_out#buffer#set_text txt; *)
blue_add
text_out
#
buffer
txt
;
cmd
()
;
if
store_flag
then
store
!
e
.
nb
;
if
display_event_flag
then
display_event
text_out
;
refresh
()
in
...
...
@@ -546,7 +550,7 @@ let main () =
let
back_step_button
=
button
~
use_mnemonic
:
true
~
stock
:
`GO_BACK
~
packing
:
bbox
#
add
()
in
set_tooltip
back_step_button
"Move BACKWARD to the previous STEP"
;
change_label
back_step_button
"Ste_p"
;
ignore
(
back_step_button
#
connect
#
clicked
~
callback
:
(
button_cb
true
bd
));
ignore
(
back_step_button
#
connect
#
clicked
~
callback
:
(
button_cb
true
true
bd
));
let
step_button
=
button
~
use_mnemonic
:
true
~
packing
:
bbox
#
add
~
stock
:
`GO_FORWARD
()
in
let
back_round_button
=
...
...
@@ -577,7 +581,7 @@ let main () =
in
(* change_label legitimate_button "Silen_t"; *)
ignore
(
legitimate_button
#
connect
#
clicked
~
callback
:
(
button_cb
true
(
fun
()
->
(
button_cb
true
true
(
fun
()
->
if
custom_mode
then
legitimate_gui
()
else
legitimate
()
)
)
);
...
...
@@ -590,12 +594,12 @@ let main () =
set_tooltip
step_button
"Move FORWARD to the next STEP"
;
change_label
step_button
"_Step"
;
ignore
(
step_button
#
connect
#
clicked
~
callback
:
(
button_cb
true
step
));
ignore
(
step_button
#
connect
#
clicked
~
callback
:
(
button_cb
true
true
step
));
set_tooltip
round_button
"Move FORWARD to the next ROUND"
;
change_label
round_button
"_Round"
;
ignore
(
round_button
#
connect
#
clicked
~
callback
:
(
button_cb
true
(
fun
()
->
button_cb
true
true
(
fun
()
->
if
custom_mode
then
(
next_round_gui
!
roundnb
;
if
custom_mode
&&
!
e
.
name
<>
"mv_hook"
&&
!
e
.
kind
<>
Call
then
...
...
@@ -608,7 +612,7 @@ let main () =
set_tooltip
back_round_button
"Move BACKWARD to the previous ROUND"
;
change_label
back_round_button
"Roun_d"
;
ignore
(
back_round_button
#
connect
#
clicked
~
callback
:
(
button_cb
true
(
fun
()
->
pr
()
;
pr
()
;
goto_hook_call
()
)));
~
callback
:
(
button_cb
true
true
(
fun
()
->
pr
()
;
pr
()
;
goto_hook_call
()
)));
let
graph
()
=
...
...
@@ -616,7 +620,7 @@ let main () =
set_tooltip
graph_button
"Visualize the Topology states: Green=Enabled ; Gold=Active"
;
let
image
=
GMisc
.
image
~
file
:
(
libui_prefix
^
"/graph_small.png"
)
()
in
graph_button
#
set_image
image
#
coerce
;
ignore
(
graph_button
#
connect
#
clicked
~
callback
:
(
button_cb
false
graph_view
));
ignore
(
graph_button
#
connect
#
clicked
~
callback
:
(
button_cb
false
false
graph_view
));
in
graph
()
;
...
...
@@ -632,14 +636,14 @@ let main () =
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
))
(
fun
()
->
let
str
=
viol_string
()
in
goto_hook_call
()
;
d
()
;
store
!
e
.
nb
;
str
))
in
oracle_button
#
misc
#
hide
()
;
(* indeed, in the defaut mode (manual central), it should be hided *)
oracle_button_ref
:=
Some
oracle_button
);
let
_
=
make_button
`UNDO
"_Undo"
"Undo the last move"
(
button_cb
true
(
fun
()
->
u
()
;
d
()
))
in
let
_
=
make_button
`UNDO
"_Undo"
"Undo the last move"
(
button_cb
true
false
(
fun
()
->
u
()
;
d
()
))
in
let
_
=
make_button
`REFRESH
"Restar_t"
"Restart from the beginning"
(
button_cb
true
(
button_cb
true
true
(
fun
()
->
let
seed
=
Seed
.
get
dotfile
in
Seed
.
set
seed
;
...
...
@@ -654,7 +658,7 @@ let main () =
d
()
))
in
let
_
=
make_button
`REFRESH
"_New Seed"
"Restart from the beginning using a New Seed"
(
button_cb
true
(
button_cb
true
true
(
fun
()
->
Seed
.
reset
()
;
Seed
.
replay_seed
:=
false
;
...
...
@@ -671,10 +675,10 @@ let main () =
d
()
))
in
let
_
=
make_button
`MEDIA_PLAY
"_Sim2chro"
"Launch sim2chro on the generated data (so far)"
(
button_cb
false
sim2chro
)
(
button_cb
false
false
sim2chro
)
in
let
_
=
make_button
`MEDIA_PLAY
"_Gnuplot"
"Launch gnuplot-rif on the generated data (so far)"
(
button_cb
false
gnuplot
)
(
button_cb
false
false
gnuplot
)
in
let
_
=
make_button
`INFO
"_Info"
"Get information about the current session"
(
button_cb_string
info_string
)
...
...
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