Generated: Tue Feb 2 17:54:53 2010 from plandevol-eng.pl 2006/04/19 40.8 KB.
#!/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 = <<EOH; plandevol, v. 0.6.0 find a navaids route between two points in the FlightGear world only (or other flight sim but *not* in reality!!). syntaxe: plandevol [-v | --vor-a-vor] [--preferer-vor] [--km] [--fg-root </PATH/TO/FG_DATA_FILES>] [--wpt </PATH/TO/WPT_FILE>] [--csv </PATH/TO/CSV_FILE>] [--csv-conf <colonnedécimal>] [-d | --dep <departure>] [-a | --arr <arrival>] [--dev-max <degrees>] [--dist-min <distance in km>] [--sid <runway>][--star <runway>] [--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_conff -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> 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 (<APT>) { 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 (<APT>) { 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 (<NAV>) { if (/^(\d+) Version/) { $version = $1; last; } } # if version is upper than 6.00 all index of arrays are incremented by 1 $version = ($version > 600)? 1 : 0; } my $ils = ($version)? '^(4|5)\s+\S+\s+\S+\s+\S+\s+(\S+)\s+\S+\s+\S+\s+\S+\s+(\S+)\s+(...)\s*' : '^(4|5)\s+\S+\s+\S+\s+\S+\s+(\S+)\s+\S+\s+\S+\s+(\S+)\s+(...)\s*'; # have a look to intersting navaids while (<NAV>) { chomp; if (/$phrase/) { push @selection, $_ if ($decale && $2 <= $lat_sup && $2 >= $lat_inf && $3 <= $long_sup && $3 >= $long_inf); push @selection, $_ if (!$decale && $1 <= $lat_sup && $1 >= $lat_inf && $2 <= $long_sup && $2 >= $long_inf); next; } # if we found ILS info for our arrival airport, we take them if (/$ils/ && $3 eq $arrivee[1]) { push (@{$arrivee[4]}, [$1, $4, $2/100]); } } close (NAV) or die "I can't close $$fichier"; return @selection; } # FONCTIONS DE CALCUL DU TRAJET (HORS SID/STAR) ############################################### sub getNavAidNearestMidPoint ($$$) { my $leg = $_[0]; my $milieu = $_[1]; my @ref_dist = (undef, undef, $_[2], $_[2]); my @ref_navaid = (undef, undef, undef, undef); my $heading_from = llll2dir_ ( [$leg->[0], $leg->[1], $milieu->[0], $milieu->[1]] ); my $heading_to = llll2dir_ ( [$milieu->[0], $milieu->[1], $leg->[2], $leg->[3]] ); #get nearest navaid for (my $index = 0; $index < @$navaid; $index++) { # on récupère le type et les coordonnées # $1: type de balise # $2: latitude # $3: longitude $navaid->[$index] =~ /^(.)\s+(\S+)\s+(\S+)\s/; # next iteration if the tested navaid is one of our extremities of the segment next if ( ($2 == $leg->[0] && $3 == $leg->[1]) || ($2 == $leg->[2] && $3 == $leg->[3]) ); # take care of deviation my $deviation_to = abs(llll2dir_ ([$leg->[0], $leg->[1], $2, $3]) - $heading_from); my $deviation_from = abs(llll2dir_ ([$2, $3, $leg->[2], $leg->[3]]) - $heading_to); # if deviation is too important continue the search next if ($deviation_to > $deviation_max && $deviation_from > $deviation_max); # disatnce calculation... my $navaid_dist = distance_( [$milieu->[0], $milieu->[1], $2, $3] ); my $dist_to = distance_( [$leg->[0], $leg->[1], $2, $3] ); my $dist_from = distance_( [$2, $3, $leg->[2], $leg->[3]] ); # if the navaid is the nearest and the distance is ok if ( $navaid_dist < $ref_dist[$1] && $dist_to > $dist_min && $dist_from > $dist_min ) { # we keep this solution (before finding a better one) $ref_navaid[$1] = $index; $ref_dist[$1] = $navaid_dist; } } #RETOUR EN FONCTION DES CHOIX SWITCH : { #IF ONLY VOR ASKED if ($vor_a_vor) { return $ref_navaid[$VOR]; last SWITCH; } #IF VOR ARE PREFERED if ($vor_preferes && $ref_navaid[$NDB]) { return ($ref_navaid[$VOR])? $ref_navaid[$VOR] : $ref_navaid[$NDB]; last SWITCH; } #IF WE DON'T CARE WITH ALL THIS STUFF if ($ref_navaid[$VOR] && $ref_navaid[$NDB]) { return ($ref_dist[$VOR] < $ref_dist[$NDB])? $ref_navaid[$VOR] : $ref_navaid[$NDB]; last SWITCH; } #IF NO VOR if (!$ref_navaid[$VOR] && $ref_navaid[$NDB]) { return $ref_navaid[$NDB]; last SWITCH; } #IF NO NDB if ($ref_navaid[$VOR] && !$ref_navaid[$NDB]) { return $ref_navaid[$VOR]; } else { return $ref_navaid[0]; } } } sub construction_route ($$$) { # the parameters my ($depuis, $vers, $plan) = @_; # the leg coordinates [from(depuis) - to(vers)] my $coord_leg = [$depuis->[0], $depuis->[1], $vers->[0], $vers->[1]]; # we calculate the coordinates of the middle of the leg [depuis-vers] # this method is not very orthodoxe... my $mi_trajet = [ $depuis->[0]+(($vers->[0]-$depuis->[0])/2), $depuis->[1]+(($vers->[1]-$depuis->[1])/2) ]; # we look for the nearest navaid of the middle of the leg [depuis-vers] my $dist = distance_ ($coord_leg); my $indexPlusProcheNavAid = getNavAidNearestMidPoint ($coord_leg, $mi_trajet, $dist/2); # if we found one if ($indexPlusProcheNavAid) { # we get the coordinates # $1 = latitude # $2 = longitude $navaid->[$indexPlusProcheNavAid] =~ /^.\s+(\S+)\s+(\S+)\s/; # we name it "waypoint" my $waypoint = [$1,$2]; # we build the route between "depuis" and "waypoint" construction_route ($depuis, $waypoint, $plan); # we put the infos about the navaid in the route split /\s+/, $navaid->[$indexPlusProcheNavAid], 8 + $version; push @$plan, \@_; # we build the route between "waypoint" and "vers" construction_route ($waypoint, $vers, $plan); } } # SID/STAR PROC MANAGEMENT ################################# sub teste_existence_procedure ($$$) { # parameters my ($sidstar, $fichier, $marqueur) = @_; my @trouvailles; # if the file does not exists we give up the procedure if (! -e $$fichier) { printf "file %s doesn't exist, procedure %s abandonned", $$fichier, ($marqueur == 60)? 'SID' : 'STAR'; return 0; } # opening the file $$fichier =~ /.+\.(.+)$/; my $fichier_traite = ($1 eq 'gz')? 'gzip -d -c '.$$fichier.'|' : $$fichier; open (FICHIER, $fichier_traite) or die "I can't open $$fichier!!!"; # we look for procedures while (<FICHIER>) { chomp; if (/^$marqueur\s+(\S+)\s+(.+)/ && $1 eq $sidstar->[1]) { # this is the entry point of a procedure my @procedure; push @procedure, $2; while (<FICHIER>) { chomp; last if (/^\s*$/); # a blank line, this this the end of the procedure push @procedure, $_; # we take all we can } # the entire procedure is placed in @trouvailles push @trouvailles, \@procedure; } } # we clsethe file close (FICHIER); # @trouvailles contain all the elements of the procedure # we put it where it has to be $sidstar->[0] = \@trouvailles; # we return the number of elements in @trouvailles (0 = rien trouvé) my $taille = @trouvailles; return $taille; } sub mise_en_forme_procedure ($$) { my ($procedure, $extremite) = @_; my @procedure_exploitable; # array with only the usable datas of the procedure my $nombre_d_entrees = 0; # to control if the procedure is modified or not # if = 0 we give up the procedure # hash table used by $sous_fonction my %type = ('F' => [$fix, '^\s*\S+\s+\S+\s+(\S+)\s*$'], 'V' => [$navaid, ($version)? '^3\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+(\S+)' : '^3\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+(\S+)' ], 'N' => [$navaid, ($version)? '^2\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+(\S+)' : '^2\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+(\S+)' ]); # return the line of a navaid from the good database $sous_fonction = sub { my ($test, $nom) = @_; foreach my $element (@{$type{$test}->[0]}) { return $element if ($element =~ /$type{$test}->[1]/ && $1 eq $nom); } }; # to check if procedure is modified my $modifie = @{$procedure}; # we clean each element of the procedure to be placed correctly in the route for (my $index = 1; $index < @{$procedure}; $index++) { $procedure->[$index] =~ /^(\S+)\s+(\S+)\s+(\S+)\s+(.+)$/; my $point_de_passage = $1; # if the waypoint in a fix, vor, or ndb... if ($point_de_passage == 65) { # stop if it is the arrival (code A of the procedure star) # in the future these data could be stored somewhere to be used... last if ($2 eq 'A'); # we take all we can take $procedure->[$index] = &$sous_fonction ($2, $3); # we continue to the next waypoint if there's no availaible infos here next if !$procedure->[$index]; # if its a vor or a ndb we put the minimal altitude after the name of the navaid if ($2 eq 'V' || $2 eq 'N') { $procedure->[$index] .= " $4"; } # if it is a fix we relook it to look like other waypoints else { my $altitude_mini = $4; $procedure->[$index] =~ /^\s*(\S+)\s+(\S+)\s+(\S+)\s*$/; $procedure->[$index] = ($version)? "65 $1 $2 fix fix fix fix $3 $altitude_mini" : "65 $1 $2 fix fix fix $3 $altitude_mini"; } } # ...idem than the fix if it's a gps point elsif ($point_de_passage == 66) { my ($lat, $lon) = ($3/1000000, $4/1000000); $procedure->[$index] = ($version)? "66 $lat $lon gps gps gps gps gps $2" : "66 $lat $lon gps gps gps gps $2"; } # ...if it is a holding pattern we don't take care (for nowadays, after...) elsif ($point_de_passage == 64) { next; } # we split the usable waypoints my @etape = split (/\s+/, $procedure->[$index]); $nombre_d_entrees++; push @procedure_exploitable, \@etape; } # in $depart[0]/$arrivee[0] anly the name of the procedure is stored # and we indicate if the procedure has been modified my $a_ete_modifie = ($nombre_d_entrees != $modifie)? ' (modifiée)' : undef; $extremite->[0] = ($nombre_d_entrees)? @{$procedure}[0].$a_ete_modifie : undef; # we return the procedure return \@procedure_exploitable; } sub sid_star ($$$$$$) { # parameters my ($proc, $procx, $extremite, $fichier, $marqueur, $autre_extremite) = @_; my $ref_dist = 99999; # ref distance to compare my $ref_index; # ref index to remember my $dist; # distance between the two extremities my @retenues; # an array with the potentially acceptable procedures my $phrase_a_matcher; # have'nt found a better name ;)... # hash table used by $sous_fonction my %type = ('F' => [$fix, '^\s*(\S+)\s+(\S+)\s+(\S+)\s*$'], 'V' => [$navaid, ($version)? '^3\s+(\S+)\s+(\S+)\s+\S+\s+\S+\s+\S+\s+\S+\s+(\S+)' : '^3\s+(\S+)\s+(\S+)\s+\S+\s+\S+\s+\S+\s+(\S+)' ], 'N' => [$navaid, ($version)? '^2\s+(\S+)\s+(\S+)\s+\S+\s+\S+\s+\S+\s+\S+\s+(\S+)' : '^2\s+(\S+)\s+(\S+)\s+\S+\s+\S+\s+\S+\s+(\S+)' ]); # return the coordinates of a navaid $sous_fonction = sub { my ($test, $nom) = @_; foreach my $element (@{$type{$test}->[0]}) { return ($1, $2) if ($element =~ /$type{$test}->[1]/ && $3 eq $nom); } }; # if we find at least one procedure: # they are stored in $depart[0]/$arrivee[0] # and we put the navaids to ram. if (teste_existence_procedure ($extremite, $fichier, $marqueur)) { @$fix = nav_to_ram (\$FIXFILE, '^\s*(\S+)\s+(\S+)\s+\S+\s*$', 0) if (@{$fix} == 0); @$navaid = nav_to_ram (\$NAVFILE, '^(2|3)\s+(\S+)\s+(\S+)\s', 1) if (@{$navaid} == 0); } # otherwise we give up the procedure and exit the function else { ($extremite->[0], $$proc, $$procx) = (undef, undef, undef); printf "No procedure %s found for %s\n", ($marqueur == 60)? 'SID':'STAR', $extremite->[1]; return; } # we look for the wanted procedures if ($$proc) { foreach my $procedure (@{$extremite->[0]}) { push @retenues, $procedure if ($procedure->[0] =~ /\[RW$$proc.\s*/); } # if we found at least one, we store them if (@retenues != 0) { $extremite->[0] = \@retenues; } # otherwise we cancel the --sid/--star demand which become a --sidx/--starx demand else { printf "No procedure %s found for runway $$proc on $extremite->[1]\n", ($marqueur == 60)? 'SID':'STAR'; $$proc = undef; $$procx = 1; } } # the choice of the best procedure # for each procedure we know for (my $index = @{$extremite->[0]}; $index--; ) { my $entree = 1; # $1 contain the info of the type of last(sid)/first(star) way point of procedure: # - 4, ou 7: holding pattern (only star) # - 5: vor, ndb or fix # - 6: gps coordinates POINT_DE_PASSAGE : { # we reach the last element of procedure sid number $index # or the first element ofthe procédure star number $index $phrase_a_matcher = ($marqueur == 60)? $extremite->[0]->[$index]->[@{$extremite->[0]->[$index]} - $entree] : $extremite->[0]->[$index]->[$entree]; $phrase_a_matcher =~ /^6(.)\s+/; if ($1 == 4 || $1 == 7) { # it's a holding pattern # we hold it a while ;)... next! $entree++; next POINT_DE_PASSAGE; } if ($1 == 5) { # it's a fix or a vor, or a ndb... # or a arrival point (code A) of procédure star but i think it would be # obvious that the first step of a procedure is its ending! # the type of way point $phrase_a_matcher =~ /^65\s+(\S)\s+(\S+)/; # its coordinates my ($lat, $lon) = &$sous_fonction ($1, $2); # next if we don't know what it is if (!$lat) { $entree++; next POINT_DE_PASSAGE; } # distance between the two extremities $dist = distance_ ( [$lat, $lon, $autre_extremite->[1], $autre_extremite->[2]] ); # if it nearer we keep it ($ref_dist, $ref_index) = ($dist, $index) if ($dist < $ref_dist); # go out last POINT_DE_PASSAGE; } if ($1 == 6) { # it's a gps # its coordinates $phrase_a_matcher =~ /^66\s+\S+\s+(\S+)\s+(\S+)/; # distance $dist = distance_ ([$1/100000, $2/100000, $autre_extremite->[2], $autre_extremite->[3]]); # if it is nearer we keep it ($ref_dist, $ref_index) = ($dist, $index) if ($dist < $ref_dist); # go out last POINT_DE_PASSAGE; # inutile mais c'est pour faire joli } } # POINT_DE_PASSAGE } # for (my $index = @{$extremite->[0]}; $index--; ) # relooking my $procedure_finale = mise_en_forme_procedure ($extremite->[0]->[$ref_index], $extremite); # we store the coordinates of end/beginnig sid/star if they're found $extremite->[2] = @{$procedure_finale->[@{$procedure_finale} - 1]}[1] if @{$procedure_finale->[@{$procedure_finale} - 1]}[1]; $extremite->[3] = @{$procedure_finale->[@{$procedure_finale} - 1]}[2] if @{$procedure_finale->[@{$procedure_finale} - 1]}[2]; # we return the only one good procedure return $procedure_finale; } ## PLAN DE VOL ############## sub plan_de_vol { # the navaids my @NDBVOR; $navaid = \@NDBVOR; # the fix my @FIX; $fix = \@FIX; # departure airport is the first point of the route push @route, ($version)? [1, $depart[2], $depart[3], @{$depart[4]->[0]}[1], $depart[4], 'apt', 'apt', $depart[1], @{$depart[4]->[0]}[5]] : [1, $depart[2], $depart[3], @{$depart[4]->[0]}[1], $depart[4], 'apt', $depart[1], @{$depart[4]->[0]}[5]]; # we get the coordinates of the end of sid procedure, which will become $depart[2] and $depart[3] # the way will be contained in $depart[0] my $procedure_sid = sid_star (\$sid, \$sidx, \@depart, \$SIDFILE, 60, \@arrivee) if ($sid || $sidx); # we get the coordinates of the beginning of the star procedure which will become $arrivee[2] et $arrivee[3] # the way will be contained in $arrivee[0] my $procedure_star = sid_star (\$star, \$starx, \@arrivee, \$STARFILE, 61, \@depart) if ($star || $starx); # if not already done we put data in ram # (@FIX only for sid/star today...) @FIX = nav_to_ram (\$FIXFILE, '^\s*(\S+)\s+(\S+)\s+\S+\s*$', 0) if (($sid || $sidx || $star || $starx) && (@{$fix} == 0)); my ($type_navaid, $decale) = ($vor_a_vor && !($sid || $sidx || $star || $starx))? ('^3', 0) : ('^(2|3)', 1); @NDBVOR = nav_to_ram (\$NAVFILE, $type_navaid.'\s+(\S+)\s+(\S+)\s', $decale) if (@{$navaid} == 0); # we feed the first step of the route whith sid procedure (if any) push @route, @{$procedure_sid} if $depart[0]; # we build route between the two extremities construction_route ( [$depart[2], $depart[3]], [$arrivee[2], $arrivee[3]], \@route); # we feed with the star procedure if any push @route, @{$procedure_star} if $arrivee[0]; # we keep in mind the coordinates of the used runway $sous_fonction = sub { my $extremite = shift; if ($extremite->[0] =~ /\[RW(...)\s*/) { my $piste = $1; foreach (@{$extremite->[4]}) { ($extremite->[2], $extremite->[3]) = ($_->[1], $_->[2]) if ($_->[3] =~ /$piste/) } } }; &$sous_fonction (\@depart); &$sous_fonction (\@arrivee); # TODO: FIND THE NAVAIDS AVAILAIBLE IN THE AIRPORT # if no sid-star asked (or availaible) # the arrival airport is the last point of the route push @route, ($version)? [1, $arrivee[2], $arrivee[3], @{$arrivee[4]->[0]}[1], $arrivee[4], 'apt', 'apt', $arrivee[1], @{$arrivee[4]->[0]}[5]] : [1, $arrivee[2], $arrivee[3], @{$arrivee[4]->[0]}[1], $arrivee[4], 'apt', $arrivee[1], @{$arrivee[4]->[0]}[5]]; # we destroy the navigation data, no use no for them $navaid = undef; $fix = undef; } # RESULTS ################################# sub fichier_csv () { $sous_fonction = sub { my $i = $_[0].$_[3].$_[1].$_[3].$_[2]; $i =~ s/\./$_[4]/g; return $i; }; # ouverture du fichier open (CSV, ">$CSVFILE"); # on configure les séparateurs my ($separateur, $decimal); if ($csv_conf =~ /^(.)(.)$/) { $separateur = $1; $decimal = $2; } # on écrit le contenu du fichier for (my $index = 0; $index < @route; $index++) { printf CSV "%s\n", &$sous_fonction ($route[$index]->[6 + $version], $route[$index]->[1], $route[$index]->[2], $separateur, $decimal); } # on ferme le fichier close (CSV); } sub fichier_wp () { # ouverture du fichier open (WP, ">$WPFILE"); # on écrit le contenu for (my $index = 1; $index < @route; $index++) { printf WP "%s\n", $route[$index]->[6 + $version]; } # fermeture du fichier close (WP); } sub sortie_standard () { # THIS PROCEDURE IS LIKE FOOD FOR CATS AND DOGS my $div = ($km)?1:1.852; my ($leg, $distance, $distance_totale, $heading); $sous_fonction = sub { print "\033[30;1m" if !$no_couleur; print "$_[0]\n"; print "\033[m" if !$no_couleur; }; if ($com_dep) { &$sous_fonction ("Useful frequencies for departure"); foreach (@{$depart[4]}) { printf ("$_->[@{$_}-1]: %s\n", $_->[1]/100) if ($_->[0] >= 50 && $_->[@{$_}-1] ne 'APP');} } print "SID procedure : $depart[0]\n" if $depart[0]; print "STAR procedure: $arrivee[0]\n" if $arrivee[0]; &$sous_fonction ("\nCode - Complete name"); printf "\t| Frequencies| Heading | Course/RNW | Distance in %s\n", ($km)? 'km':'nm'; &$sous_fonction ("$depart[4]->[0]->[4] - $depart[4]->[0]->[5]"); printf "%s", ($depart[0] =~ /\RW(...)\s+/)? "take off runway $1\n" : ''; for (my $index = 1; $index < @route; $index++) { $leg = [@{$route[$index-1]}[1],@{$route[$index-1]}[2],@{$route[$index]}[1],@{$route[$index]}[2]]; $heading = round (llll2dir_ ($leg)); $distance = distance_ ($leg) / $div; $distance_totale += $distance; $distance = round ($distance); ETAPE : { if (@{$route[$index]}[0] == 2) { # étape ndb if ($version && $distance * $div > @{$route[$index]}[5] && (@{$route[$index-1]}[0] == 2 || @{$route[$index-1]}[0] == 3)) { $distance -= round (@{$route[$index]}[5] / $div); printf "\t| ADF %-7s| %-6s | -- | $distance\n", @{$route[$index-1]}[4], $heading if @{$route[$index-1]}[0] == 2; printf "\t| NAV %-7s| %-6s | %-10s | $distance\n", @{$route[$index-1]}[4], $heading, round ($heading - @{$route[$index-1]}[5+$version]) if @{$route[$index-1]}[0] == 3; $distance = round (@{$route[$index]}[5] / $div); } printf "\t| ADF %-7s| %-6s | -- | $distance\n", @{$route[$index]}[4], $heading; &$sous_fonction ("@{$route[$index]}[6 + $version] - @{$route[$index]}[7 + $version]"); last ETAPE; } if (@{$route[$index]}[0] == 3) { # étape vor @{$route[$index]}[4] /= 100; if ($version && $distance * $div> (@{$route[$index]}[5]-5) && (@{$route[$index-1]}[0] == 2 || @{$route[$index-1]}[0] == 3)) { $distance -= round (@{$route[$index]}[5] / $div); printf "\t| ADF %-7s| %-6s | -- | $distance\n", @{$route[$index-1]}[4], $heading if @{$route[$index-1]}[0] == 2; printf "\t| NAV %-7s| %-6s | %-10s | $distance\n", @{$route[$index-1]}[4], $heading, round ($heading - @{$route[$index-1]}[5+$version]) if @{$route[$index-1]}[0] == 3; $distance = round (@{$route[$index]}[5] / $div); } printf "\t| NAV %-7s| %-6s | %-10s | $distance\n", @{$route[$index]}[4], $heading, round ($heading - @{$route[$index]}[5+$version]); &$sous_fonction ("@{$route[$index]}[6 + $version] - @{$route[$index]}[7 + $version]"); last ETAPE; } if (@{$route[$index]}[0] == 65) { # étape fix printf "\t| FIX | %-6s | -- | $distance\n", $heading; &$sous_fonction ("@{$route[$index]}[6 + $version]"); last ETAPE; } if (@{$route[$index]}[0] == 66) { # étape gps printf "\t| GPS | %-6s | -- | $distance\n", $heading; &$sous_fonction ("GPS - [@{$route[$index]}[1] , @{$route[$index]}[2]]"); last ETAPE; } if (@{$route[$index]}[0] == 1) { # aéroport de d'arrivée my ($localizer, $piste); if ($arrivee[0] =~ /\[RW(...)\s*/) { $piste = $1; $localizer = "RW $piste"; foreach (@{$arrivee[4]}) { $localizer = "ILS $_->[2]" if (($_->[0] == 4 || $_->[0] == 5) && $_->[1] eq $piste); } printf "\t| %-10s | %-6s | %-10s | $distance\n", $localizer, $heading, "RW $piste"; } else { foreach (@{$arrivee[4]}) { if ($_->[0] == 10) { $piste = "RW $_->[3]" ; printf "\t| %-10s | %-6s | %-10s | $distance\n", $piste, $heading, $piste; } elsif ($_->[0] == 4 || $_->[0] == 5) { ($localizer, $piste) = ("ILS $_->[2]", "RW $_->[1]"); printf "\t| %-10s | %-6s | %-10s | $distance\n", $localizer, $heading, $piste; } } } &$sous_fonction ("$arrivee[4]->[0]->[4] - $arrivee[4]->[0]->[5]"); last ETAPE; } } } $leg = [$depart[2], $depart[3], $arrivee[2], $arrivee[3]]; printf "\ntotal distance: %s %s (direct flight: %s)\n\n", round ($distance_totale), ($km)? 'km':'nm', round (distance_ ($leg) / $div); if ($com_app) { &$sous_fonction ("Useful frequencies for approach"); foreach (@{$arrivee[4]}) { printf ("$_->[@{$_}-1]: %s\n", $_->[1]/100) if ($_->[0] >= 50 && $_->[@{$_}-1] ne 'DEP'); } } } ####################### # FONCTION PRINCIPALE # ####################### sub main () { # if there is an error in options or help wanted if (!$options || $help) { print $texte_aide; exit; } # if we found departure and arrival the we build the route # otherwise print an error message (configure_extremite (\@depart, \$sid, \$sidx ) && configure_extremite (\@arrivee,\$star,\$starx)) ? plan_de_vol : printf $erreur; # results following options asked sortie_standard if (!$no_stdout ); fichier_csv if ($CSVFILE ); fichier_wp if ($WPFILE ); if ($INSTRFILE && -e "./plandevol-xml.pl") { require "plandevol-xml.pl"; fichier_xml (\@route, $PLANDEVOLHOME); } } main; # FORMATS USED TO STORE THE ROUTE (to be improved...) # # once the route has been built @arrivee and @depart have the same structure: # - name of the sid/star procedure used in the flight plan, if undef, no procedure usable # - ICAO code for airports, or symbol for telnet or coordinates given # - latitude of the beginning/ending point of the route # - pointer to an array containg pointers to arrays containing all the airport datas (yeah! rock'n'roll) # + complete name of the iarport, or symbol for telnet or coordinates given (first array) # + runways # + comm freqencies # the route is entirely contained in the array @route. each element of @route is a pointer to an array # containing all infos about the waypoint, following the structure of the file nav.dat