ask to download srtm tile from GCS if not available

sw/lib/ocaml/http.ml

@@ -7,7 +7,7 @@ let file_of_url = fun ?dest url ->
   else
     let tmp_file =
       match dest with
-	Some s -> s
+        Some s -> s
       | None -> Filename.temp_file "fp" ".wget" in
     let c = Printf.sprintf "wget -nv --cache=off -O %s '%s'" tmp_file url in
     if Sys.command c = 0 then

sw/lib/ocaml/mapCanvas.ml

@@ -712,12 +712,28 @@ class widget =  fun ?(height=800) ?(srtm=false) ?width ?projection ?georef () ->
     (** ground altitude extraction from srtm data *)
     method altitude = fun wgs84 ->
       try
-	Srtm.of_wgs84 wgs84
+        Srtm.of_wgs84 wgs84
       with
-	Srtm.Tile_not_found x ->
-	  srtm#set_active false;
-	  GToolbox.message_box "SRTM" (sprintf "SRTM tile %s not found: %s ?" x (Srtm.error x));
-	  0
+        Srtm.Tile_not_found x ->
+          srtm#set_active false;
+          (*GToolbox.message_box "SRTM" (sprintf "SRTM tile %s not found: %s ?" x (Srtm.error x));*)
+          let msg = (sprintf "Oups, I can't find SRTM tile %s.\nCan I try to donwload it ?\n(%s)" x (Srtm.error x)) in
+          match GToolbox.question_box "SRTM" ["Download"; "Cancel"] msg with
+          | 1 ->
+              begin try
+                let tile_zip = x^".hgt.zip" in
+                let url = Srtm.srtm_url // (Srtm.area_of_tile x) // tile_zip in
+                let dest = Env.paparazzi_home // "data" // "srtm" // tile_zip in
+                let tmp_dest = Env.paparazzi_home // "var" // tile_zip in
+                ignore(Http.file_of_url ~dest:tmp_dest url);
+                Sys.rename tmp_dest dest;
+                self#altitude wgs84
+              with
+              | Http.Failure _ | Srtm.Tile_not_found _ ->
+                  GToolbox.message_box "SRTM" ("Sorry, tile "^x^" couldn't be downloaded");
+                  0
+              end
+          | _ -> 0
 
     method georefs = georefs
 

sw/lib/ocaml/srtm.ml

@@ -26,6 +26,8 @@
 
 open Latlong
 
