fg_signs.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:37 2010 from fg_signs.pl 2008/12/12 15.7 KB.

#!/usr/bin/perl -w
# Melchior FRANZ <mfranz # aon : at>
# $Id: signs,v 1.37 2005/06/01 15:53:00 m Exp $
use strict;
use IO::Socket;
#use POSIX qw(nice);
use Cwd;
# for WIN32
use Win32::Console::ANSI;
my $def_fg_root = "C:\\FG\\27\\data";
my $def_fg_rt = 'C:\FG\27\bin';
my $fg_binary = 'flightgear';
if (! chdir($def_fg_rt) ) {
    die "ERROR: Unable to change to $def_fg_rt ...\n";
}
my $cwd = cwd();
my $HOME = $ENV{HOME} || ".";
my $FG_HOME = $ENV{FG_HOME} || $HOME . "/.fgfs";
my $FG_ROOT = $ENV{FG_ROOT} || $def_fg_root;
my $BASEDIR = "$FG_ROOT/Local/signs";
my $FGFS = $fg_binary;
my $HOST = "localhost";
my $PORT = 5500;
my $INTERVAL = 1;
my $HOTLISTSIZE = 500;
my $RESORTDIST = 0.00005;
my @COLOR = ("31;1", "31", "32", "", "36;1");
my $USECOLOR = 0;
my $MAXNUMSIGNS;
my $NUMSIGNS;
my $help = <<EOF;
Usage:
   signs [-q] [-v] [[+d|-d] <data-path>] [-o <path>] [-r <range>] [-c|<fgfs options>]
   -h  ... output this help screen
   -q  ... suppress messages
   -v  ... verbose
   -d  ... replace file list with file or all files in a directory
   +d  ... add data source (file or directory) to database file list
   -r  ... keep only locations within this km-range in memory
   -o  ... write list of all locations in memory, sorted by distance
   -c  ... generate textures for all locations and exit
   <data-path> may be just -, which makes -d- just clear the file list
Examples:
   \$ signs -r1000 --aircraft=ufo --airport=LOWL
Environment:
   SIGNS ... options in this variable are prepended to the argument list
Files:
   signsrc
Comments:
   The "signs" program reads all files in the "data" directory. You can accelerate
   the script by loading less locations. This can be done by creating extra
   directories in \$FG_ROOT/Local/signs/ and putting your favorite data files
   there (or links to files in data/), as well as stripped down airport lists.
   signs can then be told to use this directory instead of data/.
   For example, Austrians might want to organize their data like this:
      \$ cd \$FG_ROOT/Local/signs
      \$ mkdir Austria
   # write a selection of airports within 500 km range
   # and add the Austrian location database
      \$ ./signs -r500 -o./Austria/nearby_airports
      \$ cp /download/austria.gz ./Austria/
   # now use these nearby airports and Austrian locations
      \$ ./signs -d Austria --aircraft=b1900d --airport=LOXT
   # You can also put "-d Austria" into the configuration file.
   # Here's how you can create a selection of European airports
   # (including Israel and Turkey):
      \$ zgrep " [EL][A-Z][A-Z][A-Z] " ./data/airports > ./Europe/airports
      \$ gzip ./Europe/airports   # optional
