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