diff --git a/sw/ground_segment/cockpit/map2d.ml b/sw/ground_segment/cockpit/map2d.ml index 0742612b42..af11341366 100644 --- a/sw/ground_segment/cockpit/map2d.ml +++ b/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); diff --git a/sw/lib/ocaml/gm.mli b/sw/lib/ocaml/gm.mli index d8dded5516..823af18d74 100644 --- a/sw/lib/ocaml/gm.mli +++ b/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] *) + + diff --git a/sw/lib/ocaml/mapCanvas.ml b/sw/lib/ocaml/mapCanvas.ml index 8ca1fc534a..066fc77df7 100644 --- a/sw/lib/ocaml/mapCanvas.ml +++ b/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 diff --git a/sw/lib/ocaml/mapGoogle.ml b/sw/lib/ocaml/mapGoogle.ml index b10818853d..95c46a5ab1 100644 --- a/sw/lib/ocaml/mapGoogle.ml +++ b/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 diff --git a/sw/lib/ocaml/mapGoogle.mli b/sw/lib/ocaml/mapGoogle.mli index 2b158fe577..9cfe94c94e 100644 --- a/sw/lib/ocaml/mapGoogle.mli +++ b/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