Generated: Sun Aug 21 11:11:06 2011 from hgt_srtm.pl 2011/05/24 13.2 KB.
#!/usr/bin/perl -w # NAME: hgt_srtm.pl # AIM: VERY SPECIFIC use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use Cwd; my $perl_dir = 'C:\GTools\perl'; unshift(@INC, $perl_dir); require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; require 'srtm_data.pl' or die "Unableto load 'srtm_data.pl'...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $perl_dir."\\temp.$pgmname.txt"; open_log($outfile); # user variables my $load_log = 1; my $in_dir = 'C:\Qt\2010.05\qt\projects\TgScenery'; my @in_files = qw(SRTM1_Region_01.txt SRTM1_Region_02.txt SRTM1_Region_03.txt SRTM1_Region_04.txt SRTM1_Region_05.txt SRTM1_Region_06.txt SRTM1_Region_07.txt SRTM3_Africa.txt SRTM3_Australia.txt SRTM3_Eurasia.txt SRTM3_Islands.txt SRTM3_North_America.txt SRTM3_South_America.txt); ### program variables my @warnings = (); my $cwd = cwd(); my $os = $^O; my %g_ranges = (); # per key {$url} = [ $minLat, $minLon, $maxLat, $maxLon ]; #define srtm_Region_01_Url "/srtm/version2_1/SRTM1/Region_01" our $Region_01; #define srtm_Region_02_Url "/srtm/version2_1/SRTM1/Region_02" our $Region_02; #define srtm_Region_03_Url "/srtm/version2_1/SRTM1/Region_03" our $Region_03; #define srtm_Region_04_Url "/srtm/version2_1/SRTM1/Region_04" our $Region_04; #define srtm_Region_05_Url "/srtm/version2_1/SRTM1/Region_05" our $Region_05; #define srtm_Region_06_Url "/srtm/version2_1/SRTM1/Region_06" our $Region_06; #define srtm_Region_07_Url "/srtm/version2_1/SRTM1/Region_07" our $Region_07; #define srtm_Africa_Url "/srtm/version2_1/SRTM3/Arica" our $Africa; #define srtm_Australia_Url "/srtm/version2_1/SRTM3/Australia" our $Australia; #define srtm_Eurasia_Url "/srtm/version2_1/SRTM3/Eurasia" our $Eurasia; #define srtm_Islands_Url "/srtm/version2_1/SRTM3/Islands" our $Islands; #define srtm_North_America_Url "/srtm/version2_1/SRTM3/North_America" our $North_America; #define srtm_South_America_Url "/srtm/version2_1/SRTM3/South_America" our $South_America; # ================================== sub show_warnings($) { my ($val) = @_; if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { ### prt( "\nNo warnings issued.\n\n" ); } } sub pgm_exit($$) { my ($val,$msg) = @_; if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg); } show_warnings($val); close_log($outfile,$load_log); exit($val); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub process_in_file($) { my ($inf) = @_; if (! open INF, "<$inf") { pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); } my @lines = <INF>; close INF; my $lncnt = scalar @lines; prt("// Processing $lncnt lines, from [$inf]...\n"); my ($line,$list,$part,$name,$url,@arr); $list = ''; foreach $line (@lines) { chomp $line; if ($line =~ /^\#/) { if ( $line =~ /Index (.+)$/ ) { $url = $1; @arr = split('/',$url); $name = $arr[-1]; # prt("Name = [$name]\n"); prt("// Url = [$url]\n"); } next; } next if ($line =~ /^\s*$/); $part .= " " if (length($part)); $part .= $line; if (length($part) > 75) { $list .= "\"$part \"\n"; $part = ''; } } $list .= "\"$part\"\n" if (length($part)); $list =~ s/\n$//; prt("my $$name = $list;\n"); } sub getSRTM3_Africa($) { my ($rurl) = @_; my @sl; @sl = split(" ",$Africa); ${$rurl} = "/srtm/version2_1/SRTM3/Africa"; return \@sl; } sub getSRTM3_Australia($) { my ($rurl) = @_; my @sl; @sl = split(" ",$Australia); ${$rurl} = "/srtm/version2_1/SRTM3/Australia"; return \@sl; } sub getSRTM3_Eurasia($) { my ($rurl) = @_; my @sl; @sl = split(" ",$Eurasia); ${$rurl} = "/srtm/version2_1/SRTM3/Eurasia"; return \@sl; } sub getSRTM3_Islands($) { my ($rurl) = @_; my @sl; @sl = split(" ",$Islands); ${$rurl} = "/srtm/version2_1/SRTM3/Islands"; return \@sl; } sub getSRTM3_North_America($) { my ($rurl) = @_; my @sl; @sl = split(" ",$North_America); ${$rurl} = "/srtm/version2_1/SRTM3/North_America"; return \@sl; } sub getSRTM3_South_America($) { my ($rurl) = @_; my @sl; @sl = split(" ",$South_America); ${$rurl} = "/srtm/version2_1/SRTM3/South_America"; return \@sl; } sub getSRTM1Region1($) { my ($rurl) = @_; my @sl; @sl = split(" ",$Region_01); ${$rurl} = "/srtm/version2_1/SRTM1/Region_01"; return \@sl; } sub getSRTM1Region2($) { my ($rurl) = @_; my @sl; @sl = split(" ",$Region_02); ${$rurl} = "/srtm/version2_1/SRTM1/Region_02"; return \@sl; } sub getSRTM1Region3($) { my ($rurl) = @_; my @sl; @sl = split(" ",$Region_03); ${$rurl} = "/srtm/version2_1/SRTM1/Region_03"; return \@sl; } sub getSRTM1Region4($) { my ($rurl) = @_; my @sl; @sl = split(" ",$Region_04); ${$rurl} = "/srtm/version2_1/SRTM1/Region_04"; return \@sl; } sub getSRTM1Region5($) { my ($rurl) = @_; my @sl; @sl = split(" ",$Region_05); ${$rurl} = "/srtm/version2_1/SRTM1/Region_05"; return \@sl; } sub getSRTM1Region6($) { my ($rurl) = @_; my @sl; @sl = split(" ",$Region_06); ${$rurl} = "/srtm/version2_1/SRTM1/Region_06"; return \@sl; } sub getSRTM1Region7($) { my ($rurl) = @_; my @sl; @sl = split(" ",$Region_07); ${$rurl} = "/srtm/version2_1/SRTM1/Region_07"; return \@sl; } sub process_set($$) { my ($path,$ra) = @_; my ($file,$ff); $path .= "\\" if ( !($path =~ /(\\|\/)$/) ); foreach $file (@{$ra}) { $ff = $path.$file; process_in_file($ff); } } sub util_getSRTMContinent($$) { my ($lat,$lon) = @_; if (($lon >= -170) && ($lon <= -58) && ($lat <= 61) && ($lat >= 15)) { #// but there are some island exceptions if (($lat <= 29) && ($lat >= 16) && ($lon >= -179) && ($lon <= -154)) { return "Islands"; } else { return "North_America"; } } if (($lon >= -32) && ($lon <= 60) && ($lat <= 35) && ($lat >= -35) ) { #// N00E006 - return "Africa"; } if (($lon >= -95) && ($lon <= -32)&& ($lat <= 15) && ($lat >= -56)) { return "South_America"; } if (($lon >= -14) && ($lon <= 60) && ($lat <= 60) && ($lat >= 35) ) { return "Eurasia"; } if (($lon >= 60) && ($lon <= 180) && ($lat <= 60) && ($lat >= -10)) { return "Eurasia"; } if (($lon >= 110) && ($lon <= 180)&& ($lat <= -10) && ($lat >= -55)) { #// but NZ is in Islands if (($lon >= 165) && ($lon <= 180)&& ($lat <= -28) && ($lat >= -55)) { return "Islands"; } else { return "Australia"; } } if (($lon >= -180)&&($lon <= -115)&& ($lat <= -10)&&($lat >= -30)) { return "Australia"; } return "Islands"; } sub util_getSRTM1Region($$) { my ($lat,$lon) = @_; if (($lon >= -126)&&($lon >= -111)&& ($lat <= 50) && ($lat >= 38)){ return "Region_01"; } if (($lon >= -111)&&($lon <= -97)&& ($lat <= 50)&&($lat >= 38)){ return "Region_02"; } if (($lon >= -97)&&($lon <= -83)&& ($lat <= 50)&&($lat >= 38)) { return "Region_03"; } if (($lon >= -123)&&($lon <= -100)&& ($lat <= 38)&&($lat >= 28)) { return "Region_04"; } if (($lon >= -100)&&($lon <= -83)&& ($lat <= 38)&&($lat >= 25)){ return "Region_05"; } if (($lon >= -83)&&($lon <= -65)&& ($lat <= 48)&&($lat > 17)){ return "Region_06"; } if (($lon >= -180)&&($lon <= -131)&& ($lat <= 60)&&($lat >= -15)) { return "Region_07"; } return "NO REGION"; } sub get_func_list() { my @arr = (); push(@arr, \&getSRTM3_Africa); push(@arr, \&getSRTM3_Australia); push(@arr, \&getSRTM3_Eurasia); push(@arr, \&getSRTM3_Islands); push(@arr, \&getSRTM3_North_America); push(@arr, \&getSRTM3_South_America); push(@arr, \&getSRTM1Region1 ); push(@arr, \&getSRTM1Region2 ); push(@arr, \&getSRTM1Region3 ); push(@arr, \&getSRTM1Region4 ); push(@arr, \&getSRTM1Region5 ); push(@arr, \&getSRTM1Region6 ); push(@arr, \&getSRTM1Region7 ); return \@arr; } sub show_range($$) { my ($ra,$url) = @_; my ($hgt, $ns,$lat,$ew,$lon,$srtmv); my $minLat = 200; my $maxLat = -200; my $minLon = 200; my $maxLon = -200; my $reg = $url; $reg =~ s/\/srtm\/version2_1\/SRTM//; $srtmv = substr($reg,0,1); $reg = substr($reg,2); foreach $hgt (@{$ra}) { if ($hgt =~ /^(N|S)(\d{2})(E|W)(\d{3})$/) { $ns = $1; $lat = $2; $ew = $3; $lon = $4; $lat = -$lat if ($ns eq 'S'); $lon = -$lon if ($ew eq 'W'); $minLat = $lat if ($lat < $minLat); $maxLat = $lat if ($lat > $maxLat); $minLon = $lon if ($lon < $minLon); $maxLon = $lon if ($lon > $maxLon); } else { prtw("WARNING: $srtmv:$reg: Problem with [$hgt]\n"); } } $g_ranges{$url} = [ $minLat, $minLon, $maxLat, $maxLon ]; my $width = $maxLon - $minLon; my $height = $maxLat - $minLat; prt("Range:$srtmv:$reg: lat/lon MIN $minLat,$minLon, MAX $maxLat,$maxLon; hgt $height, wid $width degress\n"); my ($buck,$tmp, $key,$val,$cnt); my %blist = (); foreach $hgt (@{$ra}) { if ($hgt =~ /^(N|S)(\d{2})(E|W)(\d{3})$/) { $ns = $1; $lat = $2; $ew = $3; $lon = $4; $lat = int($lat / 10) * 10; $lon = int($lon / 10) * 10; if ($ew eq 'W') { $buck = 'w'; } else { $buck = 'e'; } $tmp = sprintf("%03d",$lon); $buck .= $tmp; if ($ns eq 'S') { $buck .= 's'; } else { $buck .= 'n'; } $tmp = sprintf("%02d",$lat); $buck .= $tmp; if (defined $blist{$buck}) { $blist{$buck}++; } else { $blist{$buck} = 1; } } } $cnt = scalar keys(%blist); prt("Fits into $cnt CHUNKS (10x10) as follows...\n"); foreach $key (sort keys %blist) { $val = $blist{$key}; prt($key."[$val] "); } prt("\n"); return \%blist; } sub process_africa() { my ($url); my $ra = getSRTM3_Africa(\$url); my $cnt = scalar @{$ra}; prt("Got $cnt array, with url [$url]\n"); my $rh = show_range($ra,$url); } sub process_all() { my $raf = get_func_list(); my ($func,$ra,$cnt,$url); my %master = (); foreach $func (@{$raf}) { $ra = $func->(\$url); $cnt = scalar @{$ra}; prt("Got $cnt array, with url [$url]\n"); my $rh = show_range($ra,$url); $master{$url} = [ $ra, $rh ]; } return \%master; } sub check_for_overlaps($) { my ($rmh) = @_; my ($url,$item,$ra,$rh,$cnt1,$cnt2,$mm,$min,$len); my ($minLat,$maxLat,$minLon,$maxLon,$msg); my ($ccnt1,$ccnt2,$wid,$hgt); $min = 0; foreach $url (keys %{$rmh}) { $url =~ s/^\/srtm\/version2_1\///; $len = length($url); $min = $len if ($len > $min); } ###$g_ranges{$url} = [ $minLat, $minLon, $maxLat, $maxLon ]; foreach $url (sort keys %{$rmh}) { $item = ${$rmh}{$url}; $ra = ${$item}[0]; $rh = ${$item}[1]; $cnt1 = scalar @{$ra}; $cnt2 = scalar keys(%{$rh}); $msg = ''; if (defined $g_ranges{$url} ) { $mm = $g_ranges{$url}; $minLat = ${$mm}[0]; $minLon = ${$mm}[1]; $maxLat = ${$mm}[2]; $maxLon = ${$mm}[3]; $wid = $maxLon - $minLon; $hgt = $maxLat - $minLat; $msg = sprintf("Min %3d,%4d, Max %3d,%4d (%3d x %3d degs)",$minLat,$minLon,$maxLat,$maxLon,$hgt,$wid); } # output $ccnt1 = sprintf("%4d",$cnt1); $ccnt2 = sprintf("%3d",$cnt2); $url =~ s/^\/srtm\/version2_1\///; $url .= ' ' while (length($url) < $min); prt("URL: $url - $ccnt1 HGT zips, $ccnt2 'chunks' $msg\n"); } } ######################################### ### MAIN ### #process_set($in_dir,\@in_files); ##process_africa(); check_for_overlaps(process_all()); pgm_exit(0,""); ######################################## # eof - hgt_srtm.pl