fg_signs_test.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:37 2010 from fg_signs_test.pl 2008/12/13 6.9 KB.

#!/perl -w
# NAME: fg_signs_test.pl
# AIM: Just TESTING parts of the original 'signs' perl script
# 12/12/2008 geoff mclane http://geoffair.net/mperl
use strict;
use warnings;
use Cwd;
# for WIN32
use Win32::Console::ANSI;
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 $outfile = "temp.$pgmname.txt";
open_log($outfile);
prt( "$0 ... Hello, World ...\n" );
my $def_fg_root = "C:\\FG\\27\\data";
my $BASEDIR = $def_fg_root.'/Local/signs';
my $PI = 3.1415926535897932384626433832795029;
my $D2R = $PI / 180;
my $R2D = 180 / $PI;
my $ERAD = 6378138.12;
my $FGFS_IO;
my $ERR = 0;
my $WARN = 1;
my $INFO = 2;
my $BULK = 3;
my $DEBUG = 4;
my $VERBOSITY = $DEBUG;
my @FILES;
my $RANGE = 2000;
my $DUMP;
my $FILL;
my $CONFIGFILE;
my $APT;
my @APTCONF;
my @FORMAT;
my @LOC = ();
my @SIGNS;
my $INTERVAL = 1;
my $HOTLISTSIZE = 500;
my $RESORTDIST = 0.00005;
my $CLR_ERR = "41m\033[33;1";
my $CLR_WARN = "47m\033[31;1";
my $CLR_INFO = "32";
my $CLR_BULK = "";
my $CLR_DEBUG = "36;1";
#             $ERR      $WARN      $INFO      $BULK      $DEBUG
my @COLOR = ( $CLR_ERR, $CLR_WARN, $CLR_INFO, $CLR_BULK, $CLR_DEBUG );
#my @COLOR = ("31;1", "31", "32", "",   "36;1");
my $USECOLOR = 1;
my $MAXNUMSIGNS;
my $NUMSIGNS;
my $dir = cwd();
prt( "Current work directory = $dir\n" );
if( chdir( $def_fg_root ) ) {
    $dir = cwd();
    &log( $BULK, "Directory change successfully ... to $dir ..." );
} else {
    &log( $ERR, "chdir FAILED ... $! ..." );
    exit(1);
}
$NUMSIGNS = $MAXNUMSIGNS = grep /\/sign\d+\.xml$/, ls($BASEDIR);
&log( $DEBUG, "Got $NUMSIGNS XML files ..." );
read_config();
@FILES = ls("$BASEDIR/data");
foreach my $file (@FILES) {
    prt( "$file\n" );
}
read_data(\@FILES);
my $lcnt = scalar @LOC;
&log( $WARN, "Got $lcnt locations ..." );
if ($RANGE) {
    # KSFO San Francisco Intl (37.6208607739872,-122.381074803838)
    $DUMP = 'c:\Gtools\perl\temploc.txt';
    sort_per_a_location(-122.381074803838, 37.6208607739872);
}
close_log($outfile,0);
exit(0);
sub coord_dist_sq($$$$$$) {
##sub coord_dist_sq {
   my ($xa, $ya, $za, $xb, $yb, $zb) = @_;
   my $x = $xb - $xa;
   my $y = $yb - $ya;
   my $z = $zb - $za;
   return $x * $x + $y * $y + $z * $z;
}
sub sort_locations($$$$) {
   my ($x, $y, $z, $list) = @_;
    # 0    1    2    3     4  5  6  7     8       9
     # typ, lon, lat, elev, x, y, z, name, distsq, filenum
   map { $$_[8] = coord_dist_sq($x, $y, $z, @$_[4], @$_[5], @$_[6]) } @$list;
   #map { $$_[8] = coord_dist_sq($x, $y, $z, @$_[4, 5, 6]) } @$list;
   @$list = sort { $$a[8] <=> $$b[8] } @$list;
}
sub sort_per_a_location {
   my ($oldlon, $oldlat) = @_;
   ##fgfs_get_coord(\$oldlon, \$oldlat) or return 0;
   my ($oldx, $oldy, $oldz) = ll2xyz($oldlon, $oldlat);
   sort_locations($oldx, $oldy, $oldz, \@LOC);
   if (defined $RANGE) {
      my $i;
      for ($i = 0; $i < @LOC; $i++) {
         #last if $ERAD * sqrt ${@{$LOC[$i]}}[8] >= $RANGE;
         last if ($ERAD * sqrt( $LOC[$i][8] )) >= $RANGE;
      }
      $i = $MAXNUMSIGNS if $i < $MAXNUMSIGNS;
      @LOC = @LOC[0 .. $i - 1];
   }
   if (defined $DUMP) {
      &log($INFO, "dumping data: $DUMP (" . scalar(@LOC) . " entries)");
      open(D, ">$DUMP") || fatal("can't write to file $DUMP: $!");
      print D (join " ", @$_[0, 1, 2, 3, 7]) . "\n" foreach @LOC;
      close D || fatal("can't close file $DUMP: $!");
   }
}
# sub read_config() {
sub read_config {
    if ( -f "$BASEDIR/signsrc") {
        $CONFIGFILE = "$BASEDIR/signsrc";
    } else {
        fatal("can't find CONFIG file $BASEDIR/signsrc!!!\n");
    }
   ##foreach ("$FG_HOME/signsrc", "$HOME/.signsrc", "$BASEDIR/signsrc") {
   ##   $CONFIGFILE = $_ and last if -f $_;
   ##}
   return unless defined $CONFIGFILE;
   open(C, '<', $CONFIGFILE) || fatal("can't open config file $CONFIGFILE");
    print "Processing $CONFIGFILE ...\n";
    my $linecnt = 0;
    my $chkline = 0;
   while (<C>) {
      chomp;
        $linecnt++;
      s/\s*#.*//;
      /^\s*$/ and next;
        $chkline++;
      if (/^([A-Z])\s+(\w+)\s+(\S+)\s+(.*)\s*$/) {
         my ($type, $tag, $regex) = ($1, $2, $3);
         my ($color, $font, $size, $encoding);
         foreach (split /\s+/, $4) {
            if (/^color=(.*)/) {
               $color = $1;
            } elsif (/^font=(.*)/) {
               $font = $1;
            } elsif (/^size=(.*)/) {
               $size = $1;
            } elsif (/^encoding=(.*)/) {
               $encoding = $1;
            } else {
               fatal("config file $CONFIGFILE contains garbage in line $.: '$_'");
            }
         }
         &log( $DEBUG, "push \@FORMAT, [$type, $tag, $regex, $color, $font, $size, $encoding]; \n" );
         push @FORMAT, [$type, $tag, $regex, $color, $font, $size, $encoding];
      } elsif (/^\s*(\S+)\s*:\s*(.*)\s*$/) {
         &log( $DEBUG, "push \@APTCONF, [$1, $_, $2]; \n" );
         push @APTCONF, [$1, split /\s+/, $2];
      } else {
            &log( $DEBUG, "Unshift???\n" );
         unshift @ARGV, split;
      }
   }
   close C || fatal("can't close config file $CONFIGFILE");
    &log ($DEBUG, "Processed $linecnt lines, but only checked $chkline lines ..." );
}
#sub ls($) {
sub ls {
   my $dir = shift;
   $dir =~ s/\/*$//;
   opendir(D, $dir) || fatal("can't open directory $dir: $!");
   @_ = grep { !/^\./ && -f "$dir/$_" && s,^,$dir/, } readdir D;
   closedir(D) || fatal("can't close directory $dir: $!");
   return @_;
}
##sub ll2xyz($$) {
sub ll2xyz {
   my $lon = (shift) * $D2R;
   my $lat = (shift) * $D2R;
   my $cosphi = cos $lat;
   my $di = $cosphi * cos $lon;
   my $dj = $cosphi * sin $lon;
   my $dk = sin $lat;
   return ($di, $dj, $dk);
}
# sub read_data($) {
sub read_data {
   my $files = shift;
   my %nodup;
   foreach (@$files) {
      /README|CVS/ and next;
      #/^\// or $_ = "$ENV{PWD}/" . $_;
      #/^\// or $_ = $cwd."/" . $_;
      $nodup{$_} = ":-P";
   }
   @$files = keys %nodup;
   my $i = 0;
    my @lines = ();
   foreach (@$files) {
      ##open(N, /\.gz$/ ? "gunzip -c $_|" : "<$_") or fatal("can't open file $_: $!");
      open(N, /\.gz$/ ? "gzip -d -c $_|" : "<$_") or fatal("can't open file $_: $!");
      &log($INFO, "reading data: $_ ($i)");
      foreach (<N>) {
         chomp;
         s/\s*#.*//;
         # type, lon, lat, elev, name
         /^(.)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*)/ or next;
         # type, lon, lat, elev, x, y, z, name, distsq, filenum
            my $type = $1;
            my $lon = $2;
            my $lat = $3;
            my $elev = $4;
            my $name = $5;
            my ($x, $y, $z) = ll2xyz($lon, $lat);
         push @LOC, [$1, $2, $3, ($4 - 600) / 0.3048, ll2xyz($2, $3), $5, -1, $i];
      }
      close N or fatal("can't close file $_: $!");
      $i++;
   }
}
##sub fatal() {
sub fatal {
   &log($ERR, "$0: @_");
   exit -1;
}
##sub log() {
sub log {
   my $v = shift;
   return if $v > $VERBOSITY;
   $v = 4 if $v > 4;
    my $msg = '';
   $msg .= "\033[$COLOR[$v]m" if $USECOLOR;
   $msg .= "@_";
   $msg .= "\033[m" if $USECOLOR;
    prt( "$msg\n" );
   #print "\n";
}
# eof - fg_signs_test.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional