diff --git a/sw/ground_segment/cockpit/editFP.ml b/sw/ground_segment/cockpit/editFP.ml index 4482832209..7ce46a84b6 100644 --- a/sw/ground_segment/cockpit/editFP.ml +++ b/sw/ground_segment/cockpit/editFP.ml @@ -64,7 +64,7 @@ let load_xml_fp = fun geomap editor_frame accel_group ?(xml_file=Env.flight_plan List.iter (fun w -> let (i, w) = fp#index w in - geomap#add_info_georef (sprintf "%s" w#name) (w :> < pos : geographic>)) + geomap#add_info_georef (sprintf "%s" w#name) w#pos) fp#waypoints; fp @@ -151,7 +151,7 @@ let create_wp = fun geomap geo -> failwith "create_wp" | Some (fp,_) -> let w = fp#add_waypoint geo in - geomap#add_info_georef (sprintf "%s" w#name) (w :> < pos : geographic>); + geomap#add_info_georef (sprintf "%s" w#name) w#pos; w diff --git a/sw/ground_segment/cockpit/gcs.ml b/sw/ground_segment/cockpit/gcs.ml index 7f0e5536f9..88f0ef058b 100644 --- a/sw/ground_segment/cockpit/gcs.ml +++ b/sw/ground_segment/cockpit/gcs.ml @@ -345,9 +345,9 @@ let options = [ "-b", Arg.String (fun x -> ivy_bus := x), "Bus\tDefault is 127.255.255.25:2010"; "-maximize", Arg.Set maximize, "Maximize window"; "-fullscreen", Arg.Set fullscreen, "Fullscreen window"; - "-ref", Arg.Set_string geo_ref, "Geographic ref (default '')"; + "-ref", Arg.Set_string geo_ref, "Geographic ref (e.g. 'WGS84 43.605 1.443')"; "-zoom", Arg.Set_float zoom, "Initial zoom"; - "-center", Arg.Set_string center, "Initial map center"; + "-center", Arg.Set_string center, "Initial map center (e.g. 'WGS84 43.605 1.443')"; "-center_ac", Arg.Set auto_center_new_ac, "Centers the map on any new A/C"; "-track_size", Arg.Set_int Live.track_size, (sprintf "Default track length (%d)" !Live.track_size); "-plugin", Arg.Set_string plugin_window, "External X application (launched with the id of the plugin window as argument)"; diff --git a/sw/ground_segment/cockpit/live.ml b/sw/ground_segment/cockpit/live.ml index f17f61b9b8..5f659923fc 100644 --- a/sw/ground_segment/cockpit/live.ml +++ b/sw/ground_segment/cockpit/live.ml @@ -406,7 +406,7 @@ let create_ac = fun alert (geomap:G.widget) (acs_notebook:GPack.notebook) (ac_id List.iter (fun w -> let (i, w) = fp#index w in - geomap#add_info_georef (sprintf "%s.%s" name w#name) (w :> < pos : geographic>)) + geomap#add_info_georef (sprintf "%s.%s" name w#name) w#pos) fp#waypoints; (** Add the short cut buttons in the strip *) diff --git a/sw/lib/ocaml/latlong.ml b/sw/lib/ocaml/latlong.ml index 921c4620af..fd2d834933 100644 --- a/sw/lib/ocaml/latlong.ml +++ b/sw/lib/ocaml/latlong.ml @@ -67,6 +67,14 @@ let (>>) u1 u2 x = (x *. piradian u2) /. piradian u1;; let deg_string_of_rad = fun r -> Printf.sprintf "%.6f" ((Rad>>Deg)r) +let decimal d m s = float d +. float m /. 60. +. s /. 3600.;; +let dms = fun x -> + let d = truncate x in + let m = truncate ((x -. float d) *. 60.) in + let s = 3600. *. (x -. float d -. float m /. 60.) in + (d, m, s);; + + let sprint_degree_of_radian x = Printf.sprintf "%.6f" ((Rad>>Deg) x) @@ -74,6 +82,16 @@ let string_degrees_of_geographic sm = Printf.sprintf "%s\t%s" (sprint_degree_of_radian sm.posn_lat) (sprint_degree_of_radian sm.posn_long) +let string_dms_of_geographic = fun geo -> + let hemi = if geo.posn_lat >= 0. then 'N' else 'S' + and east = if geo.posn_long >= 0. then 'E' else 'W' + and lat = abs_float geo.posn_lat + and lon = abs_float geo.posn_long in + let (lat_d, lat_m, lat_s) = dms ((Rad>>Deg) lat) + and (lon_d, lon_m, lon_s) = dms ((Rad>>Deg) lon) in + Printf.sprintf "%2d %02d' %02.1f\" %c\t%2d %02d' %02.1f\" %c" + lat_d lat_m lat_s hemi lon_d lon_m lon_s east + let of_semicircle x = { posn_lat = (Semi>>Rad) x.lat ; posn_long = (Semi>>Rad) x.long } @@ -81,13 +99,6 @@ let of_semicircle x = let semicircle_of x = { lat = (Rad>>Semi) x.posn_lat ; long = (Rad>>Semi) x.posn_long } -let decimal d m s = float d +. float m /. 60. +. s /. 3600.;; -let dms x = - let d = truncate x in - let m = truncate ((x -. float d) *. 60.) in - let s = 3600. *. (x -. float d -. float m /. 60.) in - (d, m, s);; - type ellipsoid = { dx : float; dy : float; dz : float; a : float; df : float; e : float } @@ -411,14 +422,26 @@ let lbt_add = fun {lbt_x=x; lbt_y=y} (dx, dy) -> let lbt_sub = fun {lbt_x=x1; lbt_y=y1} {lbt_x=x2; lbt_y=y2} -> (float (x1-x2), float (y1-y2)) -let space = Str.regexp "[ \t]+" +let space = Str.regexp "[ \t\'\"]+" let fos = float_of_string -let ios = int_of_string +let ios = fun x -> try int_of_string x with _ -> failwith (Printf.sprintf "int_of_string: %s" x) let rodg = fun s -> (Deg>>Rad)(fos s) let of_string = fun s -> match Str.split space s with ["WGS84"; lat; long] -> make_geo (rodg lat) (rodg long) + | ["WGS84_dms"; lat_d; lat_m; lat_s; hemi; lon_d; lon_m; lon_s; east_west] -> + let sign_hemi = + match hemi with + "N" -> 1. | "S" -> -1. + | _ -> failwith (Printf.sprintf "N or S expected for hemispere in dms, found '%s'" hemi) in + let sign_east = + match east_west with + "E" -> 1. | "W" -> -1. + | _ -> failwith (Printf.sprintf "E or W expected for hemispere in dms, found '%s'" east_west) in + let lat = sign_hemi *. decimal (ios lat_d) (ios lat_m) (fos lat_s) + and lon = sign_east *. decimal (ios lon_d) (ios lon_m) (fos lon_s) in + make_geo ((Deg>>Rad) lat) ((Deg>>Rad) lon) | ["WGS84_bearing"; lat; long; dir; dist] -> let utm_ref = utm_of WGS84 (make_geo (rodg lat) (rodg long)) in let dir = rodg dir and dist = fos dist in @@ -462,3 +485,32 @@ let get_gps_tow = fun () -> let unix_time_of_tow = fun tow -> let host_tow = get_gps_tow () in Unix.gettimeofday () +. float (tow - host_tow) + + +type coordinates_kind = + WGS84_dec + | WGS84_dms + | Bearing of geographic + + +let string_of_coordinates = fun kind geo -> + match kind with + WGS84_dec -> + string_degrees_of_geographic geo + | WGS84_dms -> + string_dms_of_geographic geo + | Bearing georef -> + let (dx, dy) = utm_sub (utm_of WGS84 geo) (utm_of WGS84 georef) in + let d = sqrt (dx*.dx+.dy*.dy) in + let bearing = (int_of_float ((Rad>>Deg)(atan2 dx dy)) + 360) mod 360 in + Printf.sprintf "%4d %4.0f" bearing d + +let geographic_of_coordinates = fun kind s -> + match kind with + WGS84_dec -> + of_string ("WGS84 " ^ s) + | WGS84_dms -> + of_string ("WGS84_dms " ^ s) + | Bearing georef -> + of_string (Printf.sprintf "WGS84_bearing %s %s" (string_degrees_of_geographic georef) s) + diff --git a/sw/lib/ocaml/latlong.mli b/sw/lib/ocaml/latlong.mli index 110a4800e8..044a6b888e 100644 --- a/sw/lib/ocaml/latlong.mli +++ b/sw/lib/ocaml/latlong.mli @@ -81,6 +81,7 @@ val make_geo : float -> float -> geographic (** [make_geo lat long] *) val string_degrees_of_geographic : geographic -> string +val string_dms_of_geographic : geographic -> string (** Pretty printing *) @@ -155,3 +156,11 @@ val get_gps_tow : unit -> int (** Returns the current GPS time of week in seconds *) val unix_time_of_tow : int -> float + +type coordinates_kind = + WGS84_dec + | WGS84_dms + | Bearing of geographic + +val string_of_coordinates : coordinates_kind -> geographic -> string +val geographic_of_coordinates : coordinates_kind -> string -> geographic diff --git a/sw/lib/ocaml/mapCanvas.ml b/sw/lib/ocaml/mapCanvas.ml index 81a920942e..3485fdc942 100644 --- a/sw/lib/ocaml/mapCanvas.ml +++ b/sw/lib/ocaml/mapCanvas.ml @@ -353,12 +353,7 @@ class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef ( and long = wx /. mercator_coeff +. georef.LL.posn_long in LL.make_geo lat long end - | None -> failwith "#of_world : no georef" - - - method geo_string = fun wgs84 -> - LL.string_degrees_of_geographic wgs84 - + | None -> failwith "#of_world : no georef" method move_item = fun (item:GnomeCanvas.re_p GnoCanvas.item) wgs84 -> let (xw,yw) = self#world_of wgs84 in @@ -638,7 +633,7 @@ class widget = fun ?(height=800) ?width ?projection ?georef () -> val mutable utm_grid_group = None val mutable georefs = [] - val mutable selected_georef = None + val mutable selected_georef = WGS84_dec method pack_labels = self#info#pack lbl_xy#coerce; @@ -671,8 +666,9 @@ class widget = fun ?(height=800) ?width ?projection ?georef () -> ignore (GMisc.image ~stock:(`STOCK "gtk-zoom-fit") ~packing:b#add ()); tooltips#set_tip b#coerce ~text:"Fit to window"; - let callback = fun () -> selected_georef <- None in - my_menu_item "WGS84" ~packing:georef_menu#append ~callback (); + let set = fun x () -> selected_georef <- x in + my_menu_item "WGS84" ~packing:georef_menu#append ~callback:(set WGS84_dec) (); + my_menu_item "WGS84_dms" ~packing:georef_menu#append ~callback:(set WGS84_dms) (); optmenu#set_menu georef_menu ) @@ -726,19 +722,13 @@ class widget = fun ?(height=800) ?width ?projection ?georef () -> method add_info_georef = fun name geo -> georefs <- (name, geo) :: georefs; - let callback = fun () -> selected_georef <- Some geo in + let callback = fun () -> selected_georef <- Bearing geo in my_menu_item name ~packing:georef_menu#append ~callback (); (** display methods *) method display_xy = fun s -> lbl_xy#set_text s method display_geo = fun geo -> - match selected_georef with - None -> lbl_geo#set_text (self#geo_string geo) - | Some (georef:< pos : LL.geographic>) -> - let (dx, dy) = Latlong.utm_sub (LL.utm_of LL.WGS84 geo) (LL.utm_of LL.WGS84 georef#pos) in - let d = sqrt (dx*.dx+.dy*.dy) in - let bearing = (int_of_float ((Rad>>Deg)(atan2 dx dy)) + 360) mod 360 in - lbl_geo#set_text (sprintf "%4ddeg %4.0fm" bearing d) + lbl_geo#set_text (string_of_coordinates selected_georef geo) method display_alt = fun wgs84 -> diff --git a/sw/lib/ocaml/mapWaypoints.ml b/sw/lib/ocaml/mapWaypoints.ml index 4e4b862db8..2efdc69dde 100644 --- a/sw/lib/ocaml/mapWaypoints.ml +++ b/sw/lib/ocaml/mapWaypoints.ml @@ -31,13 +31,6 @@ open LL let s = 6. let losange = [|s;0.; 0.;s; -.s;0.; 0.;-.s|] - -let wgs84_of_string = fun georef s -> - match georef with - None -> LL.of_string ("WGS84 " ^ s) - | Some (georef:< pos : LL.geographic>) -> - LL.of_string (sprintf "WGS84_bearing %s %s" (LL.string_degrees_of_geographic georef#pos) s) - class group = fun ?(color="red") ?(editable=true) ?(show_moved=false) (geomap:MapCanvas.widget) -> let g = GnoCanvas.group geomap#canvas#root in object @@ -106,29 +99,35 @@ class waypoint = fun ?(show = true) (wpts_group:group) (name :string) ?(alt=0.) let dialog = GWindow.window ~position:`MOUSE ~border_width:10 ~title:"Waypoint Edit" () in let dvbx = GPack.box `VERTICAL ~packing:dialog#add () in - let wgs84 = self#pos in - let s = sprintf "%s" (geomap#geo_string wgs84) in let ename = GEdit.entry ~text:name ~editable ~packing:dvbx#add () in let hbox = GPack.hbox ~packing:dvbx#add () in let optmenu = GMenu.option_menu ~packing:hbox#add () in - let e_pos = GEdit.entry ~text:s ~packing:hbox#add () in + let e_pos = GEdit.entry ~packing:hbox#add () in (* We would like to share the menu of the map: it does not work ! *) - let selected_georef = ref None in + let selected_georef = ref WGS84_dec in + let display_coordinates = fun () -> + e_pos#set_text (string_of_coordinates !selected_georef self#pos) + and set_coordinates = fun () -> + self#set (geographic_of_coordinates !selected_georef e_pos#text) in + + display_coordinates (); + + let initial_wgs84 = self#pos in + let menu = GMenu.menu () in - let callback = fun () -> - e_pos#set_text (sprintf "%s" (geomap#geo_string wgs84)); - selected_georef := None in + let set = fun kind () -> + set_coordinates (); + selected_georef := kind; + display_coordinates () in let mi = GMenu.menu_item ~label:"WGS84" ~packing:menu#append () in - ignore (mi#connect#activate ~callback); + ignore (mi#connect#activate ~callback:(set WGS84_dec)); + let mi = GMenu.menu_item ~label:"WGS84_dms" ~packing:menu#append () in + ignore (mi#connect#activate ~callback:(set WGS84_dms)); List.iter (fun (label, geo) -> - let callback = fun () -> - let (a, d) = LL.bearing geo#pos wgs84 in - e_pos#set_text (sprintf "%.1f %.1f" a d); - selected_georef := Some geo in let mi = GMenu.menu_item ~label ~packing:menu#append () in - ignore (mi#connect#activate ~callback)) + ignore (mi#connect#activate ~callback:(set (Bearing geo)))) geomap#georefs; optmenu#set_menu menu; @@ -147,9 +146,7 @@ class waypoint = fun ?(show = true) (wpts_group:group) (name :string) ?(alt=0.) self#set_name ename#text; alt <- float_of_string ea#text; label#set [`TEXT name]; - let wgs84 = wgs84_of_string !selected_georef e_pos#text in - - self#set wgs84; + set_coordinates (); updated (); if wpts_group#show_moved then moved <- anim moved; @@ -164,6 +161,7 @@ class waypoint = fun ?(show = true) (wpts_group:group) (name :string) ?(alt=0.) let cancel = GButton.button ~stock:`CANCEL ~packing: dhbx#add () in let destroy = fun () -> + self#set initial_wgs84; self#reset_moved (); wpt_group#lower_to_bottom (); dialog#destroy () in @@ -191,7 +189,8 @@ class waypoint = fun ?(show = true) (wpts_group:group) (name :string) ?(alt=0.) (* Update AGL on pos or alt change *) let callback = fun _ -> try - let wgs84 = wgs84_of_string !selected_georef e_pos#text in + set_coordinates (); + let wgs84 = self#pos in let agl = float_of_string ea#text -. float (try Srtm.of_wgs84 wgs84 with _ -> 0) in agl_lab#set_text (sprintf " AGL: %4.0fm" agl) with _ -> ()