From b62b2de2b3083e0f86c541226f4b59d195620dbf Mon Sep 17 00:00:00 2001 From: Pascal Brisset Date: Wed, 30 Sep 2009 20:29:31 +0000 Subject: [PATCH] Add menus for maps source (Google, OSM or MS) and policy (no http, no cache or both) --- sw/ground_segment/cockpit/gcs.ml | 46 ++++++++++++++++++++++---------- sw/lib/ocaml/gm.ml | 43 +++++++++++++++++++++++++---- sw/lib/ocaml/gm.mli | 16 +++++++---- 3 files changed, 81 insertions(+), 24 deletions(-) diff --git a/sw/ground_segment/cockpit/gcs.ml b/sw/ground_segment/cockpit/gcs.ml index 367445e5b2..717a27df14 100644 --- a/sw/ground_segment/cockpit/gcs.ml +++ b/sw/ground_segment/cockpit/gcs.ml @@ -138,12 +138,9 @@ let map_from_region = fun (geomap:G.widget) () -> save_map geomap dest nw se -(************ Google Maps handling *****************************************) +(************ Google, OSM Maps handling *****************************************) module GM = struct - let active_http = fun x -> - Gm.no_http := not x - - (** Fill the visible background with Google tiles *) + (** Fill the visible background with Google, OSM tiles *) let fill_tiles = fun geomap -> ignore (Thread.create MapGoogle.fill_window geomap) @@ -154,7 +151,7 @@ module GM = struct auto := x; update geomap -(** Creates a calibrated map from the Google tiles (selected region) *) +(** Creates a calibrated map from the Google, OSM tiles (selected region) *) let map_from_tiles = fun (geomap:G.widget) () -> match geomap#region with None -> GToolbox.message_box "Error" "Select a region (shift-left drag)" @@ -324,9 +321,9 @@ let options = "-mercator", Arg.Unit (fun () -> projection:=G.Mercator),"Switch to (Google Maps) Mercator projection, default"; "-mplayer", Arg.Set_string mplayer, "Launch mplayer with the given argument as X plugin"; "-no_alarm", Arg.Set no_alarm, "Disables alarm page"; - "-no_google_http", Arg.Set Gm.no_http, "Switch off Google Maps downloading"; + "-no_google_http", Arg.Unit (fun () -> Gm.set_policy Gm.NoHttp), "Switch off Google Maps downloading"; "-ortho", Arg.Set_string get_bdortho, "IGN tiles path"; - "-osm", Arg.Unit (fun () -> Gm.maps_source := Gm.OSM), "Use OpenStreetMap database (default is Google)"; + "-osm", Arg.Unit (fun () -> Gm.set_maps_source Gm.OSM), "Use OpenStreetMap database (default is Google)"; "-particules", Arg.Set display_particules, "Display particules"; "-plugin", Arg.Set_string plugin_window, "External X application (launched with the id of the plugin window as argument)"; "-ref", Arg.Set_string geo_ref, "Geographic ref (e.g. 'WGS84 43.605 1.443')"; @@ -364,24 +361,45 @@ let create_geomap = fun switch_fullscreen editor_frame -> (* Maps handling *) let map_menu = geomap#factory#add_submenu "Maps" in let map_menu_fact = new GMenu.factory ~accel_group map_menu in - ignore (map_menu_fact#add_item "Load" ~key:GdkKeysyms._M ~callback:(load_map geomap)); + ignore (map_menu_fact#add_item "Load User Map" ~key:GdkKeysyms._M ~callback:(load_map geomap)); if !edit then ignore (map_menu_fact#add_item "Calibrate" ~key:GdkKeysyms._C ~callback:(EditFP.calibrate_map geomap editor_frame accel_group)); + (* Choose the map source *) + let maps_source_menu = map_menu_fact#add_submenu "Maps Source" in + let maps_source_fact = new GMenu.factory maps_source_menu in + let group = ref None in + List.iter + (fun maps_source -> + let callback = fun b -> if b then Gm.set_maps_source maps_source in + let menu_item = maps_source_fact#add_radio_item ~group: !group ~callback (Gm.string_of_maps_source maps_source) in + group := menu_item#group) + Gm.maps_sources; + + (* Choose the map policy *) + let maps_policy_menu = map_menu_fact#add_submenu "Maps Policy" in + let maps_policy_fact = new GMenu.factory maps_policy_menu in + let group = ref None in + List.iter + (fun policy -> + let callback = fun b -> if b then Gm.set_policy policy in + let menu_item = maps_policy_fact#add_radio_item ~group: !group ~callback (Gm.string_of_policy policy) in + group := menu_item#group) + Gm.policies; + (* Google fill menu entry and toolbar button *) let callback = fun _ -> GM.fill_tiles geomap in - ignore (map_menu_fact#add_item "GoogleMaps Fill" ~key:GdkKeysyms._G ~callback); + ignore (map_menu_fact#add_item "Maps Fill" ~key:GdkKeysyms._G ~callback); let b = GButton.button ~packing:geomap#toolbar#add () in ignore (b#connect#clicked callback); let pixbuf = GdkPixbuf.from_file (Env.gcs_icons_path // "googleearth.png") in ignore (GMisc.image ~pixbuf ~packing:b#add ()); - let tooltips = GData.tooltips () in + let tooltips = GData.tooltips () in tooltips#set_tip b#coerce ~text:"Google maps fill"; - ignore (map_menu_fact#add_check_item "GoogleMaps Http" ~key:GdkKeysyms._H ~active:true ~callback:GM.active_http); - ignore (map_menu_fact#add_check_item "GoogleMaps Auto" ~active:!GM.auto ~callback:(GM.active_auto geomap)); + ignore (map_menu_fact#add_check_item "Maps Auto" ~active:!GM.auto ~callback:(GM.active_auto geomap)); 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 Google Tiles" ~key:GdkKeysyms._T ~callback:(GM.map_from_tiles geomap)); + ignore (map_menu_fact#add_item "Dump map of Tiles" ~key:GdkKeysyms._T ~callback:(GM.map_from_tiles geomap)); ignore (map_menu_fact#add_item "Load sector" ~callback:(Sectors.load geomap)); (** Connect Google Maps display to view change *) diff --git a/sw/lib/ocaml/gm.ml b/sw/lib/ocaml/gm.ml index 921158e86a..69dc39568c 100644 --- a/sw/lib/ocaml/gm.ml +++ b/sw/lib/ocaml/gm.ml @@ -40,9 +40,13 @@ type tile_t = { height : float (* Latitude difference *) } -type maps_source = Google | OSM +type maps_source = Google | OSM | MS +let maps_sources = [Google; OSM; MS] +let string_of_maps_source = function + Google -> "Google" | OSM -> "OSM" | MS -> "MS" let maps_source = ref Google +let set_maps_source = fun s -> maps_source := s let mkdir = fun d -> if not (Sys.file_exists d) then @@ -156,7 +160,7 @@ let get_from_cache = fun dir f -> let fi = files.(i) in let fi_key = try Filename.chop_extension fi with _ -> fi in if fi_key <> "" && is_prefix fi_key f then - (tile_of_key fi_key, !cache_path // fi) + (tile_of_key fi_key, dir // fi) else loop (i+1) else @@ -181,20 +185,46 @@ let xyz_of_qsrt = fun s -> done; (!x, !y, n-1) +let ms_key = fun key -> + let n = String.length key in + let ms_key = String.create (n-1) in + for i = 1 to n - 1 do + ms_key.[i-1] <- + match key.[i] with + 'q' -> '0' + | 'r' -> '1' + | 's' -> '3' + | 't' -> '2' + | _ -> invalid_arg "Gm.ms_key" + done; + ms_key + + let url_of_tile_key = fun maps_source s -> let (x, y, z) = xyz_of_qsrt s in match maps_source with Google -> sprintf "http://khm0.google.com/kh/v=45&x=%d&s=&y=%d&z=%d" x y z | OSM -> sprintf "http://tile.openstreetmap.org/%d/%d/%d.png" z x y + | MS -> sprintf "http://a0.ortho.tiles.virtualearth.net/tiles/a%s.jpeg?g=%d" (ms_key s) (z+32) + let get_cache_dir = function Google -> !cache_path (* Historic ! Should be // Google *) | OSM -> !cache_path // "OSM" + | MS -> !cache_path // "MS" exception Not_available -let no_http = ref false +type policy = CacheOrHttp | NoHttp | NoCache +let string_of_policy = function + CacheOrHttp -> "CacheOrHttp" + | NoHttp -> "NoHttp" + | NoCache -> "NoCache" +let policies = [CacheOrHttp; NoHttp; NoCache] +let policy = ref CacheOrHttp +let set_policy = fun p -> + policy := p let remove_last_char = fun s -> String.sub s 0 (String.length s - 1) @@ -202,9 +232,12 @@ 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; - try get_from_cache cache_dir key with + try + if !policy = NoCache then raise Not_found; + get_from_cache cache_dir key + with Not_found -> - if !no_http then raise Not_available; + 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 diff --git a/sw/lib/ocaml/gm.mli b/sw/lib/ocaml/gm.mli index d5f93501f1..21ca49edec 100644 --- a/sw/lib/ocaml/gm.mli +++ b/sw/lib/ocaml/gm.mli @@ -35,7 +35,9 @@ type tile_t = { height : float (* Latitude difference *) } -type maps_source = Google | OSM +type maps_source = Google | OSM | MS +val string_of_maps_source : maps_source -> string +val maps_sources : maps_source list val tile_of_geo : Latlong.geographic -> int -> tile_t (** [tile_string geo zoom] Returns the tile description containing a @@ -46,17 +48,21 @@ val tile_of_key : string -> tile_t named tile. *) val cache_path : string ref -val no_http : bool ref -(** Initialized to false. Set to use only the cache *) -val maps_source : maps_source ref +type policy = CacheOrHttp | NoHttp | NoCache +val string_of_policy : policy -> string +val policies : policy list +val set_policy : policy -> unit +(** Initialized to CacheOrHttp using cache and http access *) + +val set_maps_source : maps_source -> unit (** Initialized to Google *) exception Not_available val get_image : string -> tile_t * string (** [get_image key] Returns the tile description and the image file name. - May raise [Not_available] *) + May raise [Not_available] *) val get_tile : Latlong.geographic -> int -> tile_t*string (** [get_tile geo zoom] May raise [Not_available] *)