file splitting

sw/ground_segment/cockpit/Makefile

@@ -29,20 +29,21 @@ 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=horizon.ml pages.ml map2d.ml
+ML= speech.ml horizon.ml pages.ml strip.ml plugin.ml sectors.ml map2d.ml editFP.ml live.ml gcs.ml
+MAIN=gcs
 CMO=$(ML:.ml=.cmo)
 CMX=$(ML:.ml=.cmx)
 
-all : map2d
+all : $(MAIN)
 
-opt : map2d.opt
+opt : $(MAIN).opt
 
 
-map2d : $(CMO)
+$(MAIN) : $(CMO)
 	@echo OL $@
 	$(Q)$(OCAMLC) -custom $(INCLUDES) $(LIBS) threads.cma gtkThread.cmo gtkInit.cmo $(CMO) -o $@
 
-map2d.opt : $(CMX)
+$(MAIN).opt : $(CMX)
 	@echo OOL $@
 	$(Q)$(OCAMLOPT) $(INCLUDES) str.cmxa unix.cmxa xml-light.cmxa $(LIBS:.cma=.cmxa) threads.cmxa gtkThread.cmx gtkInit.cmx $(CMX) -o $@
 
@@ -50,15 +51,22 @@ map2d.opt : $(CMX)
 %.cmo: %.ml  ../../lib/ocaml/lib-pprz.cma ../../lib/ocaml/xlib-pprz.cma
 	@echo OC $<
 	$(Q)$(OCAMLC) $(INCLUDES) -c $<
-%.cmi: %.mli
+%.cmi: %.mli  ../../lib/ocaml/lib-pprz.cma ../../lib/ocaml/xlib-pprz.cma
 	@echo OCI $<
 	$(Q)$(OCAMLC) $(INCLUDES) -c $<
 %.cmx: %.ml
 	@echo OOC $<
 	$(Q)$(OCAMLOPT) $(INCLUDES) -c $<
 
-map2d.cmo : pages.cmi
+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
+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

sw/ground_segment/cockpit/editFP.ml

