Add menus for maps source (Google, OSM or MS) and policy (no http, no cache or both)

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

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

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