Google Maps auto loading

This commit is contained in:
Pascal Brisset
2006-03-10 10:28:51 +00:00
parent 3942cbe6c1
commit 0934d7cda3
5 changed files with 116 additions and 48 deletions
+9
View File
@@ -443,6 +443,10 @@ let listen_flight_params = fun () ->
let active_gm_http = fun x ->
Gm.no_http := not x
let gm_auto = ref false
let active_gm_auto = fun x ->
gm_auto := x
let button_press = fun (geomap:MapCanvas.widget) ev ->
if GdkEvent.Button.button ev = 3 then
let xc = GdkEvent.Button.x ev
@@ -463,6 +467,9 @@ let button_press = fun (geomap:MapCanvas.widget) ev ->
let fill_gm_tiles = fun geomap -> ignore (Thread.create MapGoogle.fill_window geomap)
let gm_update = fun geomap ->
if !gm_auto then fill_gm_tiles geomap
let _ =
let ivy_bus = ref "127.255.255.255:2010"
and geo_ref = ref ""
@@ -509,7 +516,9 @@ let _ =
ignore (geomap#menu_fact#add_check_item "Vertical View" ~key:GdkKeysyms._V ~callback:active_vertical);
ignore (geomap#menu_fact#add_item "GM Fill" ~key:GdkKeysyms._G ~callback:(fun _ -> fill_gm_tiles geomap));
ignore (geomap#menu_fact#add_check_item "GM Http" ~key:GdkKeysyms._H ~active:true ~callback:active_gm_http);
ignore (geomap#menu_fact#add_check_item "GM Auto" ~key:GdkKeysyms._A ~active:false ~callback:active_gm_auto);
geomap#connect_view (fun () -> gm_update geomap);
vbox#pack ~expand:true geomap#frame#coerce;
+18 -18
View File
@@ -163,26 +163,26 @@ exception Not_available
let no_http = ref false
let get_image = fun tile ->
try get_from_cache tile.key with
let remove_last_char = fun s -> String.sub s 0 (String.length s - 1)
let get_image = fun key ->
try get_from_cache key with
Not_found ->
if !no_http then raise Not_available;
let url = google_maps_url tile.key in
let jpg_file = !cache_path // (tile.key ^ ".jpg") in
try
ignore (Http.file_of_url ~dest:jpg_file url);
tile, jpg_file
with
Http.Failure _ -> raise Not_available
let rec loop = fun k ->
if String.length k >= 1 then
let url = google_maps_url k in
let jpg_file = !cache_path // (k ^ ".jpg") in
try
ignore (Http.file_of_url ~dest:jpg_file url);
tile_of_key k, jpg_file
with
Http.Failure _ -> loop (remove_last_char k)
else
raise Not_available in
loop key
let rec get_tile = fun wgs84 zoom ->
if zoom < 10 then
let tile = tile_of_geo wgs84 zoom in
try get_image tile with
(** Error, let's try a lower zoom *)
Not_available when not !no_http -> get_tile wgs84 (zoom+1)
else
raise Not_available
let tile = tile_of_geo wgs84 zoom in
get_image tile.key
+4 -1
View File
@@ -37,7 +37,7 @@ type tile_t = {
val tile_of_geo : Latlong.geographic -> int -> tile_t
(** [tile_string geo zoom] Returns the tile description containing a
given point *)
given point with a the smalled zoom greater or equal to [zoom]. *)
val tile_of_key : string -> tile_t
(** [tile_of_key google_maps_tile_key] Returns tile description of a
@@ -45,6 +45,9 @@ val tile_of_key : string -> tile_t
val cache_path : string ref
val get_image : string -> tile_t * string
(** [get_image key] May raise [Not_available] *)
val get_tile : Latlong.geographic -> int -> tile_t*string
(** May raise [Not_available] *)
+17 -2
View File
@@ -30,6 +30,7 @@ let mercator_coeff = 5e6
class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef () ->
let canvas = GnoCanvas.canvas () in
let background = GnoCanvas.group canvas#root in
let view_cbs = Hashtbl.create 3 in (* Store for view event callback *)
object (self)
(** GUI attributes *)
@@ -273,8 +274,22 @@ class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef (
| k when k = GdkKeysyms._Page_Up -> adj#set_value (adj#value+.adj#step_increment) ; true
| k when k = GdkKeysyms._Page_Down -> adj#set_value (adj#value-.adj#step_increment) ; true
| _ -> false
method any_event = fun ev ->
method connect_view = fun cb ->
Hashtbl.add view_cbs cb ()
method any_event =
let rec last_view = ref (0,0,0,0) in
fun ev ->
(** View has changed ? *)
let width_c, height_c = Gdk.Drawable.get_size canvas#misc#window
and (xc0, yc0) = canvas#get_scroll_offsets in
let view = (xc0, yc0, width_c, height_c) in
if view <> !last_view then begin
last_view := view;
Hashtbl.iter (fun cb _ -> cb ()) view_cbs
end;
match GdkEvent.get_type ev with
| `SCROLL -> begin
let scroll_event = GdkEvent.Scroll.cast ev in
+68 -27
View File
@@ -24,6 +24,11 @@
*
*)
let array_forall = fun f a ->
Array.fold_right (fun x r -> f x && r) a true
open Printf
module LL = Latlong
(** Quadtreee of displayed tiles *)
@@ -37,6 +42,9 @@ let gm_tiles = Node (Array.create 4 Empty)
let index_of = function
'q' -> 0 | 'r' -> 1 | 's' -> 2 | 't' -> 3
| _ -> invalid_arg "index_of"
let char_of = function
0 -> 'q' | 1 -> 'r' | 2 -> 's' | 3 -> 't'
| _ -> invalid_arg "char_of"
(** Checking that a tile is already displayed *)
let mem_tile = fun tile_key ->
@@ -66,6 +74,18 @@ let add_tile = fun tile_key ->
loop 0 [|gm_tiles|] 0
let display_the_tile = fun geomap tile jpg_file ->
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
and east_long = west_long +. tile.Gm.width in
let ne = { LL.posn_lat = north_lat; posn_long = east_long } in
let map = geomap#display_pixbuf ((0,256), tile.Gm.sw_corner) ((256,0),ne) (GdkPixbuf.from_file jpg_file) in
map#raise 1;
add_tile tile.Gm.key
(** 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
@@ -73,38 +93,59 @@ let display_tile = fun (geomap:MapCanvas.widget) wgs84 ->
let key = desired_tile.Gm.key in
if not (mem_tile key) then
let (tile, jpg_file) = Gm.get_tile wgs84 1 in
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
and east_long = west_long +. tile.Gm.width in
let ne = { LL.posn_lat = north_lat; posn_long = east_long } in
let map = geomap#display_pixbuf ((0,256), tile.Gm.sw_corner) ((256,0),ne) (GdkPixbuf.from_file jpg_file) in
map#raise 1;
add_tile key
display_the_tile geomap tile jpg_file
(** Filling the window with tiles *)
exception New_displayed of int
(** [New_displayed zoom] Raised when a new is loadded *)
let fill_window = fun (geomap:MapCanvas.widget) ->
(** 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
let (xw0, yw0) = geomap#window_to_world (float xc0) (float yc0)
and (xw1, yw1) = geomap#window_to_world (float (xc0+width_c)) (float (yc0+height_c)) in
let nw = geomap#of_world (xw0, yw0)
and se = geomap#of_world (xw1, yw1) in
let (xw0, yw0) = geomap#window_to_world (float xc0) (float (yc0+height_c))
and (xw1, yw1) = geomap#window_to_world (float (xc0+width_c)) (float yc0) in
let sw = geomap#of_world (xw0, yw0)
and ne = geomap#of_world (xw1, yw1) in
let west = sw.LL.posn_long /. LL.pi
and east = ne.LL.posn_long /. LL.pi
and north = LL.mercator_lat ne.LL.posn_lat /. LL.pi
and south = LL.mercator_lat sw.LL.posn_lat /. LL.pi in
(* Hypothesis: no strong variation of the height of the tiles on the whole area *)
let (width_tile, height_tile) = Gm.tile_coverage se.LL.posn_lat 1 in
for ilong = 0 to truncate ((se.LL.posn_long -. nw.LL.posn_long) /. width_tile) do
let long = nw.LL.posn_long +. float ilong *. width_tile in
for ilat = 0 to truncate ((nw.LL.posn_lat -. se.LL.posn_lat) /. height_tile) do
let lat = nw.LL.posn_lat -. float ilat *. height_tile in
let wgs84 = { LL.posn_lat = lat; posn_long = long } in
(** Go through the quadtree and look for the holes *)
let rec loop = fun twest tsouth tsize trees i zoom key ->
(* Check for intersection *)
if not (twest > east || twest+.tsize < west || tsouth > north || tsouth+.tsize < south) then
let tsize2 = tsize /. 2. in
try
display_tile geomap wgs84
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
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
Gm.Not_available -> ()
done
done
New_displayed z when z = zoom ->
trees.(i) <- Tile
| Gm.Not_available -> () in
loop (-1.) (-1.) 2. [|gm_tiles|] 0 18 "t";
geomap#canvas#update_now ()