hgt_srtm.pl to HTML.

index -|- end

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

index -|- top

checked by tidy  Valid HTML 4.01 Transitional