strip buttons

conf/flight_plans/flight_plan.dtd

@@ -55,6 +55,7 @@ alt CDATA #IMPLIED>
 
 <!ATTLIST block 
 name CDATA #REQUIRED
+strip_button CDATA #IMPLIED
 description CDATA #IMPLIED>
 
 <!ATTLIST while cond CDATA #IMPLIED>

conf/flight_plans/generic.xml

@@ -29,7 +29,7 @@
     <block NAME="stack 1">
       <circle RADIUS="estimator_z/2" WP="1"/>
     </block>
-    <block NAME="descent 0">
+    <block NAME="descent 0" strip_button="Descent">
       <circle RADIUS="estimator_z/2" WP="1" vmode="gaz" gaz="0.0" pitch="-0.3"/>
     </block>
     <block NAME="route12">

conf/settings/basic.xml

@@ -8,8 +8,8 @@
       <dl_setting MAX="1000" MIN="-50" STEP="10" VAR="altitude_shift"/>
     </dl_settings>
     <dl_settings NAME="mode">
-      <dl_setting MAX="2" MIN="0" STEP="1" VAR="pprz_mode"/>
+      <dl_setting MAX="2" MIN="0" STEP="1" VAR="pprz_mode" strip_button="AUTO2" button_value="2"/>
-      <dl_setting MAX="1" MIN="0" STEP="1" VAR="launch"/>
+      <dl_setting MAX="1" MIN="0" STEP="1" VAR="launch" strip_button="Launch" button_value="1"/>
     </dl_settings>
   </dl_settings>
 </settings>

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
 >

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

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 ; 

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

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

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

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

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]