map from Google tiles

sw/ground_segment/cockpit/map2d.ml

@@ -440,33 +440,59 @@ let fill_gm_tiles = fun geomap ->
 let gm_update = fun geomap ->
   if !gm_auto then fill_gm_tiles geomap
 
+
+let save_map = fun geomap ?(projection=geomap#projection) pixbuf nw se ->
+  match GToolbox.select_file ~filename:(default_path_maps//".xml") ~title:"Save region map" () with
+    None -> ()
+  | Some xml_file  ->
+      let jpg = Filename.chop_extension xml_file ^ ".png" in
+      GdkPixbuf.save jpg "png" pixbuf;
+      let point = fun (x,y) wgs84 ->
+	Xml.Element ("point", ["x",soi x;"y",soi y;"geo", Latlong.string_of wgs84], []) in
+      let width = GdkPixbuf.get_width pixbuf
+      and height = GdkPixbuf.get_height pixbuf in
+      let points = [point (0, 0) nw; point (width, height) se] in
+      let xml = Xml.Element ("map", 
+			     ["file", Filename.basename jpg;
+			      "projection", projection],
+			     points) in
+      let f = open_out xml_file in
+      Printf.fprintf f "%s\n" (Xml.to_string_fmt xml);
+      close_out f
+
+
+let map_from_gm_tiles = fun (geomap:MapCanvas.widget) () ->
+  match geomap#region with
+    None -> GToolbox.message_box "Error" "Select a region first (drag shift-left button)"
+  | Some ((xw1,yw1), (xw2,yw2)) ->
+      let geo1 = geomap#of_world (xw1,yw1)
+      and geo2 = geomap#of_world (xw2,yw2) in
+      let sw = { posn_lat = min geo1.posn_lat geo2.posn_lat;
+		 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 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
+      
+
 let map_from_region = fun (geomap:MapCanvas.widget) () ->
   match geomap#region with
-    None -> GToolbox.message_box "Error" "Select a region first (drag left button)"
+    None -> GToolbox.message_box "Error" "Select a region first (drag shif-left button)"
   | Some ((xw1,yw1), (xw2,yw2)) ->
+      let xw1, xw2 = min xw1 xw2, max xw1 xw2
+      and yw1, yw2 = min yw1 yw2, max yw1 yw2 in
       let (xc1, yc1) = geomap#canvas#w2c xw1 yw1
       and (xc2, yc2) = geomap#canvas#w2c xw2 yw2 in
       let width = xc2-xc1 and height = yc2-yc1 in
       let p = GdkPixbuf.create width height () in
       let (x0, y0) = geomap#canvas#get_scroll_offsets in
-      let xc1= xc1 - x0 and yc1 = yc1 - y0 in
+      let xc1 = xc1 - x0 and yc1 = yc1 - y0 in
       GdkPixbuf.get_from_drawable ~dest:p ~width ~height ~src_x:xc1 ~src_y:yc1 geomap#canvas#misc#window;
-      match GToolbox.select_file ~filename:(default_path_maps//".xml") ~title:"Save region map" () with
-	None -> ()
-      | Some xml_file  ->
-	  let jpg = Filename.chop_extension xml_file ^ ".png" in
-	  GdkPixbuf.save jpg "png" p;
-	  let point = fun (x,y) xyw ->
-	    let wgs84 = geomap#of_world xyw in
-	    Xml.Element ("point", ["x",soi x;"y",soi y;"geo", Latlong.string_of wgs84], []) in
-	  let points = [point (0, 0) (xw1,yw1); point (width, height) (xw2,yw2)] in
-	  let xml = Xml.Element ("map", 
-				 ["file", Filename.basename jpg;
-				  "projection", geomap#projection],
-			       points) in
-	  let f = open_out xml_file in
-	  Printf.fprintf f "%s\n" (Xml.to_string_fmt xml);
-	  close_out f
+      let nw = geomap#of_world (xw1,yw1)
+      and se = geomap#of_world (xw2,yw2) in
+      save_map geomap p nw se
 
 
 module Edit = struct
@@ -861,6 +887,7 @@ let _ =
   ignore (map_menu_fact#add_check_item "GM Http" ~key:GdkKeysyms._H ~active:true ~callback:active_gm_http);
   ignore (map_menu_fact#add_check_item "GM Auto" ~active:false ~callback:active_gm_auto);
   ignore (map_menu_fact#add_item "Map of region" ~key:GdkKeysyms._R ~callback:(map_from_region geomap));
+  ignore (map_menu_fact#add_item "Map of GM" ~key:GdkKeysyms._T ~callback:(map_from_gm_tiles geomap));
  
   (** Connect Google Maps display to view change *)
   geomap#connect_view (fun () -> gm_update geomap);

sw/lib/ocaml/gm.mli

@@ -37,21 +37,24 @@ type tile_t = {
       
 val tile_of_geo : Latlong.geographic -> int -> tile_t
 (** [tile_string geo zoom] Returns the tile description containing a
-   given point with a the smalled zoom greater or equal to [zoom]. *)
+  given point with a the smallest available 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
    named tile. *)
 
 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] *)
+val no_http : bool ref
+(** Initialized to false. Set to use only the cache *)
 
 exception Not_available
 
-val no_http : bool ref
+val get_image : string -> tile_t * string
+(** [get_image key] Returns the tile description and the image file name.
+   May raise [Not_available] *)
+
+val get_tile : Latlong.geographic -> int -> tile_t*string
+(** [get_tile geo zoom] May raise [Not_available] *)
+
+
 

sw/lib/ocaml/mapCanvas.ml

@@ -43,6 +43,11 @@ type projection =
   | UTM (* 1m = 1 world unit, y axis reversed *)
   | LambertIIe (* 1m = 1 world unit, y axis reversed *)
 
+let string_of_projection = function 
+    UTM -> "UTM"
+  | Mercator -> "Mercator"
+  | LambertIIe -> "LBT2e"
+
 let mercator_coeff = 5e6
 
 
@@ -66,12 +71,12 @@ class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef (
     val frame = GPack.vbox ~height ?width ()
 	
     val menubar = GMenu.menu_bar ()
-	
+
     val adj = GData.adjustment 
 	~value:1. ~lower:0.05 ~upper:10. 
 	~step_incr:0.25 ~page_incr:1.0 ~page_size:1.0 ()
   
-    val bottom = GPack.hbox  ~height:30 ()
+    val bottom = GPack.hbox ~height:30 ()
 	
     val _w = GEdit.spin_button  ~rate:0. ~digits:2 ~width:50 ~height:20 ()
 	
@@ -107,7 +112,7 @@ class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef (
       self#pack;
 
       _w#set_adjustment adj;
-      
+
       factory <- new GMenu.factory menubar;
 
       file_menu#destroy ();
@@ -155,13 +160,10 @@ class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef (
     method georef = georef
     method set_georef = fun wgs84 -> georef <- Some wgs84
 
-    method projection =
-      match projection with
-	UTM -> "UTM"
-      | Mercator -> "Mercator"
-      | LambertIIe -> "LBT2e"
+    method projection = string_of_projection projection
+      
 	
-    method world_of = fun wgs84 -> 
+    method world_of = fun wgs84 ->
       match georef with
 	Some georef -> begin
 	  match projection with

sw/lib/ocaml/mapGoogle.ml

@@ -149,3 +149,56 @@ let fill_window = fun (geomap:MapCanvas.widget) ->
 	  trees.(i) <- Tile
       | Gm.Not_available -> () in
   loop (-1.) (-1.)  2. [|gm_tiles|] 0 18 "t"
+
+
+exception To_copy of int * string
+
+let gdk_pixbuf_safe_copy_area ~dest ~dest_x ~dest_y ~width ~height ~src_x ~src_y pixbuf =
+  let dest_x, width, src_x =
+    if dest_x < 0 then 0, width+dest_x, src_x-dest_x else dest_x, width, src_x in
+  let dest_y, height, src_y =
+    if dest_y < 0 then 0, height+dest_y, src_y-dest_y else dest_y, height, src_y in
+  let width = min width (GdkPixbuf.get_width dest - dest_x)
+  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 ->
+  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
+  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
+
+  let pixel_size = 1. /. (2. ** 16.) /. 256. in
+  let width = truncate ((east -. west) /. pixel_size)
+  and height = truncate ((north -. south) /. pixel_size) in
+  let dest = GdkPixbuf.create ~width ~height () in
+  let rec loop = fun twest tsouth tsize zoom key ->
+  if not (twest > east || twest+.tsize < west || tsouth > north || tsouth+.tsize < south) then
+    let tsize2 = tsize /. 2. in
+      try
+	if zoom = 1
+	then
+	  let tile, image = Gm.get_image key in
+	  raise (To_copy (19-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 
+	  continue 0 twest (tsouth+.tsize2);
+	  continue 1 (twest+.tsize2) (tsouth+.tsize2);
+	  continue 2 (twest+.tsize2) tsouth;
+	  continue 3 twest tsouth;
+	end
+      with
+	To_copy (z, image) when z = zoom ->
+	  let dest_x = truncate ((twest -. west) /. pixel_size)
+	  and dest_y = truncate ((north -. (tsouth+.tsize)) /. pixel_size) in
+	  let width = truncate (tsize /. pixel_size) in
+	  let src_x = 0
+	  and src_y = 0 in
+	  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";
+  dest

sw/lib/ocaml/mapGoogle.mli

@@ -29,3 +29,5 @@ val display_tile : MapCanvas.widget -> Latlong.geographic -> unit
 
 val fill_window : MapCanvas.widget -> unit
 (** Filling the canvas window with Google Maps tiles *)
+
+val pixbuf : Latlong.geographic -> Latlong.geographic -> GdkPixbuf.pixbuf