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