add feature to group strip buttons verticaly with attribute "group" in settings and flight plans

conf/flight_plans/basic.xml

@@ -18,7 +18,9 @@
     <waypoint name="_BASELEG" x="168.8" y="-13.8"/>
     <waypoint name="CLIMB" x="-114.5" y="162.3"/>
   </waypoints>
-  <exceptions/>
+  <exceptions>
+    <!--exception cond="datalink_time > 22" deroute="Standby"/-->
+  </exceptions>
   <blocks>
     <block name="Wait GPS">
       <set value="1" var="kill_throttle"/>
@@ -29,47 +31,47 @@
       <call fun="NavSetGroundReferenceHere()"/>
     </block>
     <block name="Holding point">
+      <!--set var="nav_mode" value="NAV_MODE_ROLL"/-->
       <set value="1" var="kill_throttle"/>
       <attitude roll="0" throttle="0" vmode="throttle"/>
     </block>
-    <block key="t" name="Takeoff" strip_button="Takeoff (wp CLIMB)" strip_icon="takeoff.png">
+    <block key="t" name="Takeoff" strip_button="Takeoff (wp CLIMB)" strip_icon="takeoff.png" group="home">
       <exception cond="estimator_z > ground_alt+25" deroute="Standby"/>
       <set value="0" var="kill_throttle"/>
       <set value="0" var="estimator_flight_time"/>
       <go from="HOME" throttle="1.0" vmode="throttle" wp="CLIMB" pitch="15"/>
     </block>
-    <block key="<Control>a" name="Standby" strip_button="Standby" strip_icon="home.png">
+    <block key="<Control>a" name="Standby" strip_button="Standby" strip_icon="home.png" group="home">
       <circle radius="nav_radius" wp="STDBY"/>
     </block>
-    <block key="F8" name="Figure 8 around wp 1" strip_button="Figure 8 (wp 1-2)" strip_icon="eight.png">
+    <block key="F8" name="Figure 8 around wp 1" strip_button="Figure 8 (wp 1-2)" strip_icon="eight.png" group="base_pattern">
       <eight center="1" radius="nav_radius" turn_around="2"/>
     </block>
-    <block name="Oval 1-2" strip_button="Oval (wp 1-2)" strip_icon="oval.png">
+    <block name="Oval 1-2" strip_button="Oval (wp 1-2)" strip_icon="oval.png" group="base_pattern">
       <oval p1="1" p2="2" radius="nav_radius"/>
     </block>
-    <block name="MOB" strip_button="Turn around here" strip_icon="mob.png">
+    <block name="MOB" strip_button="Turn around here" strip_icon="mob.png" group="base_pattern">
       <call fun="NavSetWaypointHere(WP_MOB)"/>
       <set value="DEFAULT_CIRCLE_RADIUS" var="nav_radius"/>
       <circle radius="nav_radius" wp="MOB"/>
     </block>
-    <block name="Line 1-2" strip_button="Line (wp 1-2)" strip_icon="line.png">
+    <block name="Line 1-2" strip_button="Line (wp 1-2)" strip_icon="line.png" group="extra_pattern">
-      <exception cond="datalink_time > 22" deroute="Standby"/>
       <call fun="nav_line_init()"/>
       <call fun="nav_line(WP_1, WP_2, nav_radius)"/>
     </block>
-    <block name="Survey S1-S2" strip_button="Survey (wp S1-S2)" strip_icon="survey.png">
+    <block name="Survey S1-S2" strip_button="Survey (wp S1-S2)" strip_icon="survey.png" group="extra_pattern">
       <survey_rectangle grid="150" wp1="S1" wp2="S2"/>
     </block>
-    <block name="Path 1,2,S1,S2,STDBY" strip_button="Path (1,2,S1,S2,STDBY)" strip_icon="path.png">
+    <block name="Path 1,2,S1,S2,STDBY" strip_button="Path (1,2,S1,S2,STDBY)" strip_icon="path.png" group="extra_pattern">
       <path wpts="1,2 S1"/>
       <path wpts="S1, S2 STDBY" approaching_time="1" pitch="auto" throttle="0.4"/>
       <deroute block="Standby"/>
     </block>
