misc bug fixes

sw/ground_segment/cockpit/gcs.ml

@@ -45,12 +45,11 @@ let auto_center_new_ac = ref false
 let no_alarm = ref false
 
 
-
 (** Display a calibrated (XML) map *)
 let display_map = fun (geomap:G.widget) xml_map ->
   try
     let dir = Filename.dirname xml_map in
-    let xml_map = Xml.parse_file xml_map in
+    let xml_map = ExtXml.parse_file xml_map in
     let image = dir // ExtXml.attrib xml_map "file" in
     let map_projection = Xml.attrib xml_map "projection" in
     let opacity = try Some (int_of_string (Xml.attrib xml_map "opacity")) with _ -> None in

sw/ground_segment/cockpit/live.ml

@@ -237,7 +237,7 @@ let create_ac = fun (geomap:G.widget) (acs_notebook:GPack.notebook) (ac_id:strin
   (** Get the flight plan **)
   let fp_url = Pprz.string_assoc "flight_plan" config in
   let fp_file = Http.file_of_url fp_url in
-  let fp_xml_dump = Xml.parse_file fp_file in
+  let fp_xml_dump = ExtXml.parse_file ~noprovedtd:true fp_file in
   let stages = ExtXml.child fp_xml_dump "stages" in
   let blocks = blocks_of_stages stages in
 
@@ -349,7 +349,7 @@ let create_ac = fun (geomap:G.widget) (acs_notebook:GPack.notebook) (ac_id:strin
   let settings_file = Http.file_of_url settings_url in
   let settings_xml = 
     try
-      Xml.parse_file settings_file
+      ExtXml.parse_file ~noprovedtd:true settings_file
     with exc ->
       prerr_endline (Printexc.to_string exc);
       Xml.Element("empty", [], [])
@@ -425,6 +425,7 @@ let one_new_ac = fun (geomap:G.widget) fp_notebook ac ->
 let get_wind_msg = fun _sender vs ->
   let ac = get_ac vs in
   let value = fun field_name -> sprintf "%.1f" (Pprz.float_assoc field_name vs) in
+  ac.misc_page#set_mean_aspeed (value "mean_aspeed");
   ac.misc_page#set_wind_speed (value "wspeed");
   ac.misc_page#set_wind_dir (value "dir")
 
@@ -717,7 +718,6 @@ let listen_telemetry_status = fun () ->
 
 let listen_error = fun a ->
   let get_error = fun _sender vs ->
-    let ac = get_ac vs
-    and msg = Pprz.string_assoc "message" vs in
+    let msg = Pprz.string_assoc "message" vs in
     log_and_say a msg in
   safe_bind "TELEMETRY_ERROR" get_error

sw/ground_segment/cockpit/pages.ml

@@ -104,19 +104,19 @@ end
 (* gps page                                                                  *)
 (*****************************************************************************)
 class gps ?(visible = fun _ -> true) (widget: GBin.frame) =
+  let sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ~packing:widget#add () in
   let table = GPack.table
       ~rows: 1
       ~columns: 3
       ~row_spacings: 5
       ~col_spacings: 40
-      ~packing: widget#add
+      ~packing:sw#add_with_viewport
       () in
   let update_color = fun flags_eb flags ->
     let color = if flags land 0x01 = 1 then "green" else "red" in
     flags_eb#coerce#misc#modify_bg [`NORMAL, `NAME color] in
+
 object
-  val parent = widget
-  val table = table
   val mutable active_cno = []
   val mutable active_flags = []
 
@@ -161,7 +161,7 @@ end
 (*****************************************************************************)
 class misc ~packing (widget: GBin.frame) =
   let table = GPack.table
-      ~rows: 4
+      ~rows: 5
       ~columns: 2
       ~row_spacings: 5
       ~col_spacings: 40
@@ -172,11 +172,13 @@ class misc ~packing (widget: GBin.frame) =
     ignore (label "Wind speed" 0 0);
     ignore (label "Wind direction" 1 0);
     ignore (label "Wind east" 2 0);
-    ignore (label "Wind north" 3 0) in
+    ignore (label "Wind north" 3 0);
+    ignore (label "Mean airspeed" 4 0) in
   let wind_speed = label "" 0 1
   and wind_dir = label "" 1 1
   and wind_east = label "" 2 1
-  and wind_north = label "" 3 1 in
+  and wind_north = label "" 3 1
+  and mean_aspeed = label "" 4 1 in
   let set_east_north = fun () ->
     let w = float_of_string wind_speed#text
     and a = (Deg>>Rad)(90. -. float_of_string wind_dir#text) in
@@ -185,6 +187,7 @@ class misc ~packing (widget: GBin.frame) =
   object
     method set_wind_speed s = wind_speed#set_text s
     method set_wind_dir s = wind_dir#set_text s; set_east_north ()
+    method set_mean_aspeed s = mean_aspeed#set_text s
   end
 
 (*****************************************************************************)

sw/ground_segment/cockpit/pages.mli

@@ -2,6 +2,7 @@ class alert : GBin.frame ->
   object
     method add : string -> unit
   end
+
 class infrared : GBin.frame ->
   object
     method set_contrast_status : string -> unit
@@ -9,6 +10,7 @@ class infrared : GBin.frame ->
     method set_gps_hybrid_factor : float -> unit
     method set_gps_hybrid_mode : string -> unit
   end
+
 class gps : ?visible:(GBin.frame -> bool) -> GBin.frame ->
   object
     method svsinfo : string -> string -> int -> unit
@@ -35,6 +37,7 @@ class misc :
   object
     method set_wind_dir : string -> unit
     method set_wind_speed : string -> unit
+    method set_mean_aspeed : string -> unit
   end
 
 type rc_mode = string

sw/lib/ocaml/extXml.ml

@@ -132,10 +132,19 @@ let int_attrib = fun xml a ->
     _ -> failwith (Printf.sprintf "Error: integer expected in '%s'" v)
 
 
+(* When an .xml is coming through http, the dtd is not available. We disable
+the DTD proving feature in this case. FIXME: We should use the resolve
+feature *)
+let my_xml_parse_file =
+  let parser = XmlParser.make () in
+  XmlParser.prove parser false;
+  fun f ->
+    XmlParser.parse parser (XmlParser.SFile f)
 
-let parse_file = fun file ->
+
+let parse_file = fun ?(noprovedtd = false) file ->
   try
-    Xml.parse_file file
+    (if noprovedtd then my_xml_parse_file else Xml.parse_file) file
   with
     Xml.Error e -> failwith (Printf.sprintf "%s: %s" file (Xml.error e))
   | Dtd.Prove_error e -> failwith (Printf.sprintf "%s: %s" file (Dtd.prove_error e))

sw/lib/ocaml/extXml.mli

@@ -58,5 +58,5 @@ val subst_attrib : string -> string -> Xml.xml -> Xml.xml
 val subst_child : string -> Xml.xml -> Xml.xml -> Xml.xml
 (** [subst_child child_tag new_child xml] *)
 
-val parse_file : string -> Xml.xml
-(** Identical to Xml.parse_file with Failure exceptions *)
+val parse_file : ?noprovedtd:bool -> string -> Xml.xml
+(** Identical to Xml.parse_file with Failure exceptions. [nodtdprove] default is false. *)