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"; }