diff --git a/sw/ground_segment/cockpit/editFP.ml b/sw/ground_segment/cockpit/editFP.ml index c5eddb7f8f..f502059fa0 100644 --- a/sw/ground_segment/cockpit/editFP.ml +++ b/sw/ground_segment/cockpit/editFP.ml @@ -105,7 +105,8 @@ let load_fp = fun geomap accel_group () -> | Some xml_file -> try let xml = Xml.parse_file xml_file in - ignore (load_xml_fp geomap accel_group ~xml_file xml) + ignore (load_xml_fp geomap accel_group ~xml_file xml); + geomap#fit_to_window () with Dtd.Check_error(e) -> let m = sprintf "Error while loading %s:\n%s" xml_file (Dtd.check_error e) in diff --git a/sw/ground_segment/cockpit/live.ml b/sw/ground_segment/cockpit/live.ml index 33ebeebf2b..d4fdd10201 100644 --- a/sw/ground_segment/cockpit/live.ml +++ b/sw/ground_segment/cockpit/live.ml @@ -212,9 +212,9 @@ let mark = fun (geomap:G.widget) ac_id track plugin_frame -> (** Load a mission. Returns the XML window *) -let load_mission = fun ?edit color geomap xml -> +let load_mission = fun ?editable color geomap xml -> Map2d.set_georef_if_none geomap (MapFP.georef_of_xml xml); - new MapFP.flight_plan ?edit ~show_moved:true geomap color Env.flight_plan_dtd xml + new MapFP.flight_plan ?editable ~show_moved:true geomap color Env.flight_plan_dtd xml @@ -270,7 +270,7 @@ let create_ac = fun (geomap:G.widget) (acs_notebook:GPack.notebook) ac_id config (** Build the XML flight plan, connect then "jump_to_block" *) let fp_xml = ExtXml.child fp_xml_dump "flight_plan" in - let fp = load_mission ~edit:false color geomap fp_xml in + let fp = load_mission ~editable:false color geomap fp_xml in fp#connect_activated (fun node -> if XmlEdit.tag node = "block" then let block = XmlEdit.attrib node "name" in diff --git a/sw/lib/ocaml/mapFP.ml b/sw/lib/ocaml/mapFP.ml index 7dbf9fa45d..1f5c5dccf8 100644 --- a/sw/lib/ocaml/mapFP.ml +++ b/sw/lib/ocaml/mapFP.ml @@ -35,7 +35,7 @@ let rec assoc_nocase at = function (** Connect a change in the XML editor to the graphical rep *) let update_wp utm_ref (wp:MapWaypoints.waypoint) = function - XmlEdit.Deleted -> wp#delete + XmlEdit.Deleted -> wp#delete () | XmlEdit.New_child _ -> failwith "update_wp" | XmlEdit.Modified attribs -> try @@ -81,16 +81,19 @@ let waypoints_node = fun xml_tree -> XmlEdit.child xml_root "waypoints" (** Connect a change from the graphical rep to the xml tree *) -let update_xml = fun xml_tree utm0 wp -> +let update_xml = fun xml_tree utm0 wp id -> let xml_wpts = XmlEdit.children (waypoints_node xml_tree) in - let node = List.find (fun w -> XmlEdit.attrib w "name" = wp#name) xml_wpts in - let utm = utm_of WGS84 (wp#pos) in - try - let (dx, dy) = utm_sub utm utm0 in - XmlEdit.set_attribs node ["name",wp#name; "x",sof dx; "y",sof dy; "alt", sof wp#alt] - with - _ -> - prerr_endline "MapFP.update_xml: waypoint too far from ref (FIXME)" + let node = List.find (fun w -> XmlEdit.id w = id) xml_wpts in + if wp#deleted then begin + XmlEdit.delete node + end else + let utm = utm_of WGS84 (wp#pos) in + try + let (dx, dy) = utm_sub utm utm0 in + XmlEdit.set_attribs node ["name",wp#name; "x",sof dx; "y",sof dy; "alt", sof wp#alt] + with + _ -> + prerr_endline "MapFP.update_xml: waypoint too far from ref (FIXME)" let new_wp = fun geomap xml_tree waypoints utm_ref ?(alt = 0.) node -> let float_attrib = fun a -> float_of_string (XmlEdit.attrib node a) in @@ -102,7 +105,8 @@ let new_wp = fun geomap xml_tree waypoints utm_ref ?(alt = 0.) node -> geomap#register_to_fit (wp:>MapCanvas.geographic); XmlEdit.connect node (update_wp utm_ref wp); XmlEdit.connect node (update_wp_refs (ref name) xml_tree); - wp#connect (fun () -> update_xml xml_tree utm_ref wp); + let id = XmlEdit.id node in + wp#connect (fun () -> update_xml xml_tree utm_ref wp id); wp let gensym = @@ -119,9 +123,9 @@ let georef_of_xml = fun xml -> {posn_lat = (Deg>>Rad)lat0; posn_long = (Deg>>Rad)lon0 } -class flight_plan = fun ?edit ~show_moved geomap color fp_dtd xml -> +class flight_plan = fun ?editable ~show_moved geomap color fp_dtd xml -> (** Xml Editor *) - let xml_tree_view, xml_window = XmlEdit.create ?edit (Dtd.parse_file fp_dtd) xml in + let xml_tree_view, xml_window = XmlEdit.create ?editable (Dtd.parse_file fp_dtd) xml in let xml_root = XmlEdit.root xml_tree_view in let xml_wpts = XmlEdit.child xml_root "waypoints" in @@ -131,7 +135,7 @@ class flight_plan = fun ?edit ~show_moved geomap color fp_dtd xml -> let utm0 = utm_of WGS84 ref_wgs84 in (** The graphical waypoints *) - let wpts_group = new MapWaypoints.group ~show_moved ~color ~editable:true geomap in + let wpts_group = new MapWaypoints.group ~show_moved ~color ?editable geomap in let yaws = Hashtbl.create 5 in (* Yes Another Waypoints Store *) let create_wp = diff --git a/sw/lib/ocaml/mapFP.mli b/sw/lib/ocaml/mapFP.mli index db8614646b..4551d59307 100644 --- a/sw/lib/ocaml/mapFP.mli +++ b/sw/lib/ocaml/mapFP.mli @@ -26,7 +26,7 @@ (** [flight_plan geomap color dtd_tile xml] *) class flight_plan : - ?edit:bool -> + ?editable:bool -> show_moved:bool -> MapCanvas.widget -> string -> diff --git a/sw/lib/ocaml/mapWaypoints.ml b/sw/lib/ocaml/mapWaypoints.ml index 8ba149f280..90553385eb 100644 --- a/sw/lib/ocaml/mapWaypoints.ml +++ b/sw/lib/ocaml/mapWaypoints.ml @@ -95,7 +95,7 @@ class waypoint = fun (wpts_group:group) (name :string) ?(alt=0.) wgs84 -> let wgs84 = self#pos in let s = sprintf "WGS84 %s" (geomap#geo_string wgs84) in - let ename = GEdit.entry ~text:name ~editable:false ~packing:dvbx#add () in + let ename = GEdit.entry ~text:name ~editable ~packing:dvbx#add () in let e_pos = GEdit.entry ~text:s ~packing:dvbx#add () in let ha = GPack.hbox ~packing:dvbx#add () in let minus10= GButton.button ~label:"-10" ~packing:ha#add () in @@ -116,11 +116,22 @@ class waypoint = fun (wpts_group:group) (name :string) ?(alt=0.) wgs84 -> moved <- anim moved; dialog#destroy () in + let dhbx = GPack.box `HORIZONTAL ~packing: dvbx#add () in - let cancel = GButton.button ~stock:`CANCEL ~packing: dvbx#add () in + let cancel = GButton.button ~stock:`CANCEL ~packing: dhbx#add () in ignore(cancel#connect#clicked ~callback:dialog#destroy); - let ok = GButton.button ~stock:`OK ~packing: dvbx#add () in + if editable then begin + let delete = GButton.button ~stock:`DELETE ~packing: dhbx#add () in + let delete_callback = fun () -> + dialog#destroy (); + self#delete (); + updated () + in + ignore(delete#connect#clicked ~callback:delete_callback) + end; + + let ok = GButton.button ~stock:`OK ~packing: dhbx#add () in List.iter (fun e -> ignore (e#connect#activate ~callback)) [ename; e_pos; ea]; @@ -168,7 +179,7 @@ class waypoint = fun (wpts_group:group) (name :string) ?(alt=0.) wgs84 -> | _ -> () end; true - initializer ignore(if editable then ignore (item#connect#event self#event)) + initializer ignore(item#connect#event self#event) method moved = moved <> None method reset_moved () = match moved with @@ -201,7 +212,7 @@ class waypoint = fun (wpts_group:group) (name :string) ?(alt=0.) wgs84 -> if update then updated () | (None, false) | (Some _, true) -> () | Some x, false -> self#reset_moved () - method delete = + method delete () = deleted <- true; (* BOF *) wpt_group#destroy () method zoom (z:float) = diff --git a/sw/lib/ocaml/mapWaypoints.mli b/sw/lib/ocaml/mapWaypoints.mli index fbe458c19d..bdef5cfd8b 100644 --- a/sw/lib/ocaml/mapWaypoints.mli +++ b/sw/lib/ocaml/mapWaypoints.mli @@ -44,7 +44,7 @@ class waypoint : Latlong.geographic -> object method alt : float - method delete : unit + method delete : unit -> unit method edit : unit method pos : Latlong.geographic method event : GnoCanvas.item_event -> bool diff --git a/sw/lib/ocaml/xmlEdit.ml b/sw/lib/ocaml/xmlEdit.ml index cee1bc068d..172a4580ff 100644 --- a/sw/lib/ocaml/xmlEdit.ml +++ b/sw/lib/ocaml/xmlEdit.ml @@ -100,15 +100,22 @@ let tag_col = cols#add Gobject.Data.string let attributes = cols#add Gobject.Data.caml let event = cols#add Gobject.Data.caml let background = cols#add Gobject.Data.string +let id = cols#add Gobject.Data.int let string_of_attribs = fun attribs -> List.fold_right (fun (a,v) r -> sprintf " %s=\"%s\"%s" a v r) attribs "" +type id = int +let gen_id = + let x = ref 0 in + fun () -> incr x; !x + let set_xml = fun (store:GTree.tree_store) row xml -> store#set ~row ~column:tag_col (Xml.tag xml); store#set ~row ~column:background default_background; store#set ~row ~column:attributes (Xml.attribs xml); - store#set ~row ~column:event (fun _ -> ()) + store#set ~row ~column:event (fun _ -> ()); + store#set ~row ~column:id (gen_id ()) let rec insert_xml = fun (store:GTree.tree_store) parent xml -> @@ -375,6 +382,10 @@ let add_child = fun ((model, path):node) tag attribs -> set_xml model row (Xml.Element (tag, attribs, [])); model, model#get_path row +let id = fun ((model, path):node) -> + let row = model#get_iter path in + model#get ~row ~column:id + let connect = fun ((model, path):node) cb -> let row = model#get_iter path in let current_cb = try model#get ~row ~column:event with _ -> fun _ -> () in @@ -446,13 +457,13 @@ let tree_menu_popup = fun dtd (model:GTree.tree_store) (row:Gtk.tree_iter) -> -let create = fun ?(edit=true) ?(width = 400) dtd xml -> +let create = fun ?(editable=true) ?(width = 400) dtd xml -> let tree_model = tree_model_of_xml xml in let attribs_model = model_of_attribs () in let hbox = GPack.hbox () in let sw = GBin.scrolled_window ~width ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ~packing:hbox#add () in - let tree_view = tree_view ~edit tree_model sw in + let tree_view = tree_view ~edit:editable tree_model sw in tree_view#set_border_width 10; let sw = GBin.scrolled_window ~width:150 ~hpolicy:`AUTOMATIC @@ -460,7 +471,7 @@ let create = fun ?(edit=true) ?(width = 400) dtd xml -> let attribs_view = attribs_view attribs_model in attribs_view#set_border_width 10; sw#add attribs_view#coerce; - if edit then + if editable then hbox#add sw#coerce; let update_tree = fun _path -> @@ -494,7 +505,7 @@ let create = fun ?(edit=true) ?(width = 400) dtd xml -> let cbs = try (Hashtbl.find activated_cbs tree_model) with Not_found -> [] in List.iter (fun cb -> cb (tree_model, path)) cbs) in - if edit then begin + if editable then begin let _c = add_context_menu tree_model tree_view (tree_menu_popup dtd) in let _c = add_context_menu attribs_model attribs_view ~noselection_menu:(add_one_menu dtd tree_view) (attribs_menu_popup dtd tree_view) in diff --git a/sw/lib/ocaml/xmlEdit.mli b/sw/lib/ocaml/xmlEdit.mli index 2a0e170f82..053e674950 100644 --- a/sw/lib/ocaml/xmlEdit.mli +++ b/sw/lib/ocaml/xmlEdit.mli @@ -40,7 +40,7 @@ type attributes = attribute list type event = Deleted | Modified of attributes | New_child of node -val create : ?edit:bool -> ?width:int -> Dtd.dtd -> Xml.xml -> (t * GObj.widget) +val create : ?editable:bool -> ?width:int -> Dtd.dtd -> Xml.xml -> (t * GObj.widget) (** [create dtd xml] Opens a display of [xml] with contextual right button actions constrained by [dtd]. Returns the corresponding model. *) @@ -73,3 +73,6 @@ val selection : t -> node val expand_node : ?all:bool -> t -> node -> unit val set_background : ?all:bool -> node -> string -> unit + +type id = int +val id : node -> id