EOF
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;
my $DUMP;
my $FILL = 1;   # build a cache of signs ...
my $CONFIGFILE;
my $APT;
my @APTCONF;
my @FORMAT;
my @LOC;
my @SIGNS;
my $ccnt = 0;
my $mcnt = 0;
sub main() {
   $NUMSIGNS = $MAXNUMSIGNS = grep /\/sign\d+\.xml$/, ls($BASEDIR);
   read_config();
   @FILES = ls("$BASEDIR/data");
   my @fgfsargs = parse_options();
   &log($INFO, "config file: $CONFIGFILE") if defined $CONFIGFILE;
   read_data(\@FILES);
   &log(@LOC ? $INFO : $WARN, scalar(@LOC) . " locations in data base");
   @LOC or exit 0;
   foreach ("$BASEDIR/cache", "$BASEDIR/cache/A", "$BASEDIR/cache/B", "$BASEDIR/cache/C") {
      -d or mkdir $_ or fatal("can't create directory '$_'");
   }
    $mcnt = scalar @LOC;
   if ($FILL) {
        # 0    1    2    3     4  5  6  7     8       9
       # typ, lon, lat, elev, x, y, z, name, distsq, filenum
      create_sign(@$_[0, 7, 9]) foreach @LOC;
#        my $cnt = 0;
#        foreach (@LOC) {
#            create_sign(@$_[0, 7, 9]);
#            $cnt++;
#            last if ($cnt > 10);
#        }
      exit 0;
   }
   if (my $pid = fork) {
      # nice(20);
      main_loop();
   } else {
      defined $pid or fatal("cannot fork: $!");
      exec("$FGFS --telnet=$PORT --config=$BASEDIR/signs.xml @fgfsargs");
   }
   exit 0;
} main;
sub read_config() {
   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");
   while (<C>) {
      chomp;
      s/\s*#.*//;
      /^\s*$/ and next;
      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 $.: '$_'");
            }
         }
         push @FORMAT, [$type, $tag, $regex, $color, $font, $size, $encoding];
      } elsif (/^\s*(\S+)\s*:\s*(.*)\s*$/) {
         push @APTCONF, [$1, split /\s+/, $2];
      } else {
         unshift @ARGV, split;
      }
   }
   close C || fatal("can't close config file $CONFIGFILE");
}
sub parse_options() {
   my @args = ();
   sub argument {
      map { return $_ if defined $_ and $_ ne "" } @_;
      shift @ARGV;
      return $ARGV[0];
   }
   unshift @ARGV, split /\s+/, $ENV{'SIGNS'} if defined $ENV{'SIGNS'};
   while (1) {
      $_ = $ARGV[0];
      if (not defined $_) {
         if (not defined $APT) {
            $_ = "--airport=KSFO";
         } else {
            last;
         }
      }
      if (/^--$/) {
         shift @ARGV;
         push @args, @ARGV;
         @ARGV = ();
      } elsif (/^-o(.*)/) {
         my $path = argument($1);
         defined $path or fatal("-o option lacks <path> argument");
         $path =~ s/^~\//$HOME\//;
         $DUMP = $path;
      } elsif (/^-r(.*)/) {
         $RANGE = argument($1) * 1000;
         defined $RANGE or fatal("-r option lacks number argument (range in km)");
      } elsif (/^([-+])d(.*)/) {
         @FILES = () if $1 eq "-";
         my $path = argument($2);
         defined $path or fatal("-d option lacks <path> argument");
         if ($path eq "-") {
            @FILES = ();
         } else {
            $path =~ s/^~\//$HOME\//;
            $path = "$BASEDIR/$path";
            if (-d $path) {
               push @FILES, ls($path);
            } elsif (-f $path) {
               push @FILES, $path;
            } else {
               fatal("-d: argument '$path' is neither a file, nor a directory");
            }
         }
      } elsif (/^-c$/) {
         $FILL = 1;
      } elsif (/^-(v+)$/) {
         $VERBOSITY += length($1);
      } elsif (/^-q$/) {
         $VERBOSITY = 0;
      } elsif (/^-h$/) {
         print $help;
         exit 0;
      } elsif (/^-V$/) {
         ($_ = '$Revision: 1.37 $') =~ s/.*(\d+\.\d+).*/print "$1\n"/e;
         exit 0;
      } elsif (/^(--airport=)(.*)$/) {
         $APT = uc($2);
         push @args, $1 . $APT;
         shift @ARGV;
         foreach (@APTCONF) {
            my ($regex, @x) = @$_;
            unshift @ARGV, @x and last if $2 =~ /$regex/i;
         }
         next;
      } else {
         push @args, $_;
      }
      shift @ARGV;
   }
   return @args;
}
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;
   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;
            #           0    1    2    3                   4  5  6         7     8       9
         #           typ, lon, lat, elev,               x, y, z,        name, distsq, filenum
         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 main_loop() {
   $FGFS_IO = fgfs_connect($HOST, $PORT, 120) || die " can't open socket\n";
   fgfs_send("data");
   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: $!");
   }
   $HOTLISTSIZE = @LOC if $HOTLISTSIZE > @LOC;
   my @hotlist = @LOC[0 .. $HOTLISTSIZE - 1];
   fgfs_set("/sim/rendering/signs/signs-max", $MAXNUMSIGNS) or return;
   fgfs_set("/sim/rendering/signs/locations-max", scalar @LOC) or return;
   for (my $i = 0;; $i++) {
      sleep $INTERVAL;
      my ($lon, $lat);
      fgfs_get_coord(\$lon, \$lat) or last;
      my ($x, $y, $z) = ll2xyz($lon, $lat);
      if (coord_dist_sq($x, $y, $z, $oldx, $oldy, $oldz) > $RESORTDIST) {
         &log($INFO, "re-sorting");
         sort_locations($x, $y, $z, \@LOC);
         @hotlist = @LOC[0 .. $HOTLISTSIZE - 1];
         ($oldlon, $oldlat, $oldx, $oldy, $oldz) = ($lon, $lat, $x, $y, $z);
         &log($INFO, "done");
      } else {
         my $n;
         fgfs_get("/sim/rendering/signs/number", \$n) or last;
         $n = $MAXNUMSIGNS if $n > $MAXNUMSIGNS;
         if ($n != $NUMSIGNS) {
            @SIGNS = [];
            $NUMSIGNS = $n;
         }
         fgfs_get("/sim/rendering/signs/interval", \$INTERVAL) or last;
         fgfs_get("/sim/rendering/signs/hotlist-size", \$HOTLISTSIZE) or last;
         fgfs_get("/sim/rendering/signs/resort-dist", \$RESORTDIST) or last;
         $INTERVAL = 1 if $INTERVAL < 1;
         $HOTLISTSIZE = 1 if $HOTLISTSIZE < 1;
         $HOTLISTSIZE = @LOC if $HOTLISTSIZE > @LOC;
         $RESORTDIST = 0.000001 if $RESORTDIST < 0.000001;
         $NUMSIGNS = @LOC if $NUMSIGNS > $HOTLISTSIZE;
         sort_locations($x, $y, $z, \@hotlist);
         names_show_next(@hotlist[0 .. $NUMSIGNS - 1]);
      }
   }
   fgfs_send("quit");
   close $FGFS_IO;
   undef $FGFS_IO;
}
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 names_show_next(@) {
   my %request;
   map { $request{join ":", @$_[7, 1, 2]} = $_ } @_;
   foreach (0 .. $NUMSIGNS - 1) {
      next unless defined $SIGNS[$_];
      if (exists $request{$SIGNS[$_]}) {
         delete $request{$SIGNS[$_]};
      } else {
         delete $SIGNS[$_];
      }
   }
   sub find_free() { map { defined $SIGNS[$_] or return $_ } (0 .. $NUMSIGNS - 1) };
   foreach (values %request) {
      my ($type, $lon, $lat, $elev, $label, $filenum) = @$_[0, 1, 2, 3, 7, 9];
      my $i = find_free;
      $SIGNS[$i] = "$label:$lon:$lat";
      my $texture = create_sign($type, $label, $filenum);
      fgfs_set("/sim/rendering/signs/sign[$i]/texture", $texture) or return;
      fgfs_set("/sim/rendering/signs/sign[$i]/elevation-ft", $elev) or return;
      fgfs_set("/sim/rendering/signs/sign[$i]/longitude-deg", $lon) or return;
      fgfs_set("/sim/rendering/signs/sign[$i]/latitude-deg", $lat) or return;
   }
}
sub convert($@) {
   my $file = shift;
   system (
      "convert",
      "-size", "1024x128",
      "xc:none",
      "-gravity", "center",
      @_,
      "-compress", "RLE",
      "SGI:$file",
   );
}
sub create_sign($$$) {
   my $type = shift;
   my $location = shift;
   my $filenum = shift;
   my ($color, $font, $size, $encoding);
   my $tag = "";
   foreach (@FORMAT) {
      my @x = @$_;
      if ($type eq $x[0] and $FILES[$filenum] =~ /$x[2]/) {
         ($tag, $color, $font, $size, $encoding) = @x[1, 3, 4, 5, 6];
         $tag = '/' . $tag;
         last;
      }
   }
   my $dir = "cache/$type$tag";
   -d "$BASEDIR/$dir" or mkdir "$BASEDIR/$dir" or fatal("can't create directory $BASEDIR/$dir");
   my $file = $location;
   $file =~ y/ /_/;
   $file =~ s/(\W)/"%" . uc(unpack("H2", $1))/ge;
   $file = "$dir/$file.rgb";
   my $path = "$BASEDIR/$file";
   my $db = $FILES[$filenum];
   $db =~ s/.*\/(.*)(\.gz)?/$1/;
    $ccnt++;
   &log($INFO, "$ccnt of $mcnt: \033[32;1mcached:  \033[m $file ($db)") and return $file if -f $path;
   &log($INFO, "$ccnt of $mcnt: \033[31;1mcreating:\033[m $file ($db)");
   defined $font or $font = "Helvetica-Bold";
   defined $encoding or $encoding = "None";
    $font = 'C:\WINDOWS\Fonts\Verdana.TTF';
   $location =~ s/'/\\'/g;
   if ($type eq "A") {      # airport
      my ($id, $name) = split / /, $location, 2;
      defined $color or $color = "green";
      defined $size or $size = "60";
      my $small = $size * 4 / 5;
      my $h = $size / 2;
      convert($path,
         "-encoding", $encoding,
         "-font", $font,
         "-fill", $color,
         "-pointsize", $size,
         "-draw", "text 0,-$h '$name'",
         "-pointsize", $small,
         "-draw", "text 0,$h '($id)'"
      );
   } elsif ($type eq "B") {   # bridge/object
      defined $color or $color = "red";
      defined $size or $size = "50";
      convert($path,
         "-encoding", $encoding,
         "-font", $font,
         "-fill", $color,
         "-pointsize", $size,
         "-draw", "text 0,0 '$location'"
      );
   } elsif ($type eq "C") {   # city/location
      defined $color or $color = "blue";
      defined $size or $size = "50";
      convert($path,
         "-encoding", $encoding,
         "-font", $font,
         "-fill", $color,
         "-pointsize", $size,
         "-draw", "text 0,0 '$location'"
      );
   } else {
      die "unknown type '$type' in database";
   }
   return $file;
}
sub fgfs_get_coord($$) {
   my $lon = shift;
   my $lat = shift;
   fgfs_get("/position/longitude-deg", $lon) or exit -2;
   fgfs_get("/position/latitude-deg", $lat) or exit -2;
   return 1;
}
END {
   if (defined $FGFS_IO) {
      fgfs_send("quit");
      close $FGFS_IO;
   }
}
sub fgfs_connect() {
   my $host = shift;
   my $port = shift;
   my $timeout = (shift || 120);
   my $socket;
   STDOUT->autoflush(1);
   print "connect ";
   while ($timeout--) {
      if ($socket = IO::Socket::INET->new(
            Proto => 'tcp',
            PeerAddr => $host,
            PeerPort => $port)) {
         print ".. done.\n";
         $socket->autoflush(1);
         sleep 1;
         return $socket;
      }   
      print ".";
      sleep(1);
   }
   return 0;
}
sub fgfs_get() {
   fgfs_send("get " . shift);
   eof $FGFS_IO and return 0;
   my $val = shift;
   $$val = <$FGFS_IO>;
   $$val =~ s/\015?\012$//;
   $$val =~ /^-ERR (.*)/ and (&log($WARN, "$1") and return 0);
   return 1;
}
sub fgfs_set() {
   my $prop = shift;
   my $value = shift;
   fgfs_send("set $prop $value");
}
sub fgfs_send() {
   print $FGFS_IO shift, "\015\012";
}
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 xyz2ll($$$) {
   my ($di, $dj, $dk) = @_;
   my $aux = $di * $di + $dj * $dj;
   my $lat = atan2($dk, sqrt $aux) * $R2D;
   my $lon = atan2($dj, $di) * $R2D;
   return ($lon, $lat);
}
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 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 fatal() {
   &log($ERR, "$0: @_");
   exit -1;
}
sub log() {
   my $v = shift;
   return if $v > $VERBOSITY;
   $v = 4 if $v > 4;
   print "\033[$COLOR[$v]m" if $USECOLOR;
   print "@_";
   print "\033[m" if $USECOLOR;
   print "\n";
}

index -|- top

checked by tidy  Valid HTML 4.01 Transitional