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