chkpylons.pl to HTML.

index -|- end

Generated: Mon Aug 16 14:14:05 2010 from chkpylons.pl 2010/03/02 8.2 KB.

#!/perl -w
# NAME: chkpylons.pl
# AIM: Read FG DATA 'STG' file, and use sggeod.exe to get distance between pylons
# very specific
# 2010/03/02  - geoff mclane - http://geoffair.net/mperl/
use strict;
use warnings;
use File::Basename;
use Cwd;
unshift(@INC, 'C:\GTools\perl');
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /\w{1}:\\.*/) {
    my @tmpsp = split(/\\/,$pgmname);
    $pgmname = $tmpsp[-1];
}
my $perl_dir = 'C:\GTools\perl';
my $outfile = $perl_dir."\\temp.$pgmname.txt";
open_log($outfile);

# user variables
my $load_log = 1;
my $min_dist = 100.0;   # rather arbitrary choice

### program variables
#my $inp_file = 'C:\FGCVS\FlightGear\data\Scenery\Objects\w130n30\w123n37\942050.stg';
my $inp_file = 'C:\FGCVS\FlightGear\data\Scenery\Objects\w130n30\w123n37\942051.stg';

# DEBUG
my $dbg_01 = 0; # prt("$i2:$j2: $ln\n"); prt("$lnn1: $line1\n"); prt("$lnn2: $line2\n");
my $dbg_02 = 0; # prt("[dbg_02] $i2:$lnn1: $lat1,$lon1 ($don1)\n") if ($dbg_02);

my @warnings = ();
my $cwd = cwd();

sub pgm_exit($$) {
    my ($val,$msg) = @_;
    if (length($msg)) {
        $msg .= "\n" if (!($msg =~ /\n$/));
        prt($msg)
    }
    close_log($outfile,$load_log);
    exit($val);
}


sub prtw($) {
   my ($tx) = shift;
   $tx =~ s/\n$//;
   prt("$tx\n");
   push(@warnings,$tx);
}

