#!/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_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>
		   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

