From 2ca78d11bed196ceb3888cadcfd2337fbf6e64e9 Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Sun, 24 Mar 2013 00:21:18 +0100 Subject: [PATCH] [zoom] fix zoom level bound tiles to maps_zoom (cache or http) if lower res available in cache try http according to policy --- sw/ground_segment/cockpit/gcs.ml | 2 +- sw/lib/ocaml/gm.ml | 63 +++++++++++++++++++------------- sw/lib/ocaml/gm.mli | 2 +- sw/lib/ocaml/mapGoogle.ml | 61 +++++++++++++++---------------- sw/lib/ocaml/mapGoogle.mli | 4 +- 5 files changed, 71 insertions(+), 61 deletions(-) diff --git a/sw/ground_segment/cockpit/gcs.ml b/sw/ground_segment/cockpit/gcs.ml index 7714c423038..75e1d87e540 100644 --- a/sw/ground_segment/cockpit/gcs.ml +++ b/sw/ground_segment/cockpit/gcs.ml @@ -278,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 diff --git a/sw/lib/ocaml/gm.ml b/sw/lib/ocaml/gm.ml index 627a4eca217..737f7fe0c3e 100644 --- a/sw/lib/ocaml/gm.ml +++ b/sw/lib/ocaml/gm.ml @@ -79,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 @@ -157,12 +161,14 @@ let get_from_cache = fun dir f -> 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 @@ -245,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 a7aa3403af3..80bc47173e9 100644 --- a/sw/lib/ocaml/gm.mli +++ b/sw/lib/ocaml/gm.mli @@ -42,7 +42,7 @@ 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/mapGoogle.ml b/sw/lib/ocaml/mapGoogle.ml index 28a6e591e84..5c74903f6fa 100644 --- a/sw/lib/ocaml/mapGoogle.ml +++ b/sw/lib/ocaml/mapGoogle.ml @@ -97,14 +97,13 @@ let display_the_tile = fun (geomap:MapCanvas.widget) tile jpg_file level -> (** 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 - let level = String.length tile.Gm.key in - display_the_tile geomap tile jpg_file level + 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 @@ -131,34 +130,34 @@ let fill_window = fun (geomap:MapCanvas.widget) zoomlevel -> 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 + 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; - - (* 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 + 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; + + (* 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 zoomlevel "t" diff --git a/sw/lib/ocaml/mapGoogle.mli b/sw/lib/ocaml/mapGoogle.mli index 398b38bf240..8bb42f0dc98 100644 --- a/sw/lib/ocaml/mapGoogle.mli +++ b/sw/lib/ocaml/mapGoogle.mli @@ -22,8 +22,8 @@ * *) -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 -> int -> unit (** Filling the canvas window with Google Maps tiles at given zoomlevel*)