Skip to content
Snippets Groups Projects
Commit 510d5c13 authored by erwan's avatar erwan
Browse files

rdbg: add an experimental GUI based on labltgk3

parent 632168ba
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
test/rdbg-utils/chut.svg 0 → 100644
+ 20
− 0
View file @ 510d5c13
<?xml version="1.0" encoding="UTF-8"?>
<!-- Created with Inkscape (http://www.inkscape.org/) -->
<svg id="svg4874" width="96" height="96" version="1.1" viewBox="0 0 96 96" xmlns="http://www.w3.org/2000/svg" xmlns:cc="http://creativecommons.org/ns#" xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#">
<metadata id="metadata4879">
<rdf:RDF>
<cc:Work rdf:about="">
<dc:format>image/svg+xml</dc:format>
<dc:type rdf:resource="http://purl.org/dc/dcmitype/StillImage"/>
<dc:title/>
</cc:Work>
</rdf:RDF>
</metadata>
<g id="layer1" transform="translate(67.857 -78.505)">
<rect id="rect4782" transform="rotate(90)" x="78.505" y="-28.143" width="96" height="96" style="color:#000000;fill:none"/>
<path id="path4205" d="m18.729 85.092-80 80 2.8281 2.8281 80-80-2.8281-2.8281z" style="block-progression:tb;color-rendering:auto;color:#000000;fill:#808080;font-feature-settings:normal;font-variant-alternates:normal;font-variant-caps:normal;font-variant-ligatures:normal;font-variant-numeric:normal;font-variant-position:normal;image-rendering:auto;isolation:auto;mix-blend-mode:normal;shape-padding:0;shape-rendering:auto;solid-color:#000000;text-decoration-color:#000000;text-decoration-line:none;text-decoration-style:solid;text-indent:0;text-transform:none;white-space:normal"/>
<path id="path4160" d="m7.8772 95.935-3.5352 3.5352c6.9061 7.2961 10.777 16.961 10.777 27.035 0 10.435-4.1431 20.438-11.521 27.816l3.5352 3.5371c8.3148-8.3148 12.986-19.595 12.986-31.354 0-11.398-4.4005-22.337-12.242-30.57z" style="fill:#808080"/>
<path id="path4158" d="m-2.0056 105.82-3.5352 3.5352c4.2886 4.6701 6.6836 10.785 6.6836 17.152 0 6.7278-2.6704 13.176-7.4277 17.934l3.5352 3.5352c5.6936-5.6936 8.8926-13.417 8.8926-21.469 0-7.6913-2.9247-15.078-8.1484-20.688z" style="fill:#808080"/>
<path id="path4180" transform="translate(-67.857 78.505)" d="m48 8-19.777 19.777h-15.777s-4.4453 7.5806-4.4453 20.23c0 12.65 4.4453 20.215 4.4453 20.215h6.8477l4.002-4.002h-8.2188c-1.0205-2.1051-3.0762-6.9593-3.0762-16.213 0-9.256 2.0577-14.122 3.0781-16.23h14.801l14.121-14.121v25.859l4-4v-31.516zm0 37.172-4 4v29.17l-14.121-14.121h-0.92773l-4.002 4.002h3.2734l19.777 19.777v-42.828z" style="fill:#808080"/>
</g>
</svg>
test/rdbg-utils/chut_small.svg 0 → 100644
+ 29
− 0
View file @ 510d5c13
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
<svg version="1.1" id="Layer_1" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" x="0px" y="0px" width="50px" height="50px" viewBox="0 0 50 50" enable-background="new 0 0 50 50" xml:space="preserve"> <image id="image0" width="50" height="50" x="0" y="0"
xlink:href="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAADIAAAAyCAQAAAC0NkA6AAAABGdBTUEAALGPC/xhBQAAACBjSFJN
AAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAAAmJLR0QA/4ePzL8AAAAJcEhZ
cwAADfsAAA37AQt3NZsAAAAHdElNRQfkAxEIKw8G2AheAAAEXUlEQVRYw+3Y229UVRTH8c+ZzvRG
oa1AoUgLthI1cokGoiYYqSZG4cH4lxpNOiDlgQcToqAIiUSilE5bmGnLTS7t9DJnfOjp4cx9SvTB
xPXS7kv2d6+19l6/PScol/3rlvr3Ef91yKJZW5nYJqRk2rM25uV95xuzrwIJ3XDZahuIrDm9uqN2
enuIS3oELeYVZM0acda+7XqyiXjRBmJSzoizDsR9bXoS+rUtxH3n5Yw6ZzjR25Ynm16selOPZnf3
rm/N1iDagoRumFJ0ysdNHc85r2CXz6oQbUBCN11SdMqEnibzCi5aEChaqPG2BSR005QVp0zoahKq
gknzhvRbc8X8diCbgVpx0kR85hshckZ87YwuT/xorWI8nVzylnzF+Sm6FQWqGWLGRfeidO8x7aY/
3PFOfcgTly0RByVQlm6JyJm0YMhZw+h0yoynbhrXWQ8y7ZE93qrwZZfjTRF5Fy1KCXVEPa970y9y
7nmjFrLmjtB7TmvfCrLu6bfikWu+0IEO77pl2XQCEif+mbxeY9tCTMo56CuHlf2uEPUPGxKa8aIW
8sALew20XLpcgRh1zrj3dHnmdjS2w0EpD/1VC1mybrDpddtE9OlEPkYM47AhoWnFaNZBHdZizxKQ
v5QNtiyA+0zYKS9bUaN6HBJ44mE0a7cuGx5VQ0qWddjZAtHnc28k9GKrRgUO6FCMl+3WJ/QsDm10
ujasSelqCekz74K5Kr2gT5dlz6NWRjdWbcgkIaGSID7rjW1GVsFoFYJOGeW4mKRksKFUCWnP5p23
UEcvWllq609aWanp1LwLCvpM1EGsWRfEhSS0jnQcmdRWajLC+AjWR2TNC/TUvUvPrcroi1rriuiq
hnToVYoTV2sFWXMGZOpqStl9Jd1ei9pFz6XsjO9HfE/6BR43kKUtvfikQbFckVM2YHfUfmhVOkYm
Er9XxmMrehsgRp1reFVnLAqMxVuYV9Jrfzwee7LHDkse18nFFmJ/Az+XXbdqVywSL8wL7dZfC9lp
2LK7cZS3ENm6j5xkPm64K/B2vPO8RSmHEzGJw9Vp3G3XLQuU7XVURs737htpei/+cMW6PU5GZ6nk
N0U7jCWCm7iMY16z5IGyIeMykbD21XlHvbSSaU91Ox2/e+/5E6NeT8xKQAackRdIOWJE3gULAqtu
G24owR0+smzQsai95qqnup1IKHwFJOWoo9H/m8J6yJif/ST0aUNMvy+l42V+cxtHjFfMqVu7XqZ7
n0FTrtEE81Lo5v1g1YAPKvyoC8lHenHOfhzHlGsCn7aQtAcueSjjQwerRmog1ZKUclzZlKsCbzeF
/G5W4Jj3azaTrkZMRoiXepFyAlOuWrJRFYikHVOw7kwd6UtXI3J1f1+cwCV/CuxoCOn3pbCuhCcg
edm6iCSmcZ1Gww3EkFYFJOWEwEWv8pUkgiyaNNeigKQcF/r1FTARpGi5BWLLm8GWb5paCza/EpXN
6Yrrzz9twf+forZjfwN/YnagMZnv5AAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMC0wMy0xN1QwODo0
MzoxNSswMTowMPJWgN0AAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjAtMDMtMTdUMDg6NDM6MTUrMDE6
MDCDCzhhAAAAGXRFWHRTb2Z0d2FyZQB3d3cuaW5rc2NhcGUub3Jnm+48GgAAAABJRU5ErkJggg==" />
</svg>
test/rdbg-utils/graph.png 0 → 100644
+ 0
− 0
View file @ 510d5c13
test/rdbg-utils/graph.png

79.5 KiB

test/rdbg-utils/graph_small.png 0 → 100644
+ 0
− 0
View file @ 510d5c13
test/rdbg-utils/graph_small.png

2.84 KiB

test/rdbg-utils/oracle.jpg 0 → 100644
+ 0
− 0
View file @ 510d5c13
test/rdbg-utils/oracle.jpg

14.4 KiB

test/rdbg-utils/oracle_small.jpg 0 → 100644
+ 0
− 0
View file @ 510d5c13
test/rdbg-utils/oracle_small.jpg

837 B

test/rdbg-utils/rdbgui.ml 0 → 100644
+ 202
− 0
View file @ 510d5c13
#thread;;
#require "lablgtk3";;
(*
- comment rafraichir
-
*)
let gui () =
let _locale = GMain.init () in
let _thread = GtkThread.start() in
let w = GWindow.window ~show:true ~title: "rdbgui" () in
let box = GPack.vbox ~packing: w#add () in
let gbox = GPack.hbox ~packing: box#add () in
let gbox2 = GPack.hbox ~packing: box#add () in
let text = GText.view ~packing: box#add () in
let bbox = GPack.hbox ~packing: box#add () in
let up () =
text#buffer#set_text
(Printf.sprintf "step %d; round %d " !e.step !roundnb )
in
let change_label button str =
let icon = button#image in
button#set_label str;
button#set_image icon
in
let back_step_button =
GButton.button ~stock:`GO_BACK ~packing:bbox#add ~label:"back step" ()
in
back_step_button#misc#set_tooltip_text "Go Back to Previous Step";
change_label back_step_button "Step";
ignore (back_step_button#connect#clicked ~callback:(fun () -> bd(); up()));
let step_button =
GButton.button ~packing:bbox#add ~stock:`GO_FORWARD ~label:"step" ()
in
step_button#misc#set_tooltip_text "Go Forward to Next Step";
change_label step_button "Step";
ignore (step_button#connect#clicked ~callback:(fun () -> sd(); up()));
let back_round_button =
GButton.button ~packing:bbox#add ~stock:`MEDIA_PREVIOUS
~label:"back round" ()
in
back_round_button#misc#set_tooltip_text "Go Backward to Previous Round";
change_label back_round_button "Round";
ignore (back_round_button#connect#clicked ~callback:(fun () -> pr();up() ));
let round_button =
GButton.button ~stock:`MEDIA_FORWARD ~packing:bbox#add ~label:"round" ()
in
round_button#misc#set_tooltip_text "Go Forward to Next Round";
change_label round_button "Round";
ignore (round_button#connect#clicked ~callback:(fun () -> nr (); up()));
let silence () =
let silence_button = GButton.button ~packing:bbox#add () in
silence_button#misc#set_tooltip_text "Move Forward Until No Action is Enabled";
let image = GMisc.image ~file:"../rdbg-utils/chut_small.svg" () in
silence_button#set_image image#coerce;
ignore (silence_button#connect#clicked ~callback:(fun () -> silence(); up()))
in
silence ();
let graph () =
let graph_button = GButton.button ~packing:bbox#add () in
graph_button#misc#set_tooltip_text "View the Topology";
let image = GMisc.image ~file:"../rdbg-utils/graph_small.png" () in
graph_button#set_image image#coerce;
ignore (graph_button#connect#clicked ~callback:graph_view);
in
graph ();
let viol_oracle () =
let viol_button = GButton.button ~packing:bbox#add () in
viol_button#misc#set_tooltip_text "Move Forward Until An oracle is violated";
let image = GMisc.image ~file:"../rdbg-utils/oracle_small.jpg" () in
viol_button#set_image image#coerce;
ignore (viol_button#connect#clicked ~callback:(fun () -> viol(); up()))
in
if args.oracles <> [] then viol_oracle ();
let undo_button = GButton.button ~stock:`UNDO
~packing:bbox#add ~label:"undo" ()
in
undo_button#misc#set_tooltip_text "Undo Last Move";
ignore (undo_button#connect#clicked ~callback:(fun () -> u();up();!dot_view ()));
let restart_button = GButton.button ~stock:`REFRESH
~packing:bbox#add ~label:"restart" ()
in
restart_button#misc#set_tooltip_text "Restart from the beginning";
change_label restart_button "Restart";
ignore (restart_button#connect#clicked ~callback:(fun ()-> r();up()));
let quit_button =
GButton.button ~stock:`QUIT ~packing:bbox#add ~label:"bye" ()
in
quit_button#misc#set_tooltip_text "Quit RDBGUI";
ignore (quit_button#connect#clicked ~callback:quit);
let dot_button = GButton.radio_button ~packing:gbox#add ~label:"dot" () in
let fd_button = GButton.radio_button ~packing:gbox#add
~active:true ~group:dot_button#group ~label:"fdp" ()
in
dot_view := fd;
let sf_button = GButton.radio_button ~packing:gbox#add
~group:dot_button#group ~label:"sfdp" ()
in
let ne_button = GButton.radio_button ~packing:gbox#add
~group:dot_button#group ~label:"neato" ()
in
let tw_button = GButton.radio_button ~packing:gbox#add
~group:dot_button#group ~label:"twopi" ()
in
let ci_button = GButton.radio_button ~packing:gbox#add
~group:dot_button#group ~label:"circo" ()
in
let pa_button = GButton.radio_button ~packing:gbox#add
~group:dot_button#group ~label:"patchwork" ()
in
let os_button = GButton.radio_button ~packing:gbox#add
~group:dot_button#group ~label:"osage" ()
in
let par_dot () =
let par_dot_button = GButton.radio_button ~packing:gbox2#add
~group:dot_button#group ~label:"dot*" () in
let par_fd_button = GButton.radio_button ~packing:gbox2#add
~group:dot_button#group ~label:"fdp*" () in
let par_sf_button = GButton.radio_button ~packing:gbox2#add
~group:dot_button#group ~label:"sfdp*" () in
let par_ne_button = GButton.radio_button ~packing:gbox2#add
~group:dot_button#group ~label:"neato*" () in
let par_tw_button = GButton.radio_button ~packing:gbox2#add
~group:dot_button#group ~label:"twopi*" () in
let par_ci_button = GButton.radio_button ~packing:gbox2#add
~group:dot_button#group ~label:"circo*" () in
let par_pa_button = GButton.radio_button ~packing:gbox2#add
~group:dot_button#group ~label:"patchwork*" () in
let par_os_button = GButton.radio_button ~packing:gbox2#add
~group:dot_button#group ~label:"osage*" ()
in
par_dot_button#misc#set_tooltip_text "Use dot, but show only links to parents";
par_fd_button#misc#set_tooltip_text "Use fdp, but show only links to parents";
par_sf_button#misc#set_tooltip_text "Use sfdp, but show only links to parents";
par_ne_button#misc#set_tooltip_text "Use neato, but show only links to parents";
par_tw_button#misc#set_tooltip_text "Use twopi, but show only links to parents";
par_ci_button#misc#set_tooltip_text "Use circo, but show only links to parents";
par_pa_button#misc#set_tooltip_text "Use patchwork, but show only links to parents";
par_os_button#misc#set_tooltip_text "Use osage, but show only links to parents";
ignore (par_dot_button#connect#clicked
~callback:(fun () -> dot_view := d_par; !dot_view ()));
ignore (par_fd_button#connect#clicked
~callback:(fun () -> dot_view := fd_par; !dot_view ()));
ignore (par_sf_button#connect#clicked
~callback:(fun () -> dot_view := sf_par; !dot_view ()));
ignore (par_ne_button#connect#clicked
~callback:(fun () -> dot_view := ne_par; !dot_view ()));
ignore (par_tw_button#connect#clicked
~callback:(fun () -> dot_view := tw_par; !dot_view ()));
ignore (par_ci_button#connect#clicked
~callback:(fun () -> dot_view := ci_par; !dot_view ()));
ignore (par_pa_button#connect#clicked
~callback:(fun () -> dot_view := pa_par; !dot_view ()));
ignore (par_os_button#connect#clicked
~callback:(fun () -> dot_view := os_par; !dot_view ()))
in
let have_parent () = (* is there a parent field in the state ? *)
List.exists (fun (v,_) -> Str.string_match (Str.regexp ".*_par.*") v 0) !e.data
in
if have_parent () then par_dot ();
dot_button#misc#set_tooltip_text "Use the dot engine to display the graph";
fd_button#misc#set_tooltip_text "Use the fdp engine to display the graph";
sf_button#misc#set_tooltip_text "Use the sfdp engine to display the graph";
ne_button#misc#set_tooltip_text "Use the neato engine to display the graph";
tw_button#misc#set_tooltip_text "Use the twopi engine to display the graph";
ci_button#misc#set_tooltip_text "Use the circo engine to display the graph";
pa_button#misc#set_tooltip_text "Use the patchwork engine to display the graph";
os_button#misc#set_tooltip_text "Use the osage engine to display the graph";
ignore (dot_button#connect#clicked ~callback:(fun () -> dot_view := dot; !dot_view ()));
ignore (fd_button#connect#clicked ~callback:(fun () -> dot_view := fd; !dot_view ()));
ignore (sf_button#connect#clicked ~callback:(fun () -> dot_view := sf; !dot_view ()));
ignore (ne_button#connect#clicked ~callback:(fun () -> dot_view := ne; !dot_view ()));
ignore (tw_button#connect#clicked ~callback:(fun () -> dot_view := tw; !dot_view ()));
ignore (ci_button#connect#clicked ~callback:(fun () -> dot_view := ci; !dot_view ()));
ignore (pa_button#connect#clicked ~callback:(fun () -> dot_view := pa; !dot_view ()));
ignore (os_button#connect#clicked ~callback:(fun () -> dot_view := os; !dot_view ()));
up()
;;
let _ = gui ()
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