diff --git a/conf/flight_plans/flight_plan.dtd b/conf/flight_plans/flight_plan.dtd index f4a17382ce..23275a6aeb 100644 --- a/conf/flight_plans/flight_plan.dtd +++ b/conf/flight_plans/flight_plan.dtd @@ -55,6 +55,7 @@ alt CDATA #IMPLIED> diff --git a/conf/flight_plans/generic.xml b/conf/flight_plans/generic.xml index 3d9b58b5a9..9c31325d18 100644 --- a/conf/flight_plans/generic.xml +++ b/conf/flight_plans/generic.xml @@ -29,7 +29,7 @@ - + diff --git a/conf/settings/basic.xml b/conf/settings/basic.xml index fd72d17705..121d97c09a 100644 --- a/conf/settings/basic.xml +++ b/conf/settings/basic.xml @@ -8,8 +8,8 @@ - - + + diff --git a/conf/settings/settings.dtd b/conf/settings/settings.dtd index 9d55b0d6c6..e4d350d809 100644 --- a/conf/settings/settings.dtd +++ b/conf/settings/settings.dtd @@ -25,4 +25,6 @@ var CDATA #REQUIRED min CDATA #REQUIRED max CDATA #REQUIRED step CDATA #IMPLIED +strip_button CDATA #IMPLIED +button_value CDATA #IMPLIED > diff --git a/sw/ground_segment/cockpit/Makefile b/sw/ground_segment/cockpit/Makefile index 6d38c2e30e..a15eceae9f 100644 --- a/sw/ground_segment/cockpit/Makefile +++ b/sw/ground_segment/cockpit/Makefile @@ -29,7 +29,7 @@ INCLUDES=-I +lablgtk2 -I ../../lib/ocaml LIBS=glibivy-ocaml.cma lablgtk.cma lib-pprz.cma lablgnomecanvas.cma xlib-pprz.cma CMXA=$(LIBS:.cma=.cmxa) -ML= speech.ml horizon.ml pages.ml strip.ml plugin.ml sectors.ml map2d.ml editFP.ml live.ml gcs.ml +ML= speech.ml horizon.ml strip.ml pages.ml plugin.ml sectors.ml map2d.ml editFP.ml live.ml gcs.ml MAIN=gcs CMO=$(ML:.ml=.cmo) CMX=$(ML:.ml=.cmx) @@ -62,15 +62,18 @@ $(MAIN).opt : $(CMX) @echo OOC $< $(Q)$(OCAMLOPT) $(INCLUDES) -c $< -gcs.cmo : pages.cmi speech.cmi editFP.cmi sectors.cmi -pages.cmo pages.cmx : pages.cmi horizon.cmi -live.cmo : plugin.cmi live.cmi strip.cmi speech.cmi pages.cmi -map2d.cmo : map2d.cmi -strip.cmo : strip.cmi -speech.cmo : speech.cmi -plugin.cmo : plugin.cmi -editFP.cmo : editFP.cmi -sectors.cmo : sectors.cmi clean: rm -f *~* *.cm* *.o *.out *.opt map2d gcs + + +# +# Dependencies +# + +.depend: + ocamldep *.ml* > .depend + +ifneq ($(MAKECMDGOALS),clean) +-include .depend +endif diff --git a/sw/ground_segment/cockpit/live.ml b/sw/ground_segment/cockpit/live.ml index 05faa80c9d..f24b77fda5 100644 --- a/sw/ground_segment/cockpit/live.ml +++ b/sw/ground_segment/cockpit/live.ml @@ -269,17 +269,6 @@ let create_ac = fun (geomap:G.widget) (acs_notebook:GPack.notebook) ac_id config let params = ac_menu_fact#add_check_item "A/C label" ~active:false in ignore (params#connect#toggled (fun () -> track#set_params_state params#active)); - (** 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 ~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 - let id = list_casso block blocks in - jump_to_block ac_id id); - ignore (reset_wp_menu#connect#activate (reset_waypoints fp)); - - (** Add a new tab in the A/Cs notebook, with a colored label *) let eb = GBin.event_box () in let _label = GMisc.label ~text:name ~packing:eb#add () in @@ -291,6 +280,35 @@ let create_ac = fun (geomap:G.widget) (acs_notebook:GPack.notebook) ac_id config let visible = fun w -> ac_notebook#page_num w#coerce = ac_notebook#current_page in + (** Add a strip and connect it to the A/C notebook *) + let select_this_tab = + let n = acs_notebook#page_num ac_frame#coerce in + fun () -> acs_notebook#goto_page n in + let strip = Strip.add config color select_this_tab center_ac commit_moves (mark geomap ac_id track !Plugin.frame) in + + + (** 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 ~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 + let id = list_casso block blocks in + jump_to_block ac_id id); + ignore (reset_wp_menu#connect#activate (reset_waypoints fp)); + + (** Add the short cut buttons in the strip *) + List.iter (fun b -> + try + let label = ExtXml.attrib b "strip_button" + and id = ExtXml.int_attrib b "no" in + let b = GButton.button ~label () in + Strip.add_widget strip b#coerce; + ignore (b#connect#clicked (fun _ -> jump_to_block ac_id id)) + with + _ -> ()) + (Xml.children (ExtXml.child (ExtXml.child fp_xml_dump "flight_plan") "blocks")); + (** Insert the flight plan tab *) let fp_label = GMisc.label ~text: "Flight Plan" () in (ac_notebook:GPack.notebook)#append_page ~tab_label:fp_label#coerce fp#window#coerce; @@ -325,11 +343,13 @@ let create_ac = fun (geomap:G.widget) (acs_notebook:GPack.notebook) ac_id config let callback = fun idx value -> let vs = ["ac_id", Pprz.String ac_id; "index", Pprz.Int idx;"value", Pprz.Float value] in Ground_Pprz.message_send "dl" "DL_SETTING" vs in - let settings_tab = new Pages.settings ~visible xml_settings callback in + let settings_tab = new Pages.settings ~visible xml_settings callback strip in let tab_label = (GMisc.label ~text:"Settings" ())#coerce in ac_notebook#append_page ~tab_label settings_tab#widget; Some settings_tab - with _ -> None in + with exc -> + prerr_endline (Printexc.to_string exc); + None in let rc_settings_page = try @@ -340,12 +360,6 @@ let create_ac = fun (geomap:G.widget) (acs_notebook:GPack.notebook) ac_id config Some settings_tab with _ -> None in - (** Add a strip and connect it to the A/C notebook *) - let select_this_tab = - let n = acs_notebook#page_num ac_frame#coerce in - fun () -> acs_notebook#goto_page n in - let strip = Strip.add config color select_this_tab center_ac commit_moves (mark geomap ac_id track !Plugin.frame) in - Hashtbl.add live_aircrafts ac_id { track = track; color = color; fp_group = fp ; config = config ; diff --git a/sw/ground_segment/cockpit/pages.ml b/sw/ground_segment/cockpit/pages.ml index 6d7c1baa9e..8ecd25eb8d 100644 --- a/sw/ground_segment/cockpit/pages.ml +++ b/sw/ground_segment/cockpit/pages.ml @@ -179,7 +179,7 @@ class misc ~packing (widget: GBin.frame) = (*****************************************************************************) (* Dataling settings paged *) (*****************************************************************************) -let one_setting = fun i do_change packing s (tooltips:GData.tooltips) -> +let one_setting = fun i do_change packing s (tooltips:GData.tooltips) strip -> let f = fun a -> float_of_string (ExtXml.attrib s a) in let lower = f "min" and upper = f "max" @@ -189,7 +189,8 @@ let one_setting = fun i do_change packing s (tooltips:GData.tooltips) -> let text = ExtXml.attrib s "var" in let _l = GMisc.label ~width:100 ~text ~packing:hbox#pack () in let _v = GMisc.label ~width:50 ~text:"N/A" ~packing:hbox#pack () in - (** For a small number of values, radio buttons *) + + (** For a small number of values, radio buttons, else a slider *) let _n = truncate ((upper -. lower) /. step_incr) in let commit = if step_incr = 1. && upper -. lower <= 2. then @@ -231,10 +232,20 @@ let one_setting = fun i do_change packing s (tooltips:GData.tooltips) -> | Some v -> do_change i v in ignore (undo_but#connect#clicked ~callback); tooltips#set_tip undo_but#coerce ~text:"Undo"; + begin + try + let label = ExtXml.attrib s "strip_button" + and sp_value = f "button_value" in + let b = GButton.button ~label () in + Strip.add_widget strip b#coerce; + ignore (b#connect#clicked (fun _ -> do_change i sp_value)) + with + ExtXml.Error _ -> () + end; _v -let rec build_settings = fun do_change i flat_list xml_settings packing tooltips -> +let rec build_settings = fun do_change i flat_list xml_settings packing tooltips strip -> match xml_settings with [] -> () | x::xs -> @@ -242,7 +253,7 @@ let rec build_settings = fun do_change i flat_list xml_settings packing tooltips if ExtXml.tag_is x "dl_setting" then List.iter (fun s -> - let label_value = one_setting !i do_change packing s tooltips in + let label_value = one_setting !i do_change packing s tooltips strip in flat_list := label_value :: !flat_list; incr i) xml_settings @@ -258,20 +269,20 @@ let rec build_settings = fun do_change i flat_list xml_settings packing tooltips let tab_label = (GMisc.label ~text ())#coerce in n#append_page ~tab_label vbox#coerce; - build_settings do_change i flat_list (Xml.children p) vbox#pack tooltips) + build_settings do_change i flat_list (Xml.children p) vbox#pack tooltips strip) xml_settings end -class settings = fun ?(visible = fun _ -> true) xml_settings do_change -> +class settings = fun ?(visible = fun _ -> true) xml_settings do_change strip -> let sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in let vbox = GPack.vbox ~packing:sw#add_with_viewport () in let tooltips = GData.tooltips () in let i = ref 0 and l = ref [] in let current_values = - build_settings do_change i l xml_settings vbox#add tooltips; + build_settings do_change i l xml_settings vbox#add tooltips strip; Array.of_list (List.rev !l) in object (self) method widget = sw#coerce diff --git a/sw/ground_segment/cockpit/pages.mli b/sw/ground_segment/cockpit/pages.mli index 35c0e17831..15105c814a 100644 --- a/sw/ground_segment/cockpit/pages.mli +++ b/sw/ground_segment/cockpit/pages.mli @@ -22,7 +22,7 @@ class pfd : ?visible:(GBin.frame -> bool) -> GBin.frame -> method set_attitude : float -> float -> unit end -class settings : ?visible:(GObj.widget -> bool) -> Xml.xml list -> (int -> float -> unit) -> +class settings : ?visible:(GObj.widget -> bool) -> Xml.xml list -> (int -> float -> unit) -> Strip.t -> object method length : int method set : int -> float -> unit diff --git a/sw/ground_segment/cockpit/strip.ml b/sw/ground_segment/cockpit/strip.ml index a3ff6c65aa..27ac983cd3 100644 --- a/sw/ground_segment/cockpit/strip.ml +++ b/sw/ground_segment/cockpit/strip.ml @@ -10,7 +10,8 @@ let table = GPack.table ~rows: 1 ~columns: 1 ~row_spacings: 5 ~packing: (scrolle type t = { gauge: GRange.progress_bar ; - labels: (string * (GBin.event_box * GMisc.label)) list + labels: (string * (GBin.event_box * GMisc.label)) list; + buttons_box : GPack.box } let labels_name = [| @@ -42,7 +43,8 @@ let add config color select center_ac commit_moves mark = (* frame of the strip *) let frame = GBin.frame ~shadow_type: `IN ~packing: (widget#attach ~top: (strip_number) ~left: 0) () in - let strip = GPack.table ~rows:2 ~columns: 2 ~col_spacings: 10 ~packing: frame#add () in + let framevb = GPack.vbox ~packing:frame#add () in + let strip = GPack.table ~rows:2 ~columns: 2 ~col_spacings: 10 ~packing: framevb#add () in ignore (GMisc.label ~text: (ac_name) ~packing: (strip#attach ~top: 0 ~left: 0) ()); let plane_color = GBin.event_box ~width:10 ~height:10 ~packing:(strip#attach ~top:0 ~left: 1) () in @@ -87,7 +89,9 @@ let add config color select center_ac commit_moves mark = ignore (b#connect#clicked ~callback:commit_moves); let b = GButton.button ~label:"Mark" ~packing:(left_box#attach ~top:4 ~left:4 ~right:6) () in ignore (b#connect#clicked ~callback:mark); - {gauge=pb ; labels= !strip_labels} + + let hbox = GPack.hbox ~packing:framevb#add () in + {gauge=pb ; labels= !strip_labels; buttons_box = hbox} (** set a label *) @@ -107,3 +111,6 @@ let set_bat strip value = let f = max 0. (min 1. f) in strip.gauge#set_fraction f + +let add_widget = fun strip widget -> + strip.buttons_box#add widget diff --git a/sw/ground_segment/cockpit/strip.mli b/sw/ground_segment/cockpit/strip.mli index fb94d1aeda..17a2f7ee70 100644 --- a/sw/ground_segment/cockpit/strip.mli +++ b/sw/ground_segment/cockpit/strip.mli @@ -7,3 +7,4 @@ val set_label : t -> string -> string -> unit val set_color : t -> string -> string -> unit val set_bat : t -> float -> unit val scrolled : GBin.scrolled_window +val add_widget : t -> GObj.widget -> unit diff --git a/sw/lib/ocaml/mapFP.ml b/sw/lib/ocaml/mapFP.ml index 1f5c5dccf8..8c22142f15 100644 --- a/sw/lib/ocaml/mapFP.ml +++ b/sw/lib/ocaml/mapFP.ml @@ -87,7 +87,7 @@ let update_xml = fun xml_tree utm0 wp id -> if wp#deleted then begin XmlEdit.delete node end else - let utm = utm_of WGS84 (wp#pos) 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]