-    <block name="Land Right AF-TD" strip_button="Land right (wp AF-TD)" strip_icon="land-right.png">
+    <block name="Land Right AF-TD" strip_button="Land right (wp AF-TD)" strip_icon="land-right.png" group="land">
       <set value="DEFAULT_CIRCLE_RADIUS" var="nav_radius"/>
       <deroute block="land"/>
     </block>
-    <block name="Land Left AF-TD" strip_button="Land left (wp AF-TD)" strip_icon="land-left.png">
+    <block name="Land Left AF-TD" strip_button="Land left (wp AF-TD)" strip_icon="land-left.png" group="land">
       <set value="-DEFAULT_CIRCLE_RADIUS" var="nav_radius"/>
       <deroute block="land"/>
     </block>

conf/flight_plans/flight_plan.dtd

@@ -92,6 +92,7 @@ pre_call CDATA #IMPLIED
 post_call CDATA #IMPLIED
 strip_button CDATA #IMPLIED
 strip_icon CDATA #IMPLIED
+group CDATA #IMPLIED
 key CDATA #IMPLIED
 description CDATA #IMPLIED>
 

conf/settings/light.xml

@@ -4,8 +4,8 @@
   <dl_settings NAME="lights control">
     <dl_settings NAME="lights">
       <dl_setting var="strobe_light_mode" min="0" max="6" step="1" module="light/light" values="OFF|ON|BLINK_1|BLINK_2|BLINK_3|COMPLEX_1|COMPLEX_2">
-        <strip_button name="LightOn" icon="on.png" value="1"/>
+        <strip_button name="LightOn" icon="on.png" value="1" group="light"/>
-        <strip_button name="LightOff" icon="off.png" value="0"/>
+        <strip_button name="LightOff" icon="off.png" value="0" group="light"/>
       </dl_setting>
       <dl_setting var="nav_light_mode" min="0" max="4" step="1" values="OFF|ON|BLINK_1|BLINK_2|BLINK_3"/>
     </dl_settings>

conf/settings/settings.dtd

@@ -42,6 +42,7 @@ values CDATA #IMPLIED
 name CDATA #REQUIRED
 value CDATA #REQUIRED
 icon CDATA #IMPLIED
+group CDATA #IMPLIED
 >
 
 <!ATTLIST key_press

conf/settings/switchlight.xml

@@ -4,8 +4,8 @@
     <dl_settings NAME="Power switch control">
        <dl_settings NAME="Power switch">
       <dl_setting MAX="1" MIN="0" STEP="1" VAR="power_switch" module="autopilot" handler="SetPowerSwitch">
-        <strip_button name="Switch on" icon="on.png" value="0"/>
+        <strip_button name="Switch on" icon="on.png" value="0" group="switch_light"/>
-        <strip_button name="Switch off" icon="off.png" value="1"/>
+        <strip_button name="Switch off" icon="off.png" value="1" group="switch_light"/>
       </dl_setting>
     </dl_settings>
     </dl_settings>

sw/ground_segment/cockpit/live.ml