+let (//) = Filename.concat
+
 type error = string
 exception Tile_not_found of string
 
@@ -52,16 +54,16 @@ let find = fun tile ->
     Not_found ->
       let (bottom, left) = tile in
       let tile_name =
-	Printf.sprintf "%c%.0f%c%03.0f" (if bottom >= 0. then 'N' else 'S') (abs_float bottom) (if left >= 0. then 'E' else 'W') (abs_float left) in
+        Printf.sprintf "%c%.0f%c%03.0f" (if bottom >= 0. then 'N' else 'S') (abs_float bottom) (if left >= 0. then 'E' else 'W') (abs_float left) in
       try
-	let f = open_compressed (tile_name ^".hgt") in
-	let n = tile_size*tile_size*2 in
-	let buf = String.create n in
-	really_input f buf 0 n;
-	Hashtbl.add htiles tile buf;
-	buf
+        let f = open_compressed (tile_name ^".hgt") in
+        let n = tile_size*tile_size*2 in
+        let buf = String.create n in
+        really_input f buf 0 n;
+        Hashtbl.add htiles tile buf;
+        buf
       with Not_found ->
-	raise (Tile_not_found tile_name)
+        raise (Tile_not_found tile_name)
 
 
 let get = fun tile y x ->
@@ -79,6 +81,18 @@ let of_wgs84 = fun geo ->
 let of_utm = fun utm ->
   of_wgs84 (Latlong.of_utm WGS84 utm)
 
+let area_of_tile = fun tile ->
+  let area = open_compressed "srtm.data.bz2" in
+  let rec _area_of_tile = fun () ->
+    try
+      Scanf.fscanf area "%s %s\n" (fun t a ->
+        if t = tile then a
+        else _area_of_tile ())
+    with
+    | End_of_file -> raise (Tile_not_found tile)
+    | _ -> _area_of_tile ()
+  in
+  _area_of_tile ()
 
 
 (* field size in bytes *)

sw/lib/ocaml/srtm.mli

@@ -41,5 +41,7 @@ val of_utm : Latlong.utm -> int
 val of_wgs84 : Latlong.geographic -> int
 (** [of_utm utm_pos] Returns the altitude of the given geographic position *)
 
+val area_of_tile : string -> string
+
 val horizon_slope : Latlong.geographic -> int -> float -> float -> float -> float
 (** [horizon_slope geo alt route half_aperture horizon] *)

sw/tools/Makefile

@@ -30,7 +30,7 @@ OCAMLNETCMA=$(shell ocamlfind query -r -a-format -predicates byte netstring)
 OCAMLLEX=ocamllex
 OCAMLYACC=ocamlyacc
 
-all: gen_common.cmo gen_aircraft.out gen_airframe.out gen_messages2.out gen_messages.out gen_ubx.out gen_mtk.out gen_flight_plan.out gen_radio.out gen_periodic.out gen_settings.out gen_tuning.out gen_xsens.out gen_modules.out find_free_msg_id.out
+all: gen_common.cmo gen_aircraft.out gen_airframe.out gen_messages2.out gen_messages.out gen_ubx.out gen_mtk.out gen_flight_plan.out gen_radio.out gen_periodic.out gen_settings.out gen_tuning.out gen_xsens.out gen_modules.out find_free_msg_id.out gen_srtm.out
 
 FP_CMO = fp_proc.cmo gen_flight_plan.cmo
 ABS_FP = $(FP_CMO:%=$$PAPARAZZI_SRC/sw/tools/%)

sw/tools/gen_srtm.ml

@@ -0,0 +1,84 @@
+(*
+ * $Id: gen_aircraft.ml 4198 2009-09-23 19:15:40Z hecto $
+ *
+ * Call to Makefile.ac with the appropriate attributes from conf.xml
+ *
+ * Copyright (C) 2003-2010 ENAC
+ *
+ * This file is part of paparazzi.
+ *
+ * paparazzi is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ *
+ * paparazzi is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with paparazzi; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 59 Temple Place - Suite 330,
+ * Boston, MA 02111-1307, USA.
+ *
+ *)
+
+
+let (//) =  Filename.concat
+let var_dir = Env.paparazzi_home // "var"
+let srtm_tmp_dir = var_dir // "srtm"
+let srtm_data = var_dir // "srtm.data.bz2"
+
+let area_list = ["Africa"; "Australia"; "Eurasia"; "Islands"; "North_America"; "South_America"]
+
+(* MAIN *)
+let () =
+  (* reading file function *)
+  let read_file_and_print = fun out area ->
+    try
+      let xml = Xml.parse_file (srtm_tmp_dir // area) in
+      prerr_endline (Printf.sprintf "parsing file %s" area);
+      let body = ExtXml.child xml "body" in
+      let ul = ExtXml.child body "ul" in
+      List.iter (fun li ->
+        let a = ExtXml.child li "a" in
+        let tile = Xml.attrib a "href" in
+        let name = String.sub tile 0 7 in
+        Printf.fprintf out "%s %s\n" name area
+      ) (List.tl (Xml.children ul)) (* skip first link "Parent directory" *)
+    with _ -> prerr_endline (Printf.sprintf "error with %s: skipping" area) (* skip file if error (DTD ?) *)
+  in
+
+  (* Fetch srtm pages *)
+  if not (Sys.file_exists srtm_tmp_dir) then
+    Unix.mkdir srtm_tmp_dir 0o755;
+  List.iter (fun area ->
+    let _ = Http.file_of_url ~dest:(srtm_tmp_dir // area) (Srtm.srtm_url // area) in
+    (* remove first line (generate xml parsing error *)
+    let _ = Sys.command ("sed -i '1d' "^(srtm_tmp_dir // area)) in
+    ()
+  ) area_list;
+  (* reading file names in dir *)
+  let file_names = Sys.readdir srtm_tmp_dir in
+
+  (* Open temporary file *)
+  let file, out = Filename.open_temp_file ~temp_dir:var_dir "srtm" ".data" in
+
+  (* Parse files for xml and read them *)
+  Array.iter (read_file_and_print out) file_names;
+
+  (* Close file *)
+  close_out out;
+
+  (* Compress file *)
+  let _ = Sys.command ("bzip2 -z "^file) in
+
+  (* Move to final name *)
+  Unix.rename (file^".bz2") srtm_data;
+  prerr_endline ("Srtm data: "^srtm_data)
+
+
+
+
+