[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

@@ -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

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 ->

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]. *)
 

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"
 

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*)