@@ -0,0 +1,299 @@
+(***************** Editing ONE (single) flight plan **************************)open Printf
+open Latlong
+
+module G2D = Geometry_2d
+
+
+let (//) = Filename.concat
+let fp_example = Env.flight_plans_path // "example.xml"
+let default_path_maps =  Env.paparazzi_home // "data" // "maps"
+
+(** Dummy flight plan (for map calibration) *)
+let dummy_fp = fun latlong ->
+  Xml.Element("flight_plan",
+	      ["lat0", string_of_float ((Rad>>Deg)latlong.posn_lat);
+	       "lon0", string_of_float ((Rad>>Deg)latlong.posn_long);
+	       "alt", "42.";
+	       "MAX_DIST_FROM_HOME", "1000."],
+	      [Xml.Element("waypoints", [],[])])
+
+
+
+let current_fp = ref None
+
+    (** Wrapper checking there is currently no flight plan loaded *)
+let if_none = fun f ->
+  match !current_fp with
+    Some _ ->
+      GToolbox.message_box "Error" "Only one editable flight plan at a time"
+  | None ->
+      f ()
+
+
+let close_fp = fun () ->
+  match !current_fp with
+    None -> () (* Nothing to close *)
+  | Some (fp, _filename, window) ->
+      window#destroy ();
+      fp#destroy ();
+      current_fp := None
+	  
+let load_xml_fp = fun geomap accel_group ?(xml_file=Env.flight_plans_path) xml ->
+  Map2d.set_georef_if_none geomap (MapFP.georef_of_xml xml);
+  let fp = new MapFP.flight_plan ~show_moved:false geomap "red" Env.flight_plan_dtd xml in
+  let window = GWindow.window ~title:"Flight Plan" () in
+  window#set_default_size ~width:700 ~height:250;
+  window#add fp#window;
+  window#add_accel_group accel_group;
+  window#show();
+  ignore (window#connect#destroy ~callback:close_fp);
+  current_fp := Some (fp,xml_file, window);
+  fp
+
+let labelled_entry = fun ?width_chars text value h ->
+  let _ = GMisc.label ~text ~packing:h#add () in
+  GEdit.entry ?width_chars ~text:value ~packing:h#add ()
+
+let new_fp = fun geomap accel_group () ->
+  if_none (fun () ->
+    let dialog = GWindow.window ~border_width:10 ~title:"New flight plan" () in
+    let dvbx = GPack.box `VERTICAL ~packing:dialog#add () in
+    let h = GPack.hbox ~packing:dvbx#pack () in
+    let default_latlong =
+      match geomap#georef with
+	None -> "WGS84 37.21098 -113.45678"
+      | Some geo -> Latlong.string_of geo in
+    let latlong  = labelled_entry ~width_chars:25 "Geographic Reference" default_latlong h in
+    let alt0 = labelled_entry ~width_chars:4 "Ground Alt" "380" h in
+    let h = GPack.hbox ~packing:dvbx#pack () in
+    let alt = labelled_entry ~width_chars:4 "Default Alt" "430" h in
+    let qfu = labelled_entry ~width_chars:4 "QFU" "270" h in
+    let mdfh = labelled_entry ~width_chars:4 "Max distance from HOME" "500" h in
+    
+    let h = GPack.hbox ~packing:dvbx#pack () in
+    let name  = labelled_entry "Name" "Test flight" h in
+    
+    let h = GPack.hbox ~packing:dvbx#pack () in
+    let cancel = GButton.button ~stock:`CANCEL ~packing: h#add () in 
+    ignore(cancel#connect#clicked ~callback:dialog#destroy);
+
+    let createfp = GButton.button ~stock:`OK ~packing: h#add () in
+    createfp#grab_default ();
+    ignore(createfp#connect#clicked ~callback:
+	     begin fun _ ->
+	       let xml = Xml.parse_file fp_example in
+	       let s = ExtXml.subst_attrib in
+	       let wgs84 = Latlong.of_string latlong#text in
+	       let xml = s "lat0" (deg_string_of_rad wgs84.posn_lat) xml in
+	       let xml = s "lon0" (deg_string_of_rad wgs84.posn_long) xml in
+	       let xml = s "ground_alt" alt0#text xml in
+	       let xml = s "qfu" qfu#text xml in
+	       let xml = s "alt" alt#text xml in
+	       let xml = s "max_dist_from_home" mdfh#text xml in
+	       let xml = s "name" name#text xml in
+	       ignore (load_xml_fp geomap accel_group xml);
+	       dialog#destroy ()
+	     end);
+    dialog#show ())
+
+      
+(** Loading a flight plan for edition *)
+let load_fp = fun geomap accel_group () ->
+  if_none (fun () ->
+    match GToolbox.select_file ~title:"Open flight plan" ~filename:(Env.flight_plans_path // "*.xml") () with
+      None -> ()
+    | Some xml_file ->
+	try
+	  let xml = Xml.parse_file xml_file in
+	  ignore (load_xml_fp geomap accel_group ~xml_file xml)
+	with
+	  Dtd.Check_error(e) -> 
+	    let m = sprintf "Error while loading %s:\n%s" xml_file (Dtd.check_error e) in
+	    GToolbox.message_box "Error" m)
+
+let create_wp = fun geo ->
+  match !current_fp with
+    None -> 
+      GToolbox.message_box "Error" "Load a flight plan first";
+      failwith "create_wp"
+  | Some (fp,_,_) ->
+      fp#add_waypoint geo
+
+
+let save_fp = fun () ->
+  match !current_fp with
+    None -> () (* Nothing to save *)
+  | Some (fp, filename,_) ->
+      match GToolbox.select_file ~title:"Save Flight Plan" ~filename () with
+	None -> ()
+      | Some file -> 
+	  let f  = open_out file in
+	  fprintf f "%s\n" (Xml.to_string_fmt fp#xml);
+	  close_out f
+
+let ref_point_of_waypoint = fun xml ->
+  Xml.Element("point", ["x",Xml.attrib xml "x";
+			"y",Xml.attrib xml "y";
+			"geo", Xml.attrib xml "name"],[])
+
+
+(** Calibration of chosen image (requires a dummy flight plan) *)
+let calibrate_map = fun (geomap:MapCanvas.widget) accel_group () ->
+  match !current_fp with
+  | Some (_fp,_,_) ->  GToolbox.message_box "Error" "Close current flight plan before calibration"
+  | None ->
+      match GToolbox.select_file ~filename:default_path_maps ~title:"Open Image" () with
+	None -> ()
+      | Some image -> 
+	  (** Displaying the image in the NW corner *)
+	  let pixbuf = GdkPixbuf.from_file image in
+	  let pix = GnoCanvas.pixbuf ~pixbuf ~props:[`ANCHOR `NW] geomap#canvas#root in
+	  let (x0, y0) = geomap#canvas#get_scroll_offsets in
+	  let (x,y) = geomap#canvas#window_to_world (float x0) (float y0) in
+	  pix#move x y;
+
+	  (** Open a dummy flight plan *)
+	  let dummy_georef =
+	    match geomap#georef with
+	      None -> {posn_lat = (Deg>>Rad)43.; posn_long = (Deg>>Rad)1. }
+	    | Some geo -> geo in
+	  let fp_xml = dummy_fp dummy_georef in
+	  let fp = load_xml_fp geomap accel_group fp_xml in
+	  
+	  (** Dialog to finish calibration *)
+	  let dialog = GWindow.window ~border_width:10 ~title:"Map calibration" () in
+	  let v = GPack.vbox ~packing:dialog#add () in
+	  let _ = GMisc.label ~text:"Choose 2 (or more) waypoints (Ctrl-Left)\nRename the waypoints with their geographic coordinates\nFor example: 'WGS84 43.123456 1.234567' or 'UTM 530134 3987652 12' or 'LBT2e 123456 543210'\nClick the button below to save the XML result file\n" ~packing:v#add () in
+	  let h = GPack.hbox ~packing:v#pack () in
+	  let cancel = GButton.button ~stock:`CLOSE ~packing:h#add () in
+	  let cal = GButton.button ~stock:`OK ~packing:h#add () in
+	  let destroy = fun () ->
+	    dialog#destroy ();
+	    close_fp ();
+	    pix#destroy () in
+	  ignore(cancel#connect#clicked ~callback:destroy);
+	  ignore(cal#connect#clicked ~callback:(fun _ ->
+	    let points = List.map XmlEdit.xml_of_node fp#waypoints in
+	    let points = List.map ref_point_of_waypoint points in
+	    let xml = Xml.Element ("map", 
+				   ["file", Filename.basename image;
+				    "projection", geomap#projection],
+				   points) in
+	    match GToolbox.select_file ~filename:(default_path_maps//".xml") ~title:"Save calibrated map" () with
+	      None -> ()
+	    | Some xml_file ->
+		let f = open_out xml_file in
+		Printf.fprintf f "%s\n" (Xml.to_string_fmt xml);
+		close_out f));
+	  cal#grab_default ();
+	  dialog#show ()
+
+let radius = ref 30.
+let path = ref (ref [])
+let cur_arc = ref None
+and cur_seg = ref None
+and cur_f = ref { G2D.x2D = 0.; y2D = 0. }
+
+let set_segment = fun s p1 p2 ->
+  let x1 = p1.G2D.x2D and y1 = p1.G2D.y2D
+  and x2 = p2.G2D.x2D and y2 = p2.G2D.y2D in
+  s#set [`POINTS [|x1;y1;x2;y2|]]
+
+let arc_from_points = fun (geomap:MapCanvas.widget) c l f s ->
+  let cl = G2D.vect_make c l
+  and cf = G2D.vect_make c f in
+  let pol_cl = G2D.cart2polar cl in
+  let al = pol_cl.G2D.theta2D
+  and af = (G2D.cart2polar cf).G2D.theta2D in
+  let xc = c.G2D.x2D and yc = c.G2D.y2D in
+  let (a1, a2) = if s > 0. then (al, af) else (af, al) in
+  geomap#arc ~nb_points:10 ~fill_color:"blue" ~width:2 (xc,yc) pol_cl.G2D.r2D a1 a2
+
+    (** Update path after waypoint move *)
+let update_path = fun (geomap:MapCanvas.widget) path waypoint ->
+  let n = waypoint#name in
+  let rec loop = function
+      [] -> failwith (sprintf "update_path: %s not found" n)
+    | [p] -> [p]
+    | (wp, Some arc, Some seg, _f, radius)::wps ->
+	let new_wps = if wp#name = waypoint#name then wps else loop wps in
+	begin
+	  match new_wps with
+	    [] -> failwith "unreachable"
+	  | (wp1, _arc1, _seg1, f1, _r1)::new_wps' -> (* Previous *)
+	      let wp1_2D = geomap#pt2D_of wp1#pos
+	      and wp_2D = geomap#pt2D_of wp#pos in
+	      match new_wps' with
+		[] -> (* wp is the second point: simple segment *)
+		  set_segment seg wp1_2D wp_2D;
+		  (wp, Some arc, Some seg, wp1_2D, radius)::new_wps
+	      | _ -> (* At least 2 points before *)
+		  let (c, f, s) = G2D.arc_segment f1 wp1_2D wp_2D radius in
+		  set_segment seg f wp_2D;
+		  arc#destroy ();
+		  let new_arc = arc_from_points geomap c wp1_2D f s in
+		  (wp, Some new_arc, Some seg, f, radius)::new_wps
+	end
+    | _ -> failwith "update_path" in
+  path := loop !path
+
+      
+
+let path_button = fun (geomap:MapCanvas.widget) (xw, yw) ->
+  let geo = geomap#of_world (xw, yw) in
+  let wp = create_wp geo in
+  let cur_path = !path in
+  wp#connect (fun () -> update_path geomap cur_path wp);
+  if ! !path = [] then
+    cur_f := {G2D.x2D=xw; G2D.y2D=yw};
+  cur_path := (wp, !cur_arc, !cur_seg, !cur_f, !radius) :: ! cur_path;
+  cur_arc := Some (GnoCanvas.line geomap#canvas#root);
+  cur_seg := Some (geomap#segment ~fill_color:"blue" ~width:2 geo geo)
+
+let path_notify (geomap:MapCanvas.widget) (xw, yw) =
+  match ! !path with
+    [] -> false (** Empty path: nothing to do *)
+  | (wp1, _, _, ll,_) :: p -> (** Last is wp1 *)
+      begin
+	match !cur_seg with
+	  None -> failwith "path_notify"
+	| Some segment -> 
+	    let l = geomap#pt2D_of wp1#pos
+	    and cur_2D = {G2D.x2D = xw; y2D = yw } in
+	    match p with
+	      [] -> (** Only 1 point in the current path:add a simple segment*)
+		set_segment segment l cur_2D;
+	    | _::_ -> (** Already 2 points: add an arc and a segment *)
+		match !cur_arc with
+		  None -> failwith "path_notify"
+		| Some arc ->
+		    arc#destroy ();
+		    let (c, f, s) = G2D.arc_segment ll l cur_2D !radius in
+		    set_segment segment f cur_2D;
+		    let arc = arc_from_points geomap c l f s in
+		    cur_arc := Some arc;
+		    cur_f := f
+      end;	    
+      true
+
+	
+let path_close = fun () ->
+  let destroy = fun ref ->
+    match !ref with
+      None -> () 
+    | Some s -> s#destroy (); ref := None in
+  destroy cur_arc;
+  destroy cur_seg;
+  begin
+    match !current_fp with
+      None -> ()
+    | Some (fp, _,_) ->
+	fp#insert_path (List.map (fun (wp,_,_,_,r) -> (wp, r)) (List.rev ! !path));
+  end;
+  path := ref []
+
+let path_change_radius = function
+    `UP -> radius := !radius *. 1.1
+  | `DOWN -> radius := !radius /. 1.1
+  | _ -> ()
+

sw/ground_segment/cockpit/editFP.mli

@@ -0,0 +1,11 @@
+val path_button :
+  MapCanvas.widget -> MapCanvas.LL.fmeter * MapCanvas.LL.fmeter -> unit
+val path_notify : MapCanvas.widget -> float * float -> bool
+val path_close : unit -> unit
+val path_change_radius : [> `DOWN | `UP ] -> unit
+val create_wp : MapCanvas.LL.geographic -> MapWaypoints.waypoint
+val calibrate_map : MapCanvas.widget -> Gtk.accel_group -> unit -> unit
+val new_fp : MapCanvas.widget -> Gtk.accel_group -> unit -> unit
+val load_fp : MapCanvas.widget -> Gtk.accel_group -> unit -> unit
+val save_fp : unit -> unit
+val close_fp : unit -> unit

sw/ground_segment/cockpit/live.mli

@@ -0,0 +1,15 @@
+val message_request : string -> string -> Pprz.values -> (string -> Pprz.values -> unit) -> unit
+
+val aircrafts_msg : MapCanvas.widget -> GPack.notebook -> Pprz.values -> unit
+val safe_bind : string -> (string -> Pprz.values -> unit) -> unit
+val one_new_ac : MapCanvas.widget -> GPack.notebook -> string -> unit
+val listen_flight_params :
+  < center : MapCanvas.LL.geographic -> unit; .. > -> bool -> unit
+val listen_wind_msg : unit -> unit
+val listen_fbw_msg : unit -> unit
+val listen_engine_status_msg : unit -> unit
+val listen_if_calib_msg : unit -> unit
+val listen_waypoint_moved : unit -> unit
+val listen_infrared : unit -> unit
+val listen_svsinfo : unit -> unit
+val listen_alert : < add : string -> unit; .. > -> unit

sw/ground_segment/cockpit/map2d.mli

@@ -0,0 +1,25 @@
+(*
+* $Id$
+*
+* Copyright (C) 2004-2006 ENAC, Pascal Brisset, Antoine Drouin
+*
+* This file is part of paparazzi.
+*
+* paparazzi is free software; you can redistribute it and/or modify
+* it under the terms of the GNU General Public License as published by
+* the Free Software Foundation; either version 2, or (at your option)
+* any later version.
+*
+* paparazzi is distributed in the hope that it will be useful,
+* but WITHOUT ANY WARRANTY; without even the implied warranty of
+* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+* GNU General Public License for more details.
+*
+* You should have received a copy of the GNU General Public License
+* along with paparazzi; see the file COPYING.  If not, write to
+* the Free Software Foundation, 59 Temple Place - Suite 330,
+* Boston, MA 02111-1307, USA. 
+*
+*)
+
+val set_georef_if_none : MapCanvas.widget -> Latlong.geographic -> unit

sw/ground_segment/cockpit/plugin.ml

@@ -0,0 +1 @@
+let frame = ref (None: GBin.event_box option)

sw/ground_segment/cockpit/plugin.mli

@@ -0,0 +1 @@
+val frame : GBin.event_box option ref

sw/ground_segment/cockpit/sectors.ml

@@ -0,0 +1,41 @@
+(******** Sectors **********************************************************)
+
+open Printf
+
+let (//) = Filename.concat
+
+let rec display = fun (geomap:MapCanvas.widget) r ->
+  
+  match String.lowercase (Xml.tag r) with
+    "disc" ->
+      let rad = float_of_string (ExtXml.attrib r "radius")
+      and geo = Latlong.of_string (ExtXml.attrib (ExtXml.child r "point") "pos") in
+      ignore (geomap#circle ~width:5 ~color:"red" geo rad)
+  | "union" ->
+      List.iter (display geomap) (Xml.children r)
+  | "polygon" ->
+      let pts = List.map (fun x ->  Latlong.of_string (ExtXml.attrib x "pos")) (Xml.children r) in
+      let pts = Array.of_list pts in
+      let n = Array.length pts in
+      for i = 0 to n - 1 do
+	ignore (geomap#segment ~width:5 ~fill_color:"red" pts.(i) pts.((i+1)mod n))
+      done
+  |x -> fprintf stderr "Sector.display: '%s' not yet\n%!" x	    
+	
+
+let display_sector = fun (geomap:MapCanvas.widget) sector ->
+  display geomap (ExtXml.child sector "0")
+
+    
+let load = fun geomap () ->
+  match GToolbox.select_file ~title:"Load sectors" ~filename:(Env.flight_plans_path // "*.xml") () with
+    None -> ()
+  | Some f ->
+      try
+	let xml = Xml.parse_file f in
+	List.iter (display_sector geomap) (Xml.children xml)
+      with
+	Dtd.Prove_error(e) -> 
+	  let m = sprintf "Error while loading %s:\n%s" f (Dtd.prove_error e) in
+	  GToolbox.message_box "Error" m
+

sw/ground_segment/cockpit/sectors.mli

@@ -0,0 +1 @@
+val load : MapCanvas.widget -> unit -> unit

sw/ground_segment/cockpit/speech.ml

@@ -0,0 +1,5 @@
+let active = ref false
+
+let say = fun s ->
+  if !active then
+    ignore (Sys.command (Printf.sprintf "spd-say '%s'&" s))

sw/ground_segment/cockpit/speech.mli

@@ -0,0 +1,2 @@
+val active : bool ref
+val say : string -> unit

sw/ground_segment/cockpit/strip.ml

@@ -0,0 +1,103 @@
+(************ Strip handling ***********************************************)
+
+let bat_max = 13.
+let bat_min = 8.
+
+(** window for the strip panel *)
+let scrolled = GBin.scrolled_window ~width:300 ~hpolicy: `AUTOMATIC ~vpolicy: `AUTOMATIC ()
+let table = GPack.table ~rows: 1 ~columns: 1 ~row_spacings: 5 ~packing: (scrolled#add_with_viewport) ()
+
+
+type t = {
+    gauge: GRange.progress_bar ;
+    labels: (string * (GBin.event_box * GMisc.label)) list
+  }
+
+let labels_name =  [| 
+  [| "AP" ; "alt" ; "->" |]; [| "RC"; "climb"; "/" |]; [| "GPS"; "speed"; "" |];
+  [| "settings" ; "throttle"; "" |]
+|]
+
+let labels_print = [| 
+  [| "AP" ; "alt" ; "->" |]; [| "RC"; "climb"; "->" |]; [| "GPS"; "speed"; "" |];
+  [| "CAL" ; "throttle"; "" |]
+|]
+let gen_int = let i = ref (-1) in fun () -> incr i; !i
+
+let rows = Array.length labels_name + 1
+
+
+    (** add a strip to the panel *)
+let add config color select center_ac commit_moves mark =
+  let widget = table in
+  (* number of the strip *)
+  let strip_number = gen_int () in
+  if strip_number > 1 then widget#set_rows strip_number;
+
+  let strip_labels = ref  [] in
+  let add_label = fun name value -> 
+    strip_labels := (name, value) :: !strip_labels in
+
+  let ac_name = Pprz.string_assoc "ac_name" config in
+
+  (* 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
+  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
+  plane_color#coerce#misc#modify_bg [`NORMAL, `NAME color];
+  ignore (plane_color#event#connect#button_press ~callback:(fun _ -> select (); true));
+  let h = GPack.hbox ~packing:plane_color#add () in
+  let ft = GMisc.label ~text: "00:00:00" ~packing:h#add () in
+  ft#set_width_chars 8;
+  add_label ("flight_time_value") (plane_color, ft);
+  let block_name = GMisc.label ~text: "______" ~packing:h#add () in
+  add_label ("block_name_value") (plane_color, block_name);
+
+
+  (* battery and flight time *)
+  let pb = GRange.progress_bar ~orientation: `BOTTOM_TO_TOP ~packing:(strip#attach ~top:1 ~left:0) () in
+  pb#coerce#misc#modify_fg [`PRELIGHT, `NAME "green"];
+  pb#coerce#misc#modify_font_by_name "sans 12";
+  
+  let left_box = GPack.table ~rows ~columns: 6 ~col_spacings: 5 
+      ~packing: (strip#attach ~top: 1 ~left: 1) () in
+
+  Array.iteri 
+    (fun i a ->
+      Array.iteri
+	(fun j s ->
+	  ignore (GMisc.label ~text: labels_print.(i).(j) ~justify:`RIGHT ~packing: (left_box#attach ~top: i ~left: (2*j)) ());
+	  let eb = GBin.event_box  ~packing: (left_box#attach ~top: i ~left: (2*j+1)) () in
+	  let lvalue = (GMisc.label ~text: "" ~justify: `RIGHT ~packing:eb#add ()) in
+	  lvalue#set_width_chars 6;
+	  add_label (s^"_value") (eb, lvalue);
+	) a
+    ) labels_name;
+  let b = GButton.button ~label:"Center A/C" ~packing:(left_box#attach ~top:4 ~left:0 ~right:2) () in
+  ignore(b#connect#clicked ~callback:center_ac);
+  let b = GButton.button ~label:"Commit WPs" ~packing:(left_box#attach ~top:4 ~left:2 ~right:4) () in
+  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}
+
+
+    (** set a label *)
+let set_label strip name value = 
+  let _eb, l = List.assoc (name^"_value") strip.labels in
+  l#set_label value
+
+    (** set a label *)
+let set_color strip name color = 
+  let eb, _l = List.assoc (name^"_value") strip.labels in
+  eb#coerce#misc#modify_bg [`NORMAL, `NAME color]
+
+    (** set the battery *)
+let set_bat strip value =
+  strip.gauge#set_text (string_of_float value);
+  let f = (value -. bat_min) /. (bat_max -. bat_min) in
+  let f = max 0. (min 1. f) in
+  strip.gauge#set_fraction f
+

sw/ground_segment/cockpit/strip.mli

@@ -0,0 +1,9 @@
+type t
+val add :
+  Pprz.values ->
+  string ->
+  (unit -> 'a) -> (unit -> unit) -> (unit -> unit) -> (unit -> unit) -> t
+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