diff --git a/sw/ground_segment/cockpit/gcs.ml b/sw/ground_segment/cockpit/gcs.ml index 5c80728e62..7a55c42643 100644 --- a/sw/ground_segment/cockpit/gcs.ml +++ b/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 diff --git a/sw/ground_segment/cockpit/live.ml b/sw/ground_segment/cockpit/live.ml index 10c6299fee..fa0cc1773f 100644 --- a/sw/ground_segment/cockpit/live.ml +++ b/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 diff --git a/sw/ground_segment/cockpit/pages.ml b/sw/ground_segment/cockpit/pages.ml index 87ee76980a..8b2fc7fb82 100644 --- a/sw/ground_segment/cockpit/pages.ml +++ b/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 (*****************************************************************************) diff --git a/sw/ground_segment/cockpit/pages.mli b/sw/ground_segment/cockpit/pages.mli index 15105c814a..407954acfd 100644 --- a/sw/ground_segment/cockpit/pages.mli +++ b/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 diff --git a/sw/lib/ocaml/extXml.ml b/sw/lib/ocaml/extXml.ml index 90792827ba..cdb63d0b1c 100644 --- a/sw/lib/ocaml/extXml.ml +++ b/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)) diff --git a/sw/lib/ocaml/extXml.mli b/sw/lib/ocaml/extXml.mli index 4fcddaf367..a629d68e2f 100644 --- a/sw/lib/ocaml/extXml.mli +++ b/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. *)