@@ -483,7 +483,8 @@ let create_ac = fun alert (geomap:G.widget) (acs_notebook:GPack.notebook) (ac_id
     end;
     try (* Is it a strip button ? *)
       let label = ExtXml.attrib block "strip_button"
-      and block_name = ExtXml.attrib block "name" in
+      and block_name = ExtXml.attrib block "name"
+      and group = ExtXml.attrib_or_default block "group" "" in
       let b =
 	try (* Is it an icon ? *)
 	  let icon = Xml.attrib block "strip_icon" in
@@ -507,7 +508,7 @@ let create_ac = fun alert (geomap:G.widget) (acs_notebook:GPack.notebook) (ac_id
 	    fprintf stderr "Error: '%s' Using a standard button" (Printexc.to_string exc);
 	    GButton.button ~label ()
       in
-      strip#add_widget b#coerce;
+      strip#add_widget b#coerce ~group;
       ignore (b#connect#clicked (fun _ -> jump_to_block ac_id id))
     with
        _ -> ())
@@ -562,7 +563,7 @@ let create_ac = fun alert (geomap:G.widget) (acs_notebook:GPack.notebook) (ac_id
   let dl_settings_page =
     try
       let xml_settings = Xml.children (ExtXml.child settings_xml "dl_settings") in
-      let settings_tab = new Page_settings.settings ~visible xml_settings dl_setting_callback (fun x -> strip#add_widget x) in
+      let settings_tab = new Page_settings.settings ~visible xml_settings dl_setting_callback (fun group x -> strip#add_widget ~group x) in
 
       (** Connect key shortcuts *)
       let key_press = fun ev ->

sw/ground_segment/cockpit/page_settings.ml

@@ -188,7 +188,8 @@ let one_setting = fun (i:int) (do_change:int -> float -> unit) packing dl_settin
     match String.lowercase (Xml.tag x) with
       "strip_button" ->
 	let label = ExtXml.attrib x "name"
-	and sp_value = ExtXml.float_attrib x "value" in
+	and sp_value = ExtXml.float_attrib x "value"
+        and group = ExtXml.attrib_or_default x "group" "" in
 	let b =
 	  try (* Is it an icon ? *)
 	    let icon = Xml.attrib x "icon" in
@@ -211,7 +212,7 @@ let one_setting = fun (i:int) (do_change:int -> float -> unit) packing dl_settin
 	  | exc -> 
 	      prerr_endline (Printexc.to_string exc);
 	      GButton.button ~label () in
-	(strip b#coerce : unit);
+	(strip group b#coerce: unit);
 	ignore (b#connect#clicked (fun _ -> do_change i sp_value))
     | "key_press" -> add_key x (do_change i) keys
     | t -> failwith (sprintf "Page_settings.one_setting, Unexpected tag: '%s'" t))

sw/ground_segment/cockpit/page_settings.mli

@@ -25,7 +25,7 @@
 *)
 
 (** [new Page_settings.settings ?visible dl_settings callback short_button_receiver] *)
-class settings : ?visible:(GObj.widget -> bool) -> Xml.xml list -> (int -> float -> unit) -> (GObj.widget -> unit) ->
+class settings : ?visible:(GObj.widget -> bool) -> Xml.xml list -> (int -> float -> unit) -> (string -> GObj.widget -> unit) ->
   object
     method length : int (** Total number of settings *)
     method set : int -> float -> unit (** Set the current value *)

sw/ground_segment/cockpit/strip.ml

@@ -30,7 +30,7 @@ module LL=Latlong
 let (//) = Filename.concat
 
 type t =
-    < add_widget : GObj.widget -> unit;
+    < add_widget : ?group:string -> GObj.widget -> unit;
       connect_shift_alt : (float -> unit) -> unit;
       connect_shift_lateral : (float -> unit) -> unit;
       connect_launch : (float -> unit) -> unit;
@@ -301,6 +301,7 @@ let add = fun config strip_param ->
 
    object
     val mutable climb = 0.
+    val mutable button_tbl = Hashtbl.create 10
     method set_climb = fun v -> climb <- v
     method set_agl value = 
       let arrow = max (min 0.5 (climb /. 5.)) (-0.5) in
@@ -321,7 +322,19 @@ let add = fun config strip_param ->
 
     method set_label name value = set_label !strip_labels name value
     method set_color name value = set_color !strip_labels name value
-    method add_widget w = strip#hbox_user#pack ~fill:false w
+    (* add a button widget in a vertical box if it belongs to a group (create new group if needed) *)
+    method add_widget ?(group="") w =
+      let (vbox, pack) = match String.length group with
+          0 -> (GPack.vbox ~show:true (), true)
+        | _ -> try (Hashtbl.find button_tbl group, false) with
+                Not_found ->
+                  let vb = GPack.vbox ~show:true () in
+                  ignore(Hashtbl.add button_tbl group vb);
+                  (vb, true)
+      in
+      (*let vbox = GPack.vbox ~show:true () in*)
+      vbox#pack ~fill:false w;
+      if pack then strip#hbox_user#pack ~fill:false vbox#coerce else ()
     
     method connect_shift_alt callback = 
       let tooltips = GData.tooltips () in

sw/ground_segment/cockpit/strip.mli

@@ -25,7 +25,7 @@
  *)
 
 type t = <
-    add_widget : GObj.widget -> unit;
+    add_widget : ?group:string -> GObj.widget -> unit;
     (** Add a user widget in the low row of the strip *)
 
     connect_shift_alt : (float -> unit) -> unit;