#!/Perl # l'option -w a été enlevée pour éviter l'affichage des warnings inutiles décrits ci-dessous: # Use of implicit split to @_ is deprecated at fgfs/plandevol-dev line ... # main::construction_route() called too early to check prototype at fgfs/plandevol-dev line ... # main::construction_route() called too early to check prototype at fgfs/plandevol-dev line ... ####################################################################################################################################################### ## *********************************************** ## ***** TRES IMPORTANT ***** VERY IMPORTANT ***** ## *********************************************** ## ## THIS SCRIPT *DO NOT* GIVE REAL INFORMATION TO BUILD A REAL FLIGHTPLAN!!!!!!!! ## IT IS ONLY A WAY TO SHOW A POSSIBLE WAY BETWEEN TWO POINTS IN THE FLIGHTGEAR FS WORLD AND DO NOT GIVE ANY WARRANTY ABOUT ## THE FIABILITY OF THE GIVEN INFORMATIONS ## ####################################################################################################################################################### ###################################################################################################################################################### ## ## script wrote by seb marque, paris, france ## ## plandevol, version 0.5.9 nearly version 0.6.0 ## --help for help about how to use the script ## ## script placed under GPL license by Sébastien MARQUE ## complete text availaible in http://www.gnu.org/licenses/gpl.txt ## # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ####################################################################################################################################################### ## ## functions connect, set_prop, get_prop et send are from the script telnet.pl found in the source code of fgfs 0.98 (from Curtis L. Olson, ## with courtesy for Melchior Franz. ## ## functions round, ll2xyz, xyz2ll, llll2dir (from where goes llll2dir_), distance (from where goes distance_) et coord_dist_sqr are from the ## Melchior Franz's script "freq" found on sur http://members.aon.at/mfranz/freq. I'm trying to replace them by Math::Trig functions ## ###################################################################################################################################################### ## ## known bugs: if there's a navaid in the arrival airport, it is not yet detected... what a pity ## ## version 0.7 -> auto setup of instrumentation during flight (maybe v0.7) ## -> intégration of fix in the flight plan etwwen two navaids if necessary ## -> bettre sid/star management ## -> cleaning glue code ## ###################################################################################################################################################### use strict; use POSIX qw(ceil floor); use Getopt::Long; # for retrieving command-line options use IO::Socket; # for connecting FlightGear with Telnet use Env qw(HOME FGROOT); # for reading HOME and FGROOT ## GLOBAL VARIABLES DECLARATION ##################################### my @depart = (undef, "LFPG", undef, undef,undef); # array containing infos about departure airport (see the very end of the script) my @arrivee = (undef, "LFBD", undef, undef,undef, undef); # array containing infos about arrival airport (see the very end of the script) my $fgfs; # connection socket to fgfs my @route; # the route to follow (see the very end of the script) my ($navaid, $fix); # global pointers to navaids data my $erreur; # contain eventuals error messages my $version; # for the compatibility with different versions of nav.dat.gz my $sous_fonction; # pointer to sub functions defined locally # SCRIPT OPTIONS VARIABLES ################################# ###my $FGROOT = (exists $ENV{FGROOT})? $FGROOT : "/usr/local/share/FlightGear"; my $FGROOT = (exists $ENV{FGROOT})? $FGROOT : "c:\\FG0910-2\\FlightGear\\data"; my $vor_a_vor; # if only vor to vor route if wanted my $vor_preferes; # if we prefer vor to vor, but ndb is also ok my $deviation_max = 30; # maximal turn my $dist_min = 10; # minimal distance between two navaids my $km; # to print distances in kilometers my $help; # for printing the help my $csv_conf=':,'; # the separators for .csv file my $no_stdout; # no print out in the terminal my ($sidx, $starx); # sid/star protocol wanted with no runway specified my ($sid, $star); # sid/star protocol wanted and runway specified #my $no_couleur; # if terminal does not support ANSI, or to print in a file my $no_couleur = 1; # if terminal does not support ANSI, or to print in a file my ($com, $com_dep, $com_app); # for printing communication frequences my $INSTRFILE; # for printing in .xml file (not yet usable) my $WPFILE; # for printing in a file in order to use it with --flight-plan option of fgfs my $CSVFILE; # for printing in a comma separated file my $options = GetOptions ( "v|vor-a-vor" => \$vor_a_vor, "preferer-vor"=> \$vor_preferes, "km" => \$km, "dev-max=i" => \$deviation_max, "dist-min=i" => \$dist_min, "fg-root=s" => \$FGROOT, "wpt=s" => \$WPFILE, "instr" => \$INSTRFILE, "csv=s" => \$CSVFILE, "csv-conf=s" => \$csv_conf, "d|dep=s" => \$depart[1], "a|arr=s" => \$arrivee[1], "no-stdout" => \$no_stdout, "help" => \$help, "sidx" => \$sidx, "starx" => \$starx, "sid=s" => \$sid, "star=s" => \$star, "com" => \$com, "com-dep" => \$com_dep, "com-app" => \$com_app, "no-ansi" => \$no_couleur); ($com_dep, $com_app) = ($com, $com) if $com; ## FILES USED BY THE SCRIPT ## it can be modified ## accept files with .dat or .dat.gz ########################################### my $PLANDEVOLHOME = $HOME; # where write the xml files (not yet functionnal) my $NAVFILE = "$FGROOT/Navaids/nav.dat.gz"; # the NAV, NDB, etc. data file my $FIXFILE = "$FGROOT/Navaids/fix.dat.gz"; # the FIX data file my $SIDFILE = "$FGROOT/NavAids/sid.dat"; # the SID data file my $STARFILE = "$FGROOT/NavAids/star.dat"; # the STAR data file my $APTFILE = "$FGROOT/Airports/apt.dat.gz"; # the airports data file ## DÉCLARÉ COMME VARIABLE MAIS UTILISÉ COMME CONSTANTE ###################################################### my $texte_aide = <] [--wpt ] [--csv ] [--csv-conf ] [-d | --dep ] [-a | --arr ] [--dev-max ] [--dist-min ] [--sid ][--star ] [--sidx][--starx] [--com-dep][--com-app][--com] [--no-ansi] [--help] -v | --vor-a-vor : route with only VOR and VOR-DME (no TACAN) --preferer-vor : route built with NDB and VOR, VOR are prefered --km : print the distance in km (défault: print in nm) --fg-root : path to the FG data files default: $FGROOT --wpt : name of the file to write the route suitable witth the fgfs option --flight-plan=file --csv : name of the file to print the route with coodinates in CSV format (see --cvs-conf option) usable for printing plots on a chart (eg. via oocalc) --csv-conf : separators configuration for csv files. format = séparatordécimal (eg: --csv-conf=?ù for columns separated by the character '?', and comma represented by the character 'ù'. default --csv-conf=$csv_conf -d | --dep : departure point. you can specify: - the oaci code of the airport (case insensitive)(ex: --dep=lfQq), defaut --dep=$depart[1] --arr=$arrivee[1] - the actual position of the aircraft in fgfs (eg: --dep=telnet:5401) - an arbitrary position in lat, long (eg: --dep=[45.564,-2.066]) -a | --arr : arrival point. same possibilities than --dep option --dev-max : maximal deviation from a navaid to another related to actual heading (default: $deviation_max°) --dist-min : minimal distance between two navaids (default: $dist_min km) --sid --star : find out the route using sid (or star) procedure for the runway runway can be coded with two or three characters (ex: --sid 09 --star 23, ou --sid 09R --star 23) if none of R, C or L indicator is given by user, all of them are searched --sidx, --starx : idem --sid and --star, but the runway is choosen by the script: - for now, the choice is the runway the sid/star procedure of which is the nearest of the arrival/departure point - in the future why not an implementation using METAR for take off face to wind - related to the apt.dat evolution, we could imagine a choice with currently used runways in reality --com-dep, --com-app : print COMM frequencies for respectively departure (dep) or approach (app) --com : print COMM frequencies for both departure and approach (aqual to --com-dep --com-app) --no-ansi : no prints with the ANSI colors, for the termainals which do not support ANSI norm or to redirect the result --help : print this help message and exit (even other options are specified) EOH my $PI = 3.1415926535897932384626433832795029; my $D2R = $PI / 180; my $R2D = 180 / $PI; my $ERAD = 6378138.12; #my $ERAD = 6378; my $NDB = 2; my $VOR = 3; # CONNECTION FUNCTIONS WITH FGFS USING TELNET ############################################# sub get_prop($$) { my( $handle ) = shift; &send( $handle, "get " . shift ); eof $handle and die "\nconnection closed by host"; $_ = <$handle>; s/\015?\012$//; /^-ERR (.*)/ and die "\nfgfs error: $1\n"; return $_; } sub set_prop($$$) { my( $handle ) = shift; my( $prop ) = shift; my( $value ) = shift; &send( $handle, "set $prop $value"); # eof $handle and die "\nconnection closed by host"; } sub send($$) { my( $handle ) = shift; print $handle shift, "\015\012"; } sub connect($$$) { my( $host ) = shift; my( $port ) = shift; my( $timeout ) = (shift || 120); my( $socket ); STDOUT->autoflush(1); while ($timeout--) { if ($socket = IO::Socket::INET->new( Proto => 'tcp', PeerAddr => $host, PeerPort => $port) ) { $socket->autoflush(1); return $socket; } print "Attempting to connect to $host ... " . $timeout . "\n"; sleep(1); } return 0; } # COORDINATES CALCULATION FUNCTIONS # by Frank Melchior #################################### sub round($) { my $i = shift; my $m = (shift or 1); $i /= $m; $i = $i - &floor($i) >= 0.5 ? &ceil($i) : &floor($i); $i *= $m; return $i; } 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 ll2xyz($$) { my $lat = (shift) * $D2R; my $lon = (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 distance_($) { my $t = shift; my @ll1 = ll2xyz($t->[0], $t->[1]); my @ll2 = ll2xyz($t->[2], $t->[3]); return $ERAD * sqrt(coord_dist_sq($ll1[0], $ll1[1], $ll1[2], $ll2[0], $ll2[1], $ll2[2])) / 1000; } sub llll2dir_($) { my $t = shift; my $latA = ($t->[0]) * $D2R; my $lonA = ($t->[1]) * $D2R; my $latB = ($t->[2]) * $D2R; my $lonB = ($t->[3]) * $D2R; my $xdist = sin($lonB - $lonA) * $ERAD * cos(($latA + $latB) / 2); my $ydist = sin($latB - $latA) * $ERAD; my $dir = atan2($xdist, $ydist) * $R2D; $dir += 360 if $dir < 0; return $dir; } # FUNCTION TO FIND OUT THE TYPE AND NAME OF EXTREMITY OF THE ROUTE ################################################################## sub configure_extremite ($$$) { my ($extremite, $proc, $procx) = @_; my $extremite_ok; # = 1 if extremity of the route is known and correctly configured, # will be the return value sub getPositionParTelnet ($) { # if we are not connected, so we do if (!$fgfs) { if ( !($fgfs = &connect("localhost", $_[0], 5)) ) { print "Impossible de se connecter\n"; } } # we get the position of the aircraft my $lat = get_prop ($fgfs,"/position/latitude-deg[0]"); my $lon = get_prop ($fgfs, "/position/longitude-deg[0]"); # if position is found (limitation: ~ is different of 0°00'00''N 0°00'00''E) if ($lat && $lon) { $extremite_ok = 1; return $lat, $lon; } else { $erreur = "Unable to find the actual position of the aircraft\n"; } } $sous_fonction = sub { my @donnees_aeroport; # if the airport data file exists, it is opened, otherwise the script stop if ( -e $APTFILE ) { open (APT, "gzip -d -c $APTFILE|") or die "I can't open $APTFILE\n" ; } else { die "file $APTFILE does not exist\n"; } # we look inside the file to find our airport while () { if (/^1\s+\d+\s\d\s\d\s(\w+)\s(.+)/ && $1 eq $_[0]->[1]) { chomp; my @header = split (/\s+/, $_, 6); push @donnees_aeroport, \@header; my $autre_bout; foreach () { last if /^\s*$/; my @donnee = split (/\s+/, $_); # if it is a runway we rename it by adding the opposite name of the runway if ($donnee[0] == 10 && $donnee[3] ne 'xxx') { $donnee[3] =~ /(..)(.)/; $autre_bout = ($1 > 18)? $1 - 18 : $1 + 18; $autre_bout = '0'.$autre_bout if ($autre_bout < 10); $autre_bout .= 'L' if ($2 eq 'R'); $autre_bout .= 'R' if ($2 eq 'L'); $autre_bout .= 'C' if ($2 eq 'C'); if ($2 eq 'x') { $donnee[3] = $1.' '; $autre_bout .= ' '; } $donnee[3] = $donnee[3].'/'.$autre_bout; push (@donnees_aeroport, \@donnee) } # we take the COMM infos push (@donnees_aeroport, \@donnee) if ($donnee[0] >= 50); } } } close (APT); # first we take the first runway to know the coordinates of the airport if (@donnees_aeroport != 0) { $extremite_ok = 1; return @{$donnees_aeroport[1]}[1], @{$donnees_aeroport[1]}[2], \@donnees_aeroport; } # this line is only reach if no airport have been found in database $erreur = $_[0]->[1]." hasn't been found in database..."; }; $extremite->[1] =~ tr/a-z/A-Z/; if ($extremite->[1] =~ /^TELNET:(\d+)/) { # actuel position of aircraft, known by telnet $extremite->[1] = "ici"; ($extremite->[2], $extremite->[3]) = getPositionParTelnet ($1); $extremite->[4] = [[0, undef, undef, undef, undef, "position au ".`date`]]; ($extremite->[0], $$proc, $$procx) = (undef, undef, undef); } elsif ($extremite->[1] =~ /^\[(.+),(.+)\]$/) { # position in lat long format $extremite->[1] = "pos"; ($extremite->[2], $extremite->[3]) = ($1, $2); $extremite->[4] = [[0, undef, undef, undef,undef, $1.", ".$2]]; if (abs($extremite->[2])<=90 && abs($extremite->[3])<=180) { $extremite_ok = 1; } else { $erreur = "unknown coordinates format...: ".$extremite->[2]." ".$extremite->[3]; } ($extremite->[0], $$proc, $$procx) = (undef, undef, undef); } else { # position given by icao name ($extremite->[2], $extremite->[3], $extremite->[4]) = &$sous_fonction ($extremite); } # we close the connexion with fgfs close ($fgfs) if $fgfs; # we return the status of our search return $extremite_ok; } # NAV_TO_RAM ############ sub nav_to_ram ($$$) { my ($fichier, $phrase, $decale) = @_; my @selection; # array with useful navaids my $marge = 2; my $lat_sup = (($depart[2] >= $arrivee[2])? $depart[2]:$arrivee[2]) + $marge; my $lat_inf = (($depart[2] <= $arrivee[2])? $depart[2]:$arrivee[2]) - $marge; my $long_sup = (($depart[3] >= $arrivee[3])? $depart[3]:$arrivee[3]) + $marge; my $long_inf = (($depart[3] <= $arrivee[3])? $depart[3]:$arrivee[3]) - $marge; if ( -e $$fichier ) { $$fichier =~ /.+\.(.+)$/; my $fichier_traite = ($1 eq 'gz')? 'gzip -d -c '.$$fichier.'|' : $$fichier; open (NAV, $fichier_traite) or die "I can't open $$fichier\n" ; } else { die "file $$fichier does not exists\n"; } # version of nav.dat if ($$fichier eq $NAVFILE) { while (