fg_getelev.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:37 2010 from fg_getelev.pl 2008/12/11 6.2 KB.

#!/usr/bin/perl -w
# Melchior FRANZ <mfranz # aon : at>
# $Id: getelev,v 1.19 2005/05/26 08:37:19 m Exp $
use strict;
use IO::Socket;
use POSIX qw(floor nice);
# for WIN32
use Win32::Console::ANSI;
my $def_fg_root = "C:\\FG\\27\\data";
my $fg_binary = 'flightgear';
##my $def_fg_root = "/usr/local/share/FlightGear";
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 $FGFS_IO;
my %TRACK;
sub help() {
   print "USAGE: $0 <sourcefile> [<fgfs args>]\n";
    print "Note:\n";
    print "BASEDIR is \033[33;1m$BASEDIR\033[m\n";
    print "FG_ROOT is \033[33;1m$FG_ROOT\033[m\n";
}
sub main() {
   my $in = shift @ARGV;
   defined $in or &help and exit -1;
   -f $in or print "file $in doesn't exist\n" and &help and exit -1;
   if (my $pid = fork) {
      my $out = $in;
      $out =~ s/\.gz$//;
      $out .= ".out";
      &main_loop($in, $out);
      kill 3, $pid || &error("couldn't stop fgfs");
   } else {
      die "cannot fork: $!" unless defined $pid;
      exec("$FGFS --telnet=$PORT --aircraft=ufo --fdm=null --disable-random-objects "
            . "--disable-sound --disable-specular-highlight --fov=50 "
            . "--fog-fastest --model-hz=60 --geometry=640x480 --visibility=100.0 "
            . "--prop:/environment/clouds/layer[0]/coverage=clear "
            . "--prop:/environment/clouds/layer[0]/elevation-ft=-9999 "
            . "--prop:/environment/clouds/layer[1]/coverage=clear "
            . "--prop:/environment/clouds/layer[1]/elevation-ft=-9999 "
            . "--prop:/environment/clouds/layer[2]/coverage=clear "
            . "--prop:/environment/clouds/layer[2]/elevation-ft=-9999 "
            . "--prop:/environment/clouds/layer[3]/coverage=clear "
            . "--prop:/environment/clouds/layer[3]/elevation-ft=-9999 "
            . "--prop:/environment/clouds/layer[4]/coverage=clear "
            . "--prop:/environment/clouds/layer[4]/elevation-ft=-9999 "
            . "--prop:/environment/clouds/layer[5]/coverage=clear "
            . "--prop:/environment/clouds/layer[5]/elevation-ft=-9999 "
            . "--prop:/sim/rendering/clouds3d-enable=false "
            . "--prop:/sim/rendering/lightning-enable=false "
            . "--prop:/sim/rendering/precipitation-enable=false "
            . "--prop:/sim/rendering/enhanced-lighting=false "
            . "--prop:/sim/rendering/bump-mapping=false "
            . "--prop:/sim/rendering/multi-pass-clouds=false "
            . "--prop:/sim/rendering/distance-attenuation=false "
            . "--prop:/sim/rendering/horizon-effect=false "
            . "--prop:/sim/frame-rate-throttle-hz=10 "
            . "--prop:/sim/ai/enabled=false "
            . "--prop:/sim/ai-traffic/enabled=false "
            . "--prop:/sim/traffic-manager/enabled=false "
            . "--prop:/sim/atc/enabled=false "
            . "@ARGV "
            . "--disable-real-weather-fetch");
   }
   exit;
} &main;
sub main_loop() {
   my $in = shift;
   my $out = shift;
   $FGFS_IO = &fgfs_connect($HOST, $PORT, 120) || die " can't open socket\n";
   &fgfs_send("data");
   open(OUT, ">$out") or die "can't write data: $!";
   OUT->autoflush(1);
   STDOUT->autoflush(1);
   open(IN, $in =~ /\.gz$/ ? "gunzip -c $in|" : "<$in") || die "can't open names file $in: $!";
   print "reading data from '$in'\n";
   my $total = grep { /^(.)\s+([\d.+-]+)\s+([\d.+-]+)\s+([\d.+-]+)\s+(.*)/ } <IN>;
   seek(IN, 0, 0);
   IN->input_line_number(0);
   sleep 20;
   my $elev;
   my ($oldlon, $oldlat, $oldelev) = (-1000, -1000, -1000);
   my $count = 0;
   while (<IN>) {
      my $LINENO = $.;
      chomp;
      if (/^\s*#.*/) {
         print OUT "$_\n";
         print "\033[36;1m$_\033[m\n";
         next;
      }
      # type, lon, lat, elev, name
      unless (/^(.)\s+([\d.+-]+)\s+([\d.+-]+)\s+([\d.+-]+)\s+(.*)/) {
         print OUT "# FIXME: this line is invalid, so I commented it out:\n# $_\n";
         print "\033[34;1m$_\033[m\n";
         next;
      }
      my ($type, $lon, $lat, $name) = ($1, $2, $3, $5);
      my $xlon = floor(1000 * $lon) == int(1000 * $lon) ? $lon + 0.0001 : $lon;
      my $xlat = floor(1000 * $lat) == int(1000 * $lat) ? $lat + 0.0001 : $lat;
      &fgfs_set("/position/longitude-deg", $xlon) or (&error("fgfs died (1)") and exit -1);
      &fgfs_set("/position/latitude-deg", $xlat) or (&error("fgfs died (2)") and exit -2);
      my $start = time;
      while (1) {
         sleep 2;
         &fgfs_get("/position/ground-elev-m", \$elev) or (&error("fgfs died (3)") and exit -3);
         last if $elev > 1.0 and abs($elev - $oldelev) > 0.1;
         last if time - $start > 12;
         print ".";
      }
      if (exists $TRACK{"$lat:$lon"}) {
         my $line = join ", ", @{$TRACK{"$lat:$lon"}};
         print OUT "# FIXME: same coordinates were already used in line $line:\n";
         print "\033[31;1mWARNING: same coordinates were already used in line $line:\033[m\n";
      } elsif ($oldelev == $elev) {
         print OUT "# FIXME: same elevation as last entry:\n";
         print "\033[31;1mWARNING: same elevation as last entry:\033[m\n";
      }
      push @{$TRACK{"$lat:$lon"}}, "$LINENO (\"$name\")";
      ($oldlon, $oldlat, $oldelev) = ($lon, $lat, $elev);
      $count++;
      printf OUT "$type $lon $lat %.2f $name\n", $elev;
      printf "[%.2f%%]  ($LINENO)  \033[33;1m$type $lon $lat %.2f $name\033[m\n", 100 * $count / $total, $elev;
   }
   close IN;
   close OUT;
   &fgfs_send("quit");
   close $FGFS_IO;
   undef $FGFS_IO;
}
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 (&error("$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 error() {
   print STDERR "\033[31;1mERROR: @_\033[m\n";
   return 1;
}

index -|- top

checked by tidy  Valid HTML 4.01 Transitional