Commit 741d0243 authored by Benoit Barbot's avatar Benoit Barbot
Browse files

add callback

parent ce18f750
Pipeline #1755 failed with stage
in 29 seconds
......@@ -57,6 +57,7 @@ module GraphEditor (G: GRAPH ) = struct
mutable origin : float * float;
mutable selected_obj: selectable_type;
mutable graph : G.graph;
callback : G.graph -> unit;
canvas : Js_of_ocaml.Dom_html.canvasElement Js.t;
attribute_list : Js_of_ocaml.Dom_html.divElement Js.t;
ctx : Dom_html.canvasRenderingContext2D Js.t
......@@ -279,6 +280,7 @@ module GraphEditor (G: GRAPH ) = struct
done;
graph
let save_load_html s =
let loadfile st =
......@@ -309,7 +311,7 @@ module GraphEditor (G: GRAPH ) = struct
update_link "Direct Link" (fun n -> (n^"?q="^(get_exchange_string s.graph)))
]]
let init ?saveload ?slider canvas attribute_list =
let init ?saveload ?slider ?callback canvas attribute_list =
(*let init canvas_elt attr_list_div saveload_elt slider_elt =
let canvas = Eliom_content.Html.To_dom.of_canvas canvas_elt in
let attribute_list = Eliom_content.Html.To_dom.of_div attr_list_div in
......@@ -322,6 +324,7 @@ module GraphEditor (G: GRAPH ) = struct
origin= -50.0, -50.0;
selected_obj = Empty;
graph= G.new_graph ();
callback = (match callback with None -> ignore | Some s -> s);
canvas;
ctx;
attribute_list
......@@ -412,6 +415,7 @@ let rec html_of_attr s attr nattr cb =
update_attr s;end; v2
| Empty -> G.update_arc_attribute s.graph `Empty id (Some nva)
| Area _ -> false in
s.callback s.graph;
draw s (0.0,0.0); v in
let callback_supr id _ =
let _ = match s.selected_obj with
......@@ -508,6 +512,7 @@ let rec html_of_attr s attr nattr cb =
| Area r -> let l = node_in_rect s r in
List.iter (fun node -> G.remove_node s.graph node) l
end;
s.callback s.graph;
set_selected s Empty (0.0,0.0) in
Dom.appendChild
s.attribute_list
......@@ -563,6 +568,7 @@ let rec html_of_attr s attr nattr cb =
let vect = mouse_pos -.. get_coord ~exact:true s ev2 in
let nn = G.new_node s.graph (which_choice nchoice vect)
(from_screen s (get_coord s ev)) in
s.callback s.graph;
set_selected s (Node nn) (get_coord s ev);
Lwt.return ()
))
......@@ -597,6 +603,7 @@ let rec html_of_attr s attr nattr cb =
Node node2 -> ignore @@ G.new_arc s.graph node1 node2;
| _ -> ()
end;
s.callback s.graph;
draw s mouse_pos;
Lwt.return ());
mousemoves s.canvas (fun ev _ ->
......
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