sub show_warnings() {
   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 process_file($) {
    my ($fil) = @_;
    if (!open INP, "<$fil") {
        prt("ERROR: Unable to open file [$fil]!\n");
        pgm_exit(1,"");
    }
    my @lines = <INP>;
    close INP;
    my $lncnt = scalar @lines;
    my @list = ();
    my %hash = ();
    prt("Processing $lncnt lines, from [$fil]...\n");
    my ($i,$line,@arr,$sc,$lon,$lat);
    for ($i = 0; $i < $lncnt; $i++) {
        $line = $lines[$i];
        $line = trim_all($line);
        next if (length($line) == 0);
        if ($line =~ /Power/) {
            # prt("$line\n");
            @arr = split(/\s/,$line);
            $sc = scalar @arr;
            if ($sc == 6) {
                $lon = $arr[2];
                $lat = $arr[3];
                # prt("$lat,$lon\n");
                push(@list, [$i,$lat,$lon,0,0,0,0,0]);
            } else {
                prt("$line\n");
            }
        }
    }
    $lncnt = scalar @list;
    prt("Got $lncnt Power pylons lines...\n");
    $hash{'lines'} = \@lines;
    $hash{'pylons'} = \@list;
    return \%hash;
}

sub process_ref_hash($) {
    my ($rh) = @_;
    my $rp = ${$rh}{'pylons'};
    my $rl = ${$rh}{'lines'};
    my $lcnt = scalar @{$rp};
    prt("Process $lcnt pylons... for a minumum distance of $min_dist meters...\n");
    my ($i,$i2,$rll1,$lnn1,$lat1,$lon1);
    my ($j,$j2,$rll2,$lnn2,$lat2,$lon2);
    my (@arr,$ln,@arr2,$dist);
    my ($line1,$line2,$don1,$done,$fnd);
    my ($heading,$sgpath);
    my @pairs = ();
    for ($i = 0; $i < $lcnt; $i++) {
        $i2 = $i + 1;
        $rll1 = ${$rp}[$i];
        $lnn1 = ${$rll1}[0];
        $lat1 = ${$rll1}[1];
        $lon1 = ${$rll1}[2];
        $don1 = ${$rll1}[3];
        if ($dbg_02) {
            prt("[dbg_02] $i2:$lnn1: $lat1,$lon1 ($don1)\n");
        } else {
            prt("Done $i...\n") if ($i && (($i % 50) == 0));
        }
        next if ($don1);
        ${$rll1}[3] = 1;    # set DONE this pylon
        ${$rp}[$i] = $rll1; # and update
        $line1 = ${$rl}[$lnn1];
        $line1 = trim_all($line1);
        #for ($j = 0; $j < $lcnt; $j++) {
        for ($j = $i2; $j < $lcnt; $j++) {
            $j2 = $j + 1;
            $rll2 = ${$rp}[$j];
            $done = ${$rll2}[3];
            #if ($i != $j) {
            if ($done == 0) {
                $lnn2 = ${$rll2}[0];
                $lat2 = ${$rll2}[1];
                $lon2 = ${$rll2}[2];
               if (open (SGG, "sggeod $lat1,$lon1 $lat2,$lon2|")) {
                    @arr = <SGG>;
                    close SGG;
                    $fnd = 0;
                    foreach $ln (@arr) {
                     chomp $ln;
                     if( length($ln) ) {
                            # the line sort looks like
                            # 0         1          2       3        4         5     6     7
                            # Distance: 672.615561 meters, heading: 42.832385 degs, path: w130n30/w123n37/942051.stg
                            if ($ln =~ /^Distance:\s+/) {
                                $fnd = 1;
                                @arr2 = split(/\s/,$ln);
                                if (scalar(@arr2) > 7) {
                                    $dist = $arr2[1];
                                    $heading = $arr2[4];
                                    $sgpath  = $arr2[7];
                                    if ($dist < $min_dist) {
                                        $line2 = ${$rl}[$lnn2];
                                        $line2 = trim_all($line2);
                                        if ($dbg_01) {
                                            prt("$i2:$j2: $ln\n");
                                            prt("$lnn1: $line1\n");
                                            prt("$lnn2: $line2\n");
                                        }
                                        ${$rll2}[3] = 1;        # set DONE
                                        ${$rll2}[4] = $i;      # matched with index
                                        ${$rll2}[5] = $dist;    # add distance
                                        ${$rll2}[6] = $heading;
                                        ${$rll2}[7] = $sgpath;
                                        ${$rp}[$j] = $rll2; # and update
                                        push(@pairs, [$i, $j]);
                                    }
                                } else {
                                    pgm_exit(1,"ERROR: Ran sggeod, but line '$ln' did not split correctly! Aborting...\n");
                                }
                                last;
                            }
                        }
                    }
                    if ( !$fnd ) {
                        pgm_exit(1,"ERROR: Ran sggeod, but no line 'Distance: '! Aborting...\n");
                    }
                } else {
                    pgm_exit(1,"Failed to run sggeod...!\n");
                }
            }
        }
    }
    ${$rh}{'pairs'} = \@pairs;
    return $rh;
}

sub show_pairs($) {
    my ($rh) = @_;
    my $rp = ${$rh}{'pylons'};
    my $rl = ${$rh}{'lines'};
    my $pr = ${$rh}{'pairs'};
    my $pcnt = scalar @{$pr};
    prt( "Found $pcnt pairs, less than $min_dist appart...\n");
    my ($i,$rpr,$i1,$i2,$ii);
    my ($rll1,$lnn1,$lat1,$lon1,$don1);
    my ($rll2,$lnn2,$lat2,$lon2,$don2);
    my ($line1,$line2,$dist);
    my ($head,$path);
    for ($i = 0; $i < $pcnt; $i++) {
        $ii = $i + 1;
        $rpr = ${$pr}[$i];
        $i1 = ${$rpr}[0];   # get index
        $i2 = ${$rpr}[1];

        $rll1 = ${$rp}[$i1];
        $lnn1 = ${$rll1}[0];
        $lat1 = ${$rll1}[1];
        $lon1 = ${$rll1}[2];
        $don1 = ${$rll1}[3];

        $rll2 = ${$rp}[$i2];
        $lnn2 = ${$rll2}[0];
        $lat2 = ${$rll2}[1];
        $lon2 = ${$rll2}[2];
        $don2 = ${$rll2}[3];
        $dist = ${$rll2}[5];
        $head = ${$rll2}[6];
        $path = ${$rll2}[7];

        $line1 = ${$rl}[$lnn1];
        $line1 = trim_all($line1);
        $line2 = ${$rl}[$lnn2];
        $line2 = trim_all($line2);

        prt("$ii:$i1:$i2: Distance: $dist meters, Heading: $head, Path: $path\n");
        prt("$lnn1: $line1\n");
        prt("$lnn2: $line2\n");

    }

}
#########################################
### MAIN ###
#prt( "$pgmname: in [$cwd]: Hello, World...\n" );
my $ref_hash = process_file($inp_file);
my $ref_hash2 = process_ref_hash($ref_hash);
show_pairs($ref_hash2);

pgm_exit(0,"Normal exit(0)");
########################################
# eof - chkpylons.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional