Generated: Mon Aug 29 19:34:54 2016 from plandevol-eng01.pl 2014/09/30 45.6 KB. text copy
#!/Perl # l'option -w a été enlevée pour éviter l'affichage des warnings inutiles décrits ci-dessous: # 20140930 - Revisit to see if there are any ideas here ... # 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 MAY NOT BE ACCURATE OR CURRENT AND IS NOT VALID ## FOR NAVIAGTION OR FLIGHT PLANNING. NO WARRENTY OF FITNESS FOR ## ANY PURPOSE IS MADE OR IMPLIED. ## ## 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 ## ## Established a set of personal defaults, and an output file, so I can run it from ## within an editor, and have the results loaded in an editor for 'review' ... ## geoff mclane - 2006.10.16 ## added ## - a rave about veracity of data and calculations ## - output of the lat and lon of the nav points ###################################################################################################################################################### 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 require 'logfile.pl' or die "ERROR: Unable to load logfile.pl ...\n"; ## GLOBAL VARIABLES DECLARATION ##################################### # array containing infos about departure airport (see the very end of the script) #my @depart = (undef, "LFPG", undef, undef,undef); my @depart = (undef, "ZSPD", undef, undef, undef); ###my @depart = (undef, "DTTJ", undef, undef, undef); ###my @depart = (undef, "LFMN", undef, undef, undef); # array containing infos about arrival airport (see the very end of the script) ##my @arrivee = (undef, "LFST", undef, undef, undef, undef); my @arrivee = (undef, "YSSY", undef, undef, undef, undef); ##my @arrivee = (undef, "LFPO", undef, undef, undef, undef); ##my @arrivee = (undef, "LFMN", undef, undef, undef, undef); ##my @arrivee = (undef, "LFBD", undef, undef,undef, undef); # log file stuff my ($LF); my $outfile = 'temp.'.$0.'.txt'; 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 $FGROOT = (exists $ENV{FGROOT})? $FGROOT : "F:\\FG0910-4\\data"; my $FGROOT = (exists $ENV{FGROOT})? $FGROOT : "F:\\fgdata"; my $vor_a_vor = 0; # if only vor to vor route if wanted ###my $vor_preferes; # if we prefer vor to vor, but ndb is also ok my $vor_preferes = 1; # 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 $deviation_max = 10; # maximal turn ##my $dist_min = 20; # minimal distance between two navaids my $dist_min = 50; # minimal distance between two navaids my $km = 0; # to print distances in kilometers my $help; # for printing the help ###my $csv_conf=':,'; # european - separators for .csv file my $csv_conf=',.'; # the separator and decimal, for english .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 $WPFILE = 'tempwp.txt'; # for printing in a file in order to use it with --flight-plan option of fgfs my $CSVFILE = 'tempcsv.csv'; # for printing in a comma separated file $com = 1; # default to show useful departure and arrival frequencies ... $sidx = 1; $starx = 1; # sid/star protocol wanted with no runway specified 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 $rave = <<"EOF"; *** VERY IMPORTANT *** THIS SCRIPT MAY NOT BE ACCURATE OR CURRENT AND IS NOT VALID FOR NAVIAGTION OR FLIGHT PLANNING. NO WARRENTY OF FITNESS FOR ANY PURPOSE IS MADE OR IMPLIED. The airport, navaid, etc. information came from the files in the root folder [$FGROOT] ... Some options set - only vor = $vor_a_vorr vor-ndb = $vor_preferess dev max = $deviation_maxx dist min = $dist_min (minimal distance between two navaids) EOF 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 prt( "Finding extremite [ @{$extremite}->[1] ] ...\n" ); ###prt( "Finding extremite [ $_[0]->[1] ] ...\n" ); sub getPositionParTelnet ($) { # if we are not connected, so we do if (!$fgfs) { if ( !($fgfs = &connect("localhost", $_[0], 5)) ) { prt( "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; prt( "Opening, and scanning [$APTFILE] ...\n" ); # 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 prt( "Finding position by TELENET ...\n" ); $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 prt( "Using lat,lon position ...\n" ); $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 prt( "Finding position by icao name ...\n" ); ($extremite->[2], $extremite->[3], $extremite->[4]) = &$sous_fonction ($extremite); if ($extremite_ok) { prt( "Found at: $extremite->[2], $extremite->[3] ...\n" ); } } # 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) = @_; prt( "nav_to_ram: loading [$$fichier], [$phrase], [$decale] ...\n" ); my @selection; # array with useful navaids my $marge = 2; my $cnt = 0; 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; } # blocks $1 $2 $3 $4 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 interesting navaids while (<NAV>) { chomp; if (/$phrase/) { $cnt++; 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"; prt( "Returning " . scalar @selection . " of $cnt lines in range [$lat_sup,$long_sup]-[$lat_inf,$long_inf] ...\n" ); 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) { prt( sprintf( "File %s doesn't exist, procedure %s abandonned\n", $$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 close the 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); prt( sprintf( "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 { prt( sprintf( "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 { # name sep lat sep lon my $i = $_[0].$_[3].$_[1].$_[3].$_[2]; $i =~ s/\./$_[4]/g; # CONVERT dot to 'comma' for european 10,12345 degrees 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], # 0 $route[$index]->[1], # 1 $route[$index]->[2], # 2 $separateur, # 3 $decimal); # 4 } # 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, $fcnt); $sous_fonction = sub { prt( "\033[30;1m" ) if !$no_couleur; prt( "$_[0]\n" ); prt( "\033[m" ) if !$no_couleur; }; prt( "\nFlight Plan: DEPART: $depart[4]->[0]->[4] - $depart[4]->[0]->[5] ARRIVE: $arrivee[4]->[0]->[4] - $arrivee[4]->[0]->[5]\n"); if ($com_dep) { $fcnt = 0; foreach (@{$depart[4]}) { $fcnt++ if ($_->[0] >= 50 && $_->[@{$_}-1] ne 'APP'); } if ($fcnt) { &$sous_fonction ("Useful frequencies ($fcnt) for departure"); foreach (@{$depart[4]}) { prt( sprintf ("$_->[@{$_}-1]: %s\n", $_->[1]/100) ) if ($_->[0] >= 50 && $_->[@{$_}-1] ne 'APP'); } } else { &$sous_fonction ("NO useful frequencies available for departure"); } } prt( "SID procedure : $depart[0]\n" ) if $depart[0]; prt( "STAR procedure: $arrivee[0]\n" ) if $arrivee[0]; &$sous_fonction ("\nCode - Complete name"); prt( sprintf( "\t| Frequencies| Heading | Course/RNW | Distance in %s\n", ($km)? 'km':'nm' ) ); ###&$sous_fonction ("$depart[4]->[0]->[4] - $depart[4]->[0]->[5]"); &$sous_fonction ("$depart[4]->[0]->[4] - $depart[4]->[0]->[5]" . " - @{$route[0]}->[1],@{$route[0]}->[2]" ); # lat,lon prt( sprintf( "%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); prt( sprintf( "\t| ADF %-7s| %-6s | -- | $distance\n", @{$route[$index-1]}[4], $heading ) ) if @{$route[$index-1]}[0] == 2; prt( sprintf( "\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); } prt( sprintf( "\t| ADF %-7s| %-6s | -- | $distance\n", @{$route[$index]}[4], $heading ) ); ### show the NDB Code, Name, lat, lon ###&$sous_fonction ("@{$route[$index]}[6 + $version] - @{$route[$index]}[7 + $version]"); &$sous_fonction ("@{$route[$index]}[6 + $version] - @{$route[$index]}[7 + $version] - " . " @{$route[$index]}[1],@{$route[$index]}[2]" ); 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); prt( sprintf( "\t| ADF %-7s| %-6s | -- | $distance\n", @{$route[$index-1]}[4], $heading ) ) if @{$route[$index-1]}[0] == 2; prt( sprintf( "\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); } prt( sprintf( "\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]"); &$sous_fonction ("@{$route[$index]}[6 + $version] - @{$route[$index]}[7 + $version]" . " - @{$route[$index]}[1],@{$route[$index]}[2]" ); last ETAPE; } if (@{$route[$index]}[0] == 65) { # étape fix prt( sprintf( "\t| FIX | %-6s | -- | $distance\n", $heading ) ); ###&$sous_fonction ("@{$route[$index]}[6 + $version]"); &$sous_fonction ("@{$route[$index]}[6 + $version]" . " - @{$route[$index]}[1],@{$route[$index]}[2]" ); last ETAPE; } if (@{$route[$index]}[0] == 66) { # étape gps prt( sprintf( "\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); } prt( sprintf( "\t| %-10s | %-6s | %-10s | $distance\n", $localizer, $heading, "RW $piste" ) ); } else { foreach (@{$arrivee[4]}) { if ($_->[0] == 10) { $piste = "RW $_->[3]" ; prt( sprintf( "\t| %-10s | %-6s | %-10s | $distance\n", $piste, $heading, $piste ) ); } elsif ($_->[0] == 4 || $_->[0] == 5) { ($localizer, $piste) = ("ILS $_->[2]", "RW $_->[1]"); prt( sprintf( "\t| %-10s | %-6s | %-10s | $distance\n", $localizer, $heading, $piste ) ); } } } ###&$sous_fonction ("$arrivee[4]->[0]->[4] - $arrivee[4]->[0]->[5]"); &$sous_fonction ("$arrivee[4]->[0]->[4] - $arrivee[4]->[0]->[5]" . " - @{$route[$index]}[1],@{$route[$index]}[2]"); last ETAPE; } } } $leg = [$depart[2], $depart[3], $arrivee[2], $arrivee[3]]; prt( sprintf( "\ntotal distance: %s %s (direct flight: %s)\n\n", round ($distance_totale), ($km)? 'km':'nm', round (distance_ ($leg) / $div) ) ); if ($com_app) { $fcnt = 0; foreach (@{$arrivee[4]}) { $fcnt++ if ($_->[0] >= 50 && $_->[@{$_}-1] ne 'DEP'); } if ($fcnt) { &$sous_fonction ("Useful frequencies ($fcnt) for approach"); foreach (@{$arrivee[4]}) { prt( sprintf ("$_->[@{$_}-1]: %s\n", $_->[1]/100) ) if ($_->[0] >= 50 && $_->[@{$_}-1] ne 'DEP'); } } else { &$sous_fonction ("NO useful frequencies for approach available"); } } prt( "Generated by $0, " . scalar localtime(time()) . " ...\n" ); prt( $rave ); # end with 'warning' ... } ####################### # FONCTION PRINCIPALE # ####################### sub main () { # if there is an error in options or help wanted if (!$options || $help) { print $texte_aide; exit; } # log file stuff open_log($outfile); # 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 : prt( $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); } close_log($outfile,1); } 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