diff --git a/sw/ground_segment/cockpit/gcs.ml b/sw/ground_segment/cockpit/gcs.ml index b51807bbce..75e1d87e54 100644 --- a/sw/ground_segment/cockpit/gcs.ml +++ b/sw/ground_segment/cockpit/gcs.ml @@ -174,10 +174,11 @@ end (************ Google, OSM Maps handling *****************************************) module GM = struct (** Fill the visible background with Google, OSM tiles *) + let zoomlevel = ref 18 let fill_tiles = fun geomap -> match geomap#georef with None -> () - | Some _ -> TodoList.add (fun () -> MapGoogle.fill_window geomap) + | Some _ -> TodoList.add (fun () -> MapGoogle.fill_window geomap !zoomlevel) let auto = ref false let update = fun geomap -> @@ -197,7 +198,7 @@ module GM = struct posn_long = min geo1.posn_long geo2.posn_long } and ne = { posn_lat = max geo1.posn_lat geo2.posn_lat; posn_long = max geo1.posn_long geo2.posn_long } in - let pix = MapGoogle.pixbuf sw ne in + let pix = MapGoogle.pixbuf sw ne !zoomlevel in let nw = { posn_lat = ne.posn_lat; posn_long = sw.posn_long } and se = { posn_lat = sw.posn_lat; posn_long = ne.posn_long } in save_map geomap ~projection:"Mercator" pix nw se @@ -277,7 +278,7 @@ let button_press = fun (geomap:G.widget) ev -> and display_gm = fun () -> TodoList.add (fun () -> - try ignore (MapGoogle.display_tile geomap wgs84) with + try ignore (MapGoogle.display_tile geomap wgs84 !GM.zoomlevel) with Gm.Not_available -> ()) in let m = if !ign then [`I ("Load IGN tile", display_ign)] else [] in @@ -286,7 +287,7 @@ let button_press = fun (geomap:G.widget) ev -> (`I ("Load BDORTHO", display_bdortho geomap wgs84))::m else m in - GToolbox.popup_menu ~entries:([`I ("Load Google tile", display_gm)]@m) + GToolbox.popup_menu ~entries:([`I ("Load background tile", display_gm)]@m) ~button:3 ~time:(Int32.of_int 0); true end else if GdkEvent.Button.button ev = 1 && Gdk.Convert.test_modifier `CONTROL state then @@ -347,6 +348,7 @@ let options = "-edit", Arg.Unit (fun () -> edit := true; layout_file := "editor.xml"), "Flight plan editor"; "-fullscreen", Arg.Set fullscreen, "Fullscreen window"; "-maps_fill", Arg.Set GM.auto, "Automatically start loading background maps"; + "-maps_zoom", Arg.Set_int GM.zoomlevel, "Background maps zoomlevel (default: 18, max: 22)"; "-ign", Arg.String (fun s -> ign:=true; IGN.data_path := s), "IGN tiles path"; "-lambertIIe", Arg.Unit (fun () -> projection:=G.LambertIIe),"Switch to LambertIIe projection"; "-layout", Arg.Set_string layout_file, (sprintf " GUI layout. Default: %s" !layout_file); @@ -470,7 +472,7 @@ let create_geomap = fun switch_fullscreen editor_frame -> (** Separate from A/C menus *) ignore (geomap#factory#add_separator ()); - (** Set the initial soom *) + (** Set the initial zoom *) geomap#zoom !zoom; geomap, menu_fact diff --git a/sw/lib/ocaml/gm.ml b/sw/lib/ocaml/gm.ml index 31b9cff1cc..737f7fe0c3 100644 --- a/sw/lib/ocaml/gm.ml +++ b/sw/lib/ocaml/gm.ml @@ -28,7 +28,8 @@ open Latlong open Printf let tile_size = 256, 256 -let zoom_max = 18 +let zoom_max = 22 +let zoom_min = 18 let cache_path = ref "/var/tmp" @@ -39,10 +40,10 @@ type tile_t = { height : float (* Latitude difference *) } -type maps_source = Google | OSM | MS -let maps_sources = [Google; OSM; MS] +type maps_source = Google | OSM | MS | MQ | MQ_Aerial +let maps_sources = [Google; OSM; MS; MQ; MQ_Aerial] let string_of_maps_source = function - Google -> "Google" | OSM -> "OSM" | MS -> "MS" + Google -> "Google" | OSM -> "OpenStreetMap" | MS -> "Bing" | MQ -> "MapQuest OSM" | MQ_Aerial -> "MapQuest Open Aerial" let maps_source = ref Google let set_maps_source = fun s -> maps_source := s @@ -78,8 +79,12 @@ let gm_pos_and_scale = fun keyholeString tLat latHeight tLon lonWidth -> (** Returns a keyhole string for a longitude (x), latitude (y), and zoom for Google Maps (http://www.ponies.me.uk/maps/GoogleTileUtils.java) *) -let tile_of_geo = fun wgs84 zoom -> - let zoom = zoom_max - zoom in +let tile_of_geo = fun ?level wgs84 zoom -> + let max = match level with + | None -> zoom_max + | Some l -> if l < zoom_min then zoom_min else if l > zoom_max then zoom_max else l + in + let zoom = max - zoom in (* first convert the lat lon to transverse mercator coordinates *) let lon = (Rad>>Deg)wgs84.posn_long in @@ -150,16 +155,20 @@ let is_prefix = fun a b -> (** Get the tile or one which contains it from the cache *) let get_from_cache = fun dir f -> let files = Sys.readdir dir in + (* sort files to have the longest names first *) + Array.sort (fun a b -> String.length b - String.length a) files; let rec loop = fun i -> if i < Array.length files then let fi = files.(i) in let fi_key = try Filename.chop_extension fi with _ -> fi in + (* is it a valid substring ? *) if fi_key <> "" && is_prefix fi_key f then - (tile_of_key fi_key, dir // fi) + (tile_of_key fi_key, dir // fi) else - loop (i+1) + loop (i+1) else - raise Not_found in + raise Not_found + in loop 0 (** Translate the old quadtree naming policy into new (x,y) coordinates @@ -202,6 +211,8 @@ let url_of_tile_key = fun maps_source s -> match maps_source with Google -> sprintf "http://khm0.google.com/kh/v=%d&x=%d&s=&y=%d&z=%d" google_version x y z | OSM -> sprintf "http://tile.openstreetmap.org/%d/%d/%d.png" z x y + | MQ -> sprintf "http://otile1.mqcdn.com/tiles/1.0.0/osm/%d/%d/%d.png" z x y + | MQ_Aerial -> sprintf "http://otile1.mqcdn.com/tiles/1.0.0/sat/%d/%d/%d.png" z x y | MS -> let (key, last_char) = ms_key s in (* That's the old naming scheme, that still works as of 1st August 2010 @@ -215,6 +226,8 @@ let url_of_tile_key = fun maps_source s -> let get_cache_dir = function Google -> !cache_path (* Historic ! Should be // Google *) | OSM -> !cache_path // "OSM" + | MQ -> !cache_path // "MapQuest" + | MQ_Aerial -> !cache_path // "MapQuestAerial" | MS -> !cache_path // "MS" @@ -238,30 +251,35 @@ let remove_last_char = fun s -> String.sub s 0 (String.length s - 1) let get_image = fun key -> let cache_dir = get_cache_dir !maps_source in mkdir cache_dir; + let rec get_from_http = fun k -> + if String.length k >= 1 then + let url = url_of_tile_key !maps_source k in + let jpg_file = cache_dir // (k ^ ".jpg") in + try + ignore (Http.file_of_url ~dest:jpg_file url); + tile_of_key k, jpg_file + with + Http.Not_Found _ -> get_from_http (remove_last_char k) + | Http.Blocked _ -> + begin + prerr_endline (Printf.sprintf "Seem to be temporarily blocked, '%s'" url); + raise Not_available + end + | _ -> raise Not_available + else + raise Not_available + in try if !policy = NoCache then raise Not_found; - get_from_cache cache_dir key + let (t, f) = get_from_cache cache_dir key in + (* if not exact match from cache, try http if CacheOrHttp policy *) + if !policy = CacheOrHttp && (String.length t.key < String.length key) then + try get_from_http key with _ -> (t, f) + else (t, f) with - Not_found -> - if !policy = NoHttp then raise Not_available; - let rec loop = fun k -> - if String.length k >= 1 then - let url = url_of_tile_key !maps_source k in - let jpg_file = cache_dir // (k ^ ".jpg") in - try - ignore (Http.file_of_url ~dest:jpg_file url); - tile_of_key k, jpg_file - with - Http.Not_Found _ -> loop (remove_last_char k) - | Http.Blocked _ -> - begin - prerr_endline (Printf.sprintf "Seem to be temporarily blocked, '%s'" url); - raise Not_available - end - | _ -> raise Not_available - else - raise Not_available in - loop key + | Not_found -> + if !policy = NoHttp then raise Not_available; + get_from_http key let rec get_tile = fun wgs84 zoom -> diff --git a/sw/lib/ocaml/gm.mli b/sw/lib/ocaml/gm.mli index 7be6cbddaf..80bc47173e 100644 --- a/sw/lib/ocaml/gm.mli +++ b/sw/lib/ocaml/gm.mli @@ -23,6 +23,8 @@ *) val tile_size : int * int +val zoom_max : int +val zoom_min : int val tile_coverage : float -> int -> float * float (** [tile_coverage wgs84_lat zoom] Returns (width,height) *) @@ -33,14 +35,14 @@ type tile_t = { height : float (* Latitude difference *) } -type maps_source = Google | OSM | MS +type maps_source = Google | OSM | MS | MQ | MQ_Aerial val string_of_maps_source : maps_source -> string val maps_sources : maps_source list val set_maps_source : maps_source -> unit val get_maps_source : unit -> maps_source (** Initialized to Google *) -val tile_of_geo : Latlong.geographic -> int -> tile_t +val tile_of_geo : ?level:int -> Latlong.geographic -> int -> tile_t (** [tile_string geo zoom] Returns the tile description containing a given point with a the smallest available zoom greater or equal to [zoom]. *) diff --git a/sw/lib/ocaml/mapCanvas.ml b/sw/lib/ocaml/mapCanvas.ml index 82dc10e217..06ba68f4e2 100644 --- a/sw/lib/ocaml/mapCanvas.ml +++ b/sw/lib/ocaml/mapCanvas.ml @@ -152,6 +152,8 @@ class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef ( let canvas = GnoCanvas.canvas ~packing:(frame#pack ~expand:true) () in let background = GnoCanvas.group canvas#root and still = GnoCanvas.group canvas#root in + (* create several layers of canvas group to display the map in correct order *) + let maps = Array.init (Gm.zoom_max - Gm.zoom_min + 1) (fun _ -> GnoCanvas.group background) in let view_cbs = Hashtbl.create 3 in (* Store for view event callback *) let region_rectangle = GnoCanvas.rect canvas#root ~props:[`WIDTH_PIXELS 2; `OUTLINE_COLOR "red"] in @@ -184,6 +186,7 @@ class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef ( method toolbar = toolbar method background = background method still = still + method maps = maps method top_still = 3.5*.s method utc_time = utc_time method set_utc_time = fun h m s -> @@ -373,14 +376,23 @@ class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef ( self#of_world (xw, yw) - method display_pixbuf = fun ?opacity ((x1,y1), geo1) ((x2,y2), geo2) image -> + method display_pixbuf = fun ?opacity ?level ((x1,y1), geo1) ((x2,y2), geo2) image -> let x1 = float x1 and x2 = float x2 and y1 = float y1 and y2 = float y2 in let image = match opacity with None -> image | Some o -> set_opacity image o in - let pix = GnoCanvas.pixbuf ~x:(-.x1) ~y:(-.y1)~pixbuf:image ~props:[`ANCHOR `NW] background in + let map_layer = match level with + | None -> 0 + | Some l -> + if l > Gm.zoom_max then + Array.length maps - 1 + else if l < Gm.zoom_min then + 0 + else l - Gm.zoom_min + in + let pix = GnoCanvas.pixbuf ~x:(-.x1) ~y:(-.y1) ~pixbuf:image ~props:[`ANCHOR `NW] maps.(map_layer) in let xw1, yw1 = self#world_of geo1 and xw2, yw2 = self#world_of geo2 in diff --git a/sw/lib/ocaml/mapCanvas.mli b/sw/lib/ocaml/mapCanvas.mli index 5259c7700d..dc95020615 100644 --- a/sw/lib/ocaml/mapCanvas.mli +++ b/sw/lib/ocaml/mapCanvas.mli @@ -43,6 +43,7 @@ class widget : float * float -> float -> float -> float -> GnoCanvas.line method background : GnoCanvas.group method background_event : GnoCanvas.item_event -> bool + method maps : GnoCanvas.group array method canvas : GnoCanvas.canvas method center : Latlong.geographic -> unit method circle : @@ -57,6 +58,7 @@ class widget : method display_group : string -> unit method display_pixbuf : ?opacity:int -> + ?level:int -> (int * int) * Latlong.geographic -> (int * int) * Latlong.geographic -> GdkPixbuf.pixbuf -> GnoCanvas.pixbuf method display_xy : string -> unit diff --git a/sw/lib/ocaml/mapGoogle.ml b/sw/lib/ocaml/mapGoogle.ml index 650ec1ddf5..5c74903f6f 100644 --- a/sw/lib/ocaml/mapGoogle.ml +++ b/sw/lib/ocaml/mapGoogle.ml @@ -72,7 +72,7 @@ let add_tile = fun tile_key -> loop 0 [|gm_tiles|] 0 -let display_the_tile = fun (geomap:MapCanvas.widget) tile jpg_file -> +let display_the_tile = fun (geomap:MapCanvas.widget) tile jpg_file level -> let south_lat = tile.Gm.sw_corner.LL.posn_lat and west_long = tile.Gm.sw_corner.LL.posn_long in let north_lat = south_lat +. tile.Gm.height @@ -83,7 +83,7 @@ let display_the_tile = fun (geomap:MapCanvas.widget) tile jpg_file -> try let pixbuf = GdkPixbuf.from_file jpg_file in ignore (GMain.Idle.add (fun () -> - let map = geomap#display_pixbuf ((0,tx), tile.Gm.sw_corner) ((ty,0),ne) pixbuf in + let map = geomap#display_pixbuf ((0,tx), tile.Gm.sw_corner) ((ty,0),ne) pixbuf ~level in map#raise 1; false)); add_tile tile.Gm.key @@ -97,19 +97,19 @@ let display_the_tile = fun (geomap:MapCanvas.widget) tile jpg_file -> (** Displaying the tile around the given point *) -let display_tile = fun (geomap:MapCanvas.widget) wgs84 -> - let desired_tile = Gm.tile_of_geo wgs84 1 in +let display_tile = fun (geomap:MapCanvas.widget) wgs84 level -> + let desired_tile = Gm.tile_of_geo ~level wgs84 1 in let key = desired_tile.Gm.key in if not (mem_tile key) then - let (tile, jpg_file) = Gm.get_tile wgs84 1 in - display_the_tile geomap tile jpg_file + let (tile, jpg_file) = Gm.get_image key in + display_the_tile geomap tile jpg_file (String.length tile.Gm.key) exception New_displayed of int (** [New_displayed zoom] Raised when a new is loadded *) -let fill_window = fun (geomap:MapCanvas.widget) -> +let fill_window = fun (geomap:MapCanvas.widget) zoomlevel -> (** First estimate the coverage of the window *) let width_c, height_c = Gdk.Drawable.get_size geomap#canvas#misc#window and (xc0, yc0) = geomap#canvas#get_scroll_offsets in @@ -130,35 +130,36 @@ let fill_window = fun (geomap:MapCanvas.widget) -> if not (twest > east || (twest+.tsize < west && (east < 1. (* Standard case *) || twest+.2.>east (* Over 180° *))) || tsouth > north || tsouth+.tsize < south) then let tsize2 = tsize /. 2. in try - match trees.(i) with - Tile -> () - | Empty -> - if zoom = 1 then - let tile, image = Gm.get_image key in - display_the_tile geomap tile image; - raise (New_displayed (19-String.length tile.Gm.key)) - else begin - trees.(i) <- Node (Array.create 4 Empty); - loop twest tsouth tsize trees i zoom key - end - | Node sons -> - let continue = fun j tw ts -> - loop tw ts tsize2 sons j (zoom-1) (key^String.make 1 (char_of j)) in + match trees.(i) with + Tile -> () + | Empty -> + if zoom = 1 then + let tile, image = Gm.get_image key in + let level = String.length tile.Gm.key in + display_the_tile geomap tile image level; + raise (New_displayed (zoomlevel+1-String.length tile.Gm.key)) + else begin + trees.(i) <- Node (Array.create 4 Empty); + loop twest tsouth tsize trees i zoom key + end + | Node sons -> + let continue = fun j tw ts -> + loop tw ts tsize2 sons j (zoom-1) (key^String.make 1 (char_of j)) in - continue 0 twest (tsouth+.tsize2); - continue 1 (twest+.tsize2) (tsouth+.tsize2); - continue 2 (twest+.tsize2) tsouth; - continue 3 twest tsouth; + continue 0 twest (tsouth+.tsize2); + continue 1 (twest+.tsize2) (tsouth+.tsize2); + continue 2 (twest+.tsize2) tsouth; + continue 3 twest tsouth; - (* If the current node is complete, replace it by a Tile *) - if array_forall (fun x -> x = Tile) sons then begin - trees.(i) <- Tile - end + (* If the current node is complete, replace it by a Tile *) + if array_forall (fun x -> x = Tile) sons then begin + trees.(i) <- Tile + end with - New_displayed z when z = zoom -> - trees.(i) <- Tile + New_displayed z when z = zoom -> + trees.(i) <- Tile | Gm.Not_available -> () in - loop (-1.) (-1.) 2. [|gm_tiles|] 0 18 "t" + loop (-1.) (-1.) 2. [|gm_tiles|] 0 zoomlevel "t" exception To_copy of int * string @@ -172,7 +173,7 @@ let gdk_pixbuf_safe_copy_area ~dest ~dest_x ~dest_y ~width ~height ~src_x ~src_y and height = min height (GdkPixbuf.get_height dest -dest_y) in GdkPixbuf.copy_area ~dest ~dest_x ~dest_y ~width ~height ~src_x ~src_y pixbuf -let pixbuf = fun sw ne -> +let pixbuf = fun sw ne zoomlevel-> assert (sw.LL.posn_lat < ne.LL.posn_lat); assert (sw.LL.posn_long < ne.LL.posn_long); let west = sw.LL.posn_long /. LL.pi @@ -191,7 +192,7 @@ let pixbuf = fun sw ne -> if zoom = 1 then let tile, image = Gm.get_image key in - raise (To_copy (19-String.length tile.Gm.key, image)) + raise (To_copy (zoomlevel+1-String.length tile.Gm.key, image)) else begin let continue = fun j tw ts -> loop tw ts tsize2 (zoom-1) (key^String.make 1 (char_of j)) in @@ -210,5 +211,5 @@ let pixbuf = fun sw ne -> let pixbuf = GdkPixbuf.from_file image in gdk_pixbuf_safe_copy_area ~dest ~dest_x ~dest_y ~width ~height:width ~src_x ~src_y pixbuf | Gm.Not_available -> () in - loop (-1.) (-1.) 2. 18 "t"; + loop (-1.) (-1.) 2. zoomlevel "t"; dest diff --git a/sw/lib/ocaml/mapGoogle.mli b/sw/lib/ocaml/mapGoogle.mli index 0255098cac..8bb42f0dc9 100644 --- a/sw/lib/ocaml/mapGoogle.mli +++ b/sw/lib/ocaml/mapGoogle.mli @@ -22,11 +22,11 @@ * *) -val display_tile : MapCanvas.widget -> Latlong.geographic -> unit -(** Displaying the Google Maps tile around the given point (zoom=1) *) +val display_tile : MapCanvas.widget -> Latlong.geographic -> int -> unit +(** Displaying the Google Maps tile around the given point (zoom=1) up to max level *) -val fill_window : MapCanvas.widget -> unit -(** Filling the canvas window with Google Maps tiles *) +val fill_window : MapCanvas.widget -> int -> unit +(** Filling the canvas window with Google Maps tiles at given zoomlevel*) -val pixbuf : Latlong.geographic -> Latlong.geographic -> GdkPixbuf.pixbuf -(** [pixbuf south_west north_east] Returns a map background of the given area *) +val pixbuf : Latlong.geographic -> Latlong.geographic -> int -> GdkPixbuf.pixbuf +(** [pixbuf south_west north_east zoomlevel] Returns a map background of the given area *)