diff --git a/conf/flight_plans/basic.xml b/conf/flight_plans/basic.xml
index acbbaf022e..3f421d8d14 100644
--- a/conf/flight_plans/basic.xml
+++ b/conf/flight_plans/basic.xml
@@ -18,7 +18,9 @@
-
+
+
+
@@ -29,47 +31,47 @@
+
-
+
-
+
-
+
-
+
-
+
-
-
+
-
+
-
+
-
+
-
+
diff --git a/conf/flight_plans/flight_plan.dtd b/conf/flight_plans/flight_plan.dtd
index 25720efcc4..a82e24a31a 100644
--- a/conf/flight_plans/flight_plan.dtd
+++ b/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>
diff --git a/conf/settings/light.xml b/conf/settings/light.xml
index cc39474512..9a1691c98e 100644
--- a/conf/settings/light.xml
+++ b/conf/settings/light.xml
@@ -4,8 +4,8 @@
-
-
+
+
diff --git a/conf/settings/settings.dtd b/conf/settings/settings.dtd
index 847a4dffe5..25cda6c3be 100644
--- a/conf/settings/settings.dtd
+++ b/conf/settings/settings.dtd
@@ -42,6 +42,7 @@ values CDATA #IMPLIED
name CDATA #REQUIRED
value CDATA #REQUIRED
icon CDATA #IMPLIED
+group CDATA #IMPLIED
>
-
-
+
+
diff --git a/sw/ground_segment/cockpit/live.ml b/sw/ground_segment/cockpit/live.ml
index 1b343b9572..2701101087 100644
--- a/sw/ground_segment/cockpit/live.ml
+++ b/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 ->
diff --git a/sw/ground_segment/cockpit/page_settings.ml b/sw/ground_segment/cockpit/page_settings.ml
index f027e592c4..9a26d0c5a2 100644
--- a/sw/ground_segment/cockpit/page_settings.ml
+++ b/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))
diff --git a/sw/ground_segment/cockpit/page_settings.mli b/sw/ground_segment/cockpit/page_settings.mli
index 7e65339e44..87462dbf59 100644
--- a/sw/ground_segment/cockpit/page_settings.mli
+++ b/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 *)
diff --git a/sw/ground_segment/cockpit/strip.ml b/sw/ground_segment/cockpit/strip.ml
index e19432b07c..bb69d1c5e8 100644
--- a/sw/ground_segment/cockpit/strip.ml
+++ b/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
diff --git a/sw/ground_segment/cockpit/strip.mli b/sw/ground_segment/cockpit/strip.mli
index 2d32b24c19..03b58f3392 100644
--- a/sw/ground_segment/cockpit/strip.mli
+++ b/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;