Generated: Sat Oct 24 16:35:27 2020 from plandevol02.pl 2018/06/30 112.5 KB. text copy
#!/usr/bin/perl # 12/11/2014 - Like the xg output, add refueling legs to the # 20141003 - Load ALL airports - for a light plane vfr, need to also supply re-fueling airport # 20141001 - Add a log file # 20140930 from : http://seb.marque.free.fr/fichiers/scripts/perl/plandevol # 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 ... ####################################################################################################################################################### ## *********************************************** ## ***** TRES IMPORTANT ***** VERY IMPORTANT ***** ## *********************************************** ## ## CE SCRIPT NE PROPOSE PAS UNE SOLUTION DE VOL FIABLE POUR LA CONSTRUCTION D'UN PLAN DE VOL RÉEL!!!!!!!! ## IL N'EST QU'UNE SOLUTION POUR PROPOSER UN TRAJET DE _LOISIR_ AVEC FLIGHTGEAR FS ET NE GARANTIT EN AUCUN CAS LA FIABILITÉ DES INFORMATIONS ## QU'IL DÉLIVRE ## ####################################################################################################################################################### ###################################################################################################################################################### ## ## script écrit par seb marque, paris, france ## ## plandevol, version 0.5.9 qui s'approche dangereusement de la version 0.6.0 ## --help pour une aide sur l'utilisation du script ## ## script placé sous licence GPL par Sébastien MARQUE ## texte complet disponible sur 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 ####################################################################################################################################################### ## ## les fonctions fg_connect, set_prop, get_prop et send proviennent du script telnet.pl trouvé dans le code source de fgfs 0.98 (de Curtis L. Olson, ## avec "courtesy" pour Melchior Franz. ## ## les fonctions round, ll2xyz, xyz2ll, llll2dir (dont provient llll2dir_), distance (dont provient distance_) et coord_dist_sqr proviennent du script ## de Melchior Franz "freq" trouvé sur http://members.aon.at/mfranz/freq, en attente de leur remplacement éventuel par les fonctions de Math::Trig ## ###################################################################################################################################################### ## ## bugs connus: si une balise est situé dans l'enceinte du point d'arrivée elle n'est pas détectée... c'est dommage ## fixé la compatibilité avec les différentes versions de nav.dat.gz ## ## version 0.6 -> réglage auto des instruments de vol ## -> intégration des fix dans le plan de vol si nécessaire ## -> gestion des sid/star ## -> nettoyage du code ## ###################################################################################################################################################### use strict; use POSIX qw(ceil floor); use Getopt::Long; # pour récupérer les options en ligne de commande use IO::Socket; # pour la connexion telnet avec FlightGear use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use Time::HiRes qw( gettimeofday tv_interval ); use Data::Dumper; use Env qw(HOME FG_ROOT FG_HOME); # pour lire HOME FG_HOME et FG_ROOT my $os = $^O; my $perl_dir = '/home/geoff/bin'; my $PATH_SEP = '/'; my $temp_dir = '/tmp'; if ($os =~ /win/i) { $perl_dir = 'C:\GTools\perl'; $temp_dir = $perl_dir; $PATH_SEP = "\\"; } unshift(@INC, $perl_dir); require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n"; require 'fg_wsg84.pl' or die "Unable to load fg_wsg84.pl ...\n"; # log file stuff our ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $temp_dir.$PATH_SEP."temp.$pgmname.txt"; my $out_xg = $temp_dir.$PATH_SEP."tempout.xg"; my $out_csv = $temp_dir.$PATH_SEP."tempout.csv"; open_log($outfile); my $def_dep = ""; my $def_arr = ""; my $debug_on = 1; if ($debug_on) { ##$def_dep = "YCBA"; ##$def_arr = "YGIL"; ##$def_dep = "YGIL"; ##$def_arr = "YPAG"; # "YBHI"; # "YCBA"; ##$def_dep = "KSFO"; # "ESSA"; # "LFPG"; ##$def_arr = "KLAX"; # "LFPG"; # "LFBD"; ##$def_dep = "LFPO"; # Orly ##$def_arr = "LFBD"; # Bordeaux Merignac ##$def_dep = "LFPV"; # Velizy ##$def_arr = "LFCZ"; # Mimizan ##$def_dep = "YPPH"; # Perth ##$def_arr = "YSSY"; # Sydney $def_dep = "KCLT"; # USA - 749 KCLT Charlotte Douglas Intl 35.223512110,-80.944231280 $def_arr = "LIRF"; # Italy - 15 LIRF Roma Fiumicino Leonardo 41.793517,12.251605 } # c172p #my $aircraft = "c172p"; #my $max_range = 696; # nm #my $cruise_speed = 150; # 122; # kts (kn) = 87 km/h #my $def_altitude = 2000; # feet AGL (or AMSL) # Cruise speed: 122 kn (140 mph; 226 km/h) # Stall speed: 47 kn (54 mph; 87 km/h) (power off, flaps down)[73] # Never exceed speed: 163 kn (188 mph; 302 km/h) (IAS)[8] # Range: 696 nmi (801 mi; 1,289 km) with 45 minute reserve, 55% Power, at 12,000 ft # Service ceiling: 13,500 ft (4,100 m) # Rate of climb: 721 ft/min (3.66 m/s) # Wing loading: 14.1 lb/sq ft (68.6 kg/m2) # Beech 99 #my $aircraft = "beech99"; # "beech99-yasim"; #my $max_range = 910; # nm #my $cruise_speed = 205; # kts (kn) = 87 km/h # Cruise speed: 205 knots (380 km/h) at 10,000 ft (3,050 m) # Range: 910 nm (1,048 mi, 1,686 km) at 216 mph (347 km/h) at 8,000 ft (2,440 m) # Service ceiling: 26,200 ft (7,988 m) # Rate of climb: 1,700 ft/min (8.63 m/s) #my $def_altitude = 5000; # feet AGL (or AMSL) # A330 my $aircraft = "A330"; # A330-300 my $max_range = 7500; # nm 13,450 km my $cruise_speed = 470; # kts (kn) = 871 km/h my $def_altitude = 10000; # feet AGL (or AMSL) # Cub #my $aircraft = 'Cub'; #my $cruise_speed = 62; # kn #my $max_range = 191; # NM with fuel adjustment to Cub_FDM.xml #my $def_altitude = 3000; # feet AGL (or AMSL) my $deviation_max = 10; # 30; # virage maximal my $dist_min = 74; # = 40 # was 10; # distance minimale entre deux waypoints (km?) ## DECLARATION DES VARIABLES GLOBALES ##################################### # sid icao lat lon apt-array # 0 1 2 3 4 my @depart = (undef, $def_dep, undef, undef, undef); # tableau contenant des infos sur l'aéroport de départ (sid, ICAO, lat, lon, nom complet de l'aéroport) my @arrivee = (undef, $def_arr, undef, undef, undef, undef); # tableau contenant des infos sur l'aéroport d'arrivée (star, ICAO, lat, lon, nom complet de l'aéroport) # 0 1 2 3 4 5 6 7 8 # push(@g_navaids, [$typ, $nlat, $nlon, $nalt, $nfrq, $nrng, $nfrq2, $nid, $name, 0, 0, 0, 0] ); my @g_navaids = (); my $fgfs; # socket de connexion à fgfs my @route; # contient la route à suivre my @flt_plan = (); # similar to the above my @flt_hops = (); # above processed to find refueling airports my %apt_icao = (); # set with a reference of each airport found. key=ICAO my ($navaid, $fix); # pointent sur les tableaux contenant les aides à la navigation my $erreur; # contient les messages d'erreur éventuels my $version; # pour la compatibilité avec différentes version de nav.dat.gz my $sous_fonction; # pointe vers des sous fonctions anonymes définies localement my @all_airports = (); # load ALL airports my $done_all = 0; # only done once # actually seems little difference on these mostly small distances my $use_sg_math = 1; # use fg_geo_inverse_wgs_84($lat1, $lon1, $lat2, $lon2, \$az1, \$az2, \$s); my $VERS = "0.8.0 2014-11-13"; # my $VERS = "0.7.0 2014-10-03"; # my $VERS = "0.6.0"; my $load_log = 0; my $verbosity = 1; # default verbosity (range 0,1,2,5,9) my $add_xg_bbox = 0; my $def_root = "F:\\fgdata"; $def_root = "X:\\fgdata" if (-d "X:\\fgdata"); # VARIABLES DES OPTIONS DU SCRIPT ################################# my $FGROOT = (exists $ENV{FG_ROOT})? $FG_ROOT : $def_root; my $FGHOME = (exists $ENV{FG_HOME})? $FG_HOME : "$HOME/.fgfs"; my $vor_a_vor; # exclusivement du vor my $vor_preferes; # si on veut du vor, mais sinon du ndb my $km; # affichage des distances en kilomètres my $help; # demande d'aide my $csv_conf=':,'; # les séparateurs pour les fichiers .csv my $no_stdout; # pas de sortie sur le terminal my ($sidx, $starx); # protocole sid/star demandé sans spécifier de piste my ($sid, $star); # protocole sid/star demandé en spécifiant une piste my $add_couleur; # applique des couleurs à la sortie standard my ($com_dep, $com_app, $com); # pour afficher les fréqences de communication my $wpt; #enregistrer la route my $WPFILE; # le fichier dans lequel on enregistre les points de passage my $CSVFILE; # le fichier dans lequel on enregistre les points de passage my $XGFILE; # le fichier dans lequel on enregistre les points de passage my $add_altitude = 1; # add altitdude to waypoints my $xml_base = ''; my $incl_refuel_ap = 1; # not used or documented # my $INSTRFILE; # création d'un fichier .xml # "instr" => \$INSTRFILE, 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, "max-range=i" => \$max_range, "fg-root=s" => \$FGROOT, "aircraft=s" => \$aircraft, "wpt" => \$wpt, "csv=s" => \$CSVFILE, "xg=s" => \$XGFILE, "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-dep" => \$com_dep, "com-app" => \$com_app, "com" => \$com, "def-alt=i" => \$def_altitude, "ansi" => \$add_couleur); ## FICHIERS UTILISÉS PAR LE SCRIPT ## à modifier selon sa propre configuration ## accepte les fichiers en clair, ou gzipés ########################################### my $NAVFILE = "$FGROOT/Navaids/nav.dat.gz"; # le fichier contenant les aides à la navigation my $FIXFILE = "$FGROOT/Navaids/fix.dat.gz"; # le fichier contenant les fix my $SIDFILE = "$FGROOT/NavAids/sid.dat"; # le fichier contenant les procédures SID my $STARFILE = "$FGROOT/NavAids/star.dat"; # le fichier contenant les procédure STAR my $APTFILE = "$FGROOT/Airports/apt.dat.gz"; # le fichier contenant les aéroports my $AWYFILE = "$FGROOT/Navaids/awy.dat.gz"; # hi and low airways ## DÉCLARÉ COMME VARIABLE MAIS UTILISÉ COMME CONSTANTE ###################################################### my $texte_aide = <<EOH; plandevol, v. $VERSS trouve une route de balises entre deux points. syntaxe: plandevol [options] (-d | --dep <icao de départ>) (-a | --arr <icao d'arrivée>) options: [-v | --vor-a-vor] [--preferer-vor] [--km] [--fg-root </PATH/TO/FG_DATA_FILES>] [--wpt] [--csv </PATH/TO/CSV_FILE>] [--csv-conf <colonnedécimal>] [--xg </PATH/TO/XG_FILE>] [--dev-max <angle en degrés>] [--dist-min <distance en km>] [--max-range <distance in nm>] [--aircraft <name>] [--sid <nom de piste>][--star <nom de piste>] [--sidx][--starx] [--com-dep][--com-app][--com] [--ansi] [--def-alt <alt-in-feet> [--help] Essential: -d|--dep=icao : point de départ. il est possible de spécifier: - soit le code oaci de l'aéroport (ex: --dep=LFQQ), - soit la position actuelle de l'avion dans fgfs (ex: --dep=telnet:5401) - soit une position exprimée en lat, long (ex: --dep=[45.564,-2.066]) Options: -a|--arr=icao : point d'arrivée. même possibilités que l'option --dep --aircraft <name>: Short name of aircraft. Used to name the xml output file. (default $aircraft) -v | --vor-a-vor : ne sélectionne que les balises VOR et VOR-DME (pas de TACAN) --preferer-vor : route construite avec NDB et VOR, avec une préférence pour les balises VOR --km : affiche la distance en km (défaut: affichage en nm) --fg-root=path : chemin contenant les fichiers de FlightGear défaut: $FGROOTT --wpt : enregistre la route dans $FGROOT/Routes (nommage auto) directory must exist. It will not be created. --csv=file : fichier CSV ( séparateur = : , virgule décimale = , ) pour affichage du trajet en graphique (via oocalc par exemple) --xg=file : fichier XG. Can be viewed by polyView2D. See https://sites.google.com/site/polyview2d/ --csv-conf=ab : paramètre les séparateurs de colonne et de décimale pour la fabrication du fichier csv. format = séparateurdécimale (ex: --csv-conf=?ù) pour des colonnes séparées par le caractère '?', et la virgule représentée par le caractère 'ù'. par défaut --csv-conf=$csv_conff --dev-max=degs : déviation maximale d'une balise à une autre par rapport au trajet en cours (défaut: $deviation_max°) --dist-min=km : distance minimale entre deux balises (défaut: $dist_min km) --max-range=nm : maximum distance before refueling (defaut: $max_range nm) --sid --star=rw : cherche le trajet en tenant compte de la procédure sid (ou star) de la piste <nom de la piste> codé sur deux ou trois caractères (ex: --sid 09 --star 23, ou --sid 09R --star 23) si aucun indicatif de piste (R, C ou L) n'est fourni ils seront tous les trois inclus dans la recherche de procédure --sidx, --starx : idem que --sid et --star, mais avec une piste choisie par le programme: - pour le moment, le choix se porte sur la piste dont la procédure rapproche du point de départ/arrivée - dans le futur, il est prévu une implémentation avec les METAR (décollage/atterrissage face au vent) - selon l'évolution du fichier apt.dat, on peut imaginer un choix en fonction des pistes réellement usitées --com-dep, --com-app : affichent respectivement les fréquences COM pour le départ (dep) ou l'approche (app) --com : affichent les fréquences COM pour le départ (dep) and l'approche (app) --def-alt=feet : default AGL in feet --ansi : affiche les étapes en couleurs, pour les terminaux qui ne supportent pas la norme ANSI, ou pour redirection du résultat --help : affiche ce message d'aide et quitte (même si d'autres options ont été spécifiées) CE SCRIPT NE PROPOSE PAS UNE SOLUTION DE VOL FIABLE POUR LA CONSTRUCTION D'UN PLAN DE VOL RÉEL!!!!!!!! IL N'EST QU'UNE SOLUTION POUR PROPOSER UN TRAJET DE _LOISIR_ AVEC FLIGHTGEAR FS ET NE GARANTIT EN AUCUN CAS LA FIABILITÉ DES INFORMATIONS QU'IL DÉLIVRE 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; my $KM2FEET = 3280.84; my $NM2KM = 1.852; my $KM2NM = 0.539957; sub VERB1() { return $verbosity >= 1; } sub VERB2() { return $verbosity >= 2; } sub VERB5() { return $verbosity >= 5; } sub VERB9() { return $verbosity >= 9; } sub pgm_exit($$) { my ($val,$msg) = @_; if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg); } # show_warnings($val); close_log($outfile,$load_log); exit($val); } # FONCTIONS DE CONNEXION AVEC FGFS PAR TELNET ############################################# sub get_prop($$) { my( $handle ) = shift; &fg_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; &fg_send( $handle, "set $prop $value"); # eof $handle and die "\nconnection closed by host"; } sub fg_send($$) { my( $handle ) = shift; print $handle shift, "\015\012"; } sub fg_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; } prt( "Attempting to connect to $host ... " . $timeout . "\n" ); sleep(1); } return 0; } # FONCTIONS DE CALCULS GEOGRAPHIQUES # par 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); } # return km distance 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; } # Airport Line. eg '1 5355 1 0 KABQ Albuquerque Intl Sunport' # 0 1 - this as an airport header line. 16 is a seaplane/floatplane base, 17 a heliport. # 1 5355 - Airport elevation (in feet above MSL). # 2 1 - Airport has a control tower (1=yes, 0=no). # 3 0 - Display X-Plane’s default airport buildings (1=yes, 0=no). # 4 KABQ - Identifying code for the airport (the ICAO code, if one exists). # 5+Albuquerque Intl Sunport - Airport name. sub load_airports() { my ($ver,$line,$type,$autre_bout); my $t1 = [gettimeofday]; if ( -e $APTFILE ) { open (APT, "gzip -d -c $APTFILE|") or die "je ne peux pas ouvrir $APTFILE\n" ; while (<APT>) { if (/^(\d+)\s+Version\s+/) { $ver = $1; last; } } } else { prt("fichier $APTFILE introuvable\n"); prt("veuillez vérifier \$FGROOT\n"); prt("ou utilisez l'option --fg-root=répertoire\n"); prt("ou encore modifiez le script ver ligne 80\n"); exit 1; } if ($ver) { prt("Loading file $APTFILE, version $ver... moment...\n") if (VERB1()); } else { close APT; prt("Failed to find version in $APTFILE!\n"); exit 1; } my $aptcnt = 0; while ($line = <APT>) { chomp $line; next if ($line =~ /^\s*$/); my @header = split(/\s+/, $line); $type = $header[0]; last if ($type == 99); if ($type == 1) { # 0 1 2 3 4 5+ # # elev_ft twr bld icao name push(@all_airports, \@header); $aptcnt++; } elsif ($type == 10) { if ($header[3] ne 'xxx') { # 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 # 10 36.962213 127.031071 14x 131.52 8208 1595.0620 0000.0000 150 321321 1 0 3 0.25 0 0300.0300 # 10 36.969145 127.020106 xxx 221.51 329 0.0 0.0 75 161161 1 0 0 0.25 0 $header[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') { $header[3] = $1.' '; $autre_bout .= ' '; } $header[3] = $header[3].'/'.$autre_bout; push(@all_airports,\@header); } } elsif ($type == 100) { # See version 1000 specs # 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 # 100 29.87 3 0 0.00 1 2 1 16 43.91080605 004.90321905 0.00 0.00 2 0 0 0 34 43.90662331 004.90428974 0.00 0.00 2 0 0 0 my $rwy = $header[8]; my $rwynm = $rwy; $rwynm =~ /(..)(.)/; $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') { $rwy = $1.' '; $autre_bout .= ' '; } $rwynm = $rwy.'/'.$autre_bout; my $rlat1 = $header[9]; # $of_lat1 my $rlon1 = $header[10]; # $of_lon1 my $rlat2 = $header[18]; # $of_lat2 my $rlon2 = $header[19]; # $of_lon2 my $rlat = ($rlat1 + $rlat2) / 2; my $rlon = ($rlon1 + $rlon2) / 2; my ($dist,$az1,$az2,$res,$s); if ($use_sg_math) { $res = fg_geo_inverse_wgs_84($rlat1, $rlon1, $rlat2, $rlon2, \$az1, \$az2, \$s); $dist = int(($s / 1000) * $KM2FEET ); # runway length, in feet } else { $dist = distance_( [$rlat1, $rlon1, $rlat2, $rlon2] ); $dist = int( $dist * $KM2FEET ); # runway length, in feet $az1 = llll2dir_( [$rlat1, $rlon1, $rlat2, $rlon2] ); } $az1 = round($az1); my @a = (); #push(@a,[10, $rlat, $rlon, $rwynm, $az1, $dist, 0.0, 0.0, 75, 161161, 1, 0, 0, 0.25, 0, 0]); @a = (10, $rlat, $rlon, $rwynm, $az1, $dist, 0.0, 0.0, 75, 161161, 1, 0, 0, 0.25, 0, 0); push(@all_airports, \@a); } elsif (($type >= 50)&&($type <= 59)) { # on garde aussi les fréquences COM... push(@all_airports,\@header); } } $done_all = scalar @all_airports; my $elap = secs_HHMMSS( tv_interval( $t1, [gettimeofday] ) ); prt("Loaded $aptcnt airports, total $done_all lines...in $elap...\n") if (VERB1()); $done_all = 1; } sub get_airport_by_icao($$) { my ($icao,$ara) = @_; my $max = scalar @all_airports; my ($i,$type,$ra); my $fnd = 0; for ($i = 0; $i < $max; $i++) { $ra = $all_airports[$i]; $type = ${$ra}[0]; if (($type == 1) && (${$ra}[4] eq $icao)) { push(@{$ara},$ra); $i++; $fnd = 1; for (; $i < $max; $i++) { $ra = $all_airports[$i]; $type = ${$ra}[0]; last if ($type == 1); # stop at next airport header push(@{$ara},$ra); } } last if ($fnd); } return $fnd; } # FONCTIONS DE CALCUL DU TRAJET # passed reference to # my @depart = (undef, "LFPG", undef, undef,undef); # or @arrivee ... ############################### sub configure_extremite ($$$) { my ($extremite, $proc, $procx) = @_; my $extremite_ok; # positionné à 1 si l'extrémité a pu être configuré, # sera la valeur de retour de la fonction # to UPPER case $extremite->[1] =~ tr/a-z/A-Z/; my $icao = $extremite->[1]; # extract icao sub getPositionParTelnet ($) { # si on est pas déjà connecté, alors on se connecte if (!$fgfs) { if ( !($fgfs = &fg_connect("localhost", $_[0], 5)) ) { prt("Impossible de se connecter\n"); } } # on récupère la position actuelle de l'appareil my $lat = get_prop ($fgfs,"/position/latitude-deg[0]"); my $lon = get_prop ($fgfs, "/position/longitude-deg[0]"); # si la postion est trouvée (limitation: ~ est différente de 0°00'00''N 0°00'00''E) if ($lat && $lon) { $extremite_ok = 1; return $lat, $lon; } else { $erreur = "Impossible de déterminer la position actuelle de l'appareil\n"; } } $sous_fonction = sub { my $t1 = [gettimeofday]; my ($type,@donnees_aeroport); get_airport_by_icao($icao,\@donnees_aeroport); # on récupère ses coordonnées de la première piste listée... pour l'instant my $lcnt = scalar @donnees_aeroport; if ($lcnt > 0) { my ($i,$ra,$alat,$alon); for ($i = 0; $i < $lcnt; $i++) { $ra = $donnees_aeroport[$i]; $type = ${$ra}[0]; ### prt("$i: rtype $rtype\n"); if ($type == 10) { $alat = ${$ra}[1]; $alon = ${$ra}[2]; $extremite_ok = 1; last; } } if ($extremite_ok) { my $elap = secs_HHMMSS( tv_interval( $t1, [gettimeofday] ) ); prt("Success: $icao lat/lon $alat,$alon, $lcnt records... in $elap\n") if (VERB1()); # return @{$donnees_aeroport[1]}[1], @{$donnees_aeroport[1]}[2], \@donnees_aeroport; return $alat,$alon,\@donnees_aeroport; } $erreur = "Error: No runways found for $icao..."; } else { # ces lignes ne atteintes que si aucun aéroport a été trouvé dans la base $erreur = "Error: $icao n'a pas été trouvé dans la base de données aéroports..."; } }; if ($extremite->[1] =~ /^TELNET:(\d+)/) { # position actuelle de l'appareil, connue par 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 exprimée en coordonnées cartésiennes $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 = "format de coordonnées inconnu...: ".$extremite->[2]." ".$extremite->[3]; } ($extremite->[0], $$proc, $$procx) = (undef, undef, undef); } else { # position par nom de l'aéroport # set positions and runway array ($extremite->[2], $extremite->[3], $extremite->[4]) = &$sous_fonction ($extremite); } # on ferme la connexion avec fgfs close ($fgfs) if $fgfs; # on retourne le résultat de nos recherches return $extremite_ok; } sub load_nav_data() { my $t1 = [gettimeofday]; prt("\n[v5] Loading $NAVFILE file ...\n") if (VERB5()); die "ERROR: Can NOT stat '$NAVFILE'!\n" if ( !( -f $NAVFILE) ); open NIF, "gzip -d -c $NAVFILE|" or die "ERROR: CAN NOT OPEN $NAVFILE...$!...\n"; my @nav_lines = <NIF>; close NIF; my $elap = secs_HHMMSS( tv_interval( $t1, [gettimeofday] ) ); prt("[v5] Got ".scalar @nav_lines." lines in $elap...\n") if (VERB5()); my ($line,@arr,$nc,$i,$len); my ($typ,$nlat,$nlon,$nalt,$nfrq,$nrng,$nfrq2,$nid,$name); foreach $line (@nav_lines) { chomp $line; $line = trim_all($line); $len = length($line); next if ($line =~ /\s+Version\s+/i); next if ($line =~ /^I/); next if ($len == 0); # 0 1 (lat) 2 (lon) 3(alt) 4(feq) 5(rng) 6 7 8++ # 2 38.087769 -077.324919 284 396 25 0.000 APH A P Hill NDB # 3 57.103719 009.995578 57 11670 100 1.000 AAL Aalborg VORTAC # 4 39.980911 -075.877814 660 10850 18 281.662 IMQS 40N 29 ILS-cat-I # 4 -09.458922 147.231225 128 11010 18 148.650 IWG AYPY 14L ILS-cat-I # 5 40.034606 -079.023281 2272 10870 18 236.086 ISOZ 2G9 24 LOC # 5 67.018506 -050.682072 165 10955 18 61.600 ISF BGSF 10 LOC # 6 39.977294 -075.860275 655 10850 10 300281.205 --- 40N 29 GS # 6 -09.432703 147.216444 128 11010 10 302148.785 --- AYPY 14L GS # 7 39.960719 -075.750778 660 0 0 281.205 --- 40N 29 OM # 7 -09.376150 147.176867 146 0 0 148.785 JSN AYPY 14L OM # 8 -09.421875 147.208331 91 0 0 148.785 MM AYPY 14L MM # 8 -09.461050 147.232544 146 0 0 328.777 PY AYPY 32R MM # 9 65.609444 -018.052222 32 0 0 22.093 --- BIAR 01 IM # 9 08.425319 004.475597 1126 0 0 49.252 IL DNIL 05 IM # 12 -09.432703 147.216444 11 11010 18 0.000 IWG AYPY 14L DME-ILS # 12 -09.449222 147.226589 11 10950 18 0.000 IBB AYPY 32R DME-ILS @arr = split(/\s+/,$line); $nc = scalar @arr; $typ = $arr[0]; last if ($typ == 99); if ($nc < 8) { prt("Type: [$typ] - Handle this line [$line] - count = $nc...\n"); pgm_exit(1,"ERROR: FIX ME FIRST!\n"); } $nlat = $arr[1]; $nlon = $arr[2]; $nalt = $arr[3]; $nfrq = $arr[4]; $nrng = $arr[5]; $nfrq2 = $arr[6]; $nid = $arr[7]; $name = ''; for ($i = 8; $i < $nc; $i++) { $name .= ' ' if length($name); $name .= $arr[$i]; } push(@g_navaids, [$typ, $nlat, $nlon, $nalt, $nfrq, $nrng, $nfrq2, $nid, $name, 0, 0, 0, 0] ); } $elap = secs_HHMMSS( tv_interval( $t1, [gettimeofday] ) ); prt("[v5] Got ".scalar @g_navaids." navaids in $elap...\n") if (VERB5()); } # NAV_TO_RAM ############ # 0 1 (lat) 2 (lon) 3(alt) 4(feq) 5(rng) 6 7 8++ # 2 38.087769 -077.324919 284 396 25 0.000 APH A P Hill NDB # 3 57.103719 009.995578 57 11670 100 1.000 AAL Aalborg VORTAC sub nav_to_ram ($$$) { my ($fichier, $phrase, $decale) = @_; prt("Loading file ${$fichier}, p=$phrase d=$decale\n") if (VERB2()); my @selection; # tableau qui va contenir les aides à la navigation utiles 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; prt("For lat/lon $lat_sup,$long_sup $lat_inf,$long_inf...\n") if (VERB5()); if ( -e $$fichier ) { $$fichier =~ /.+\.(.+)$/; my $fichier_traite = ($1 eq 'gz')? 'gzip -d -c '.$$fichier.'|' : $$fichier; open (NAV, $fichier_traite) or die "je ne peux pas ouvrir $$fichier\n" ; } else { die "fichier $$fichier introuvable\n"; } # on détermine la version du fichier nav.dat if ($$fichier eq $NAVFILE) { while (<NAV>) { if (/^(\d+) Version/) { $version = $1; last; } } # si la version est supérieure à 6.00 on incrémente de 1 les index des tableaux $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*'; # on parcourt le fichier pour ne conserver que les balises intéressantes 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; } # si par hasard on trouve des infos sur les balises ILS de notre aéroport d'arrivée, pourquoi se gêner? if (/$ils/ && $3 eq $arrivee[1]) { push (@{$arrivee[4]}, [$1, $4, $2/100]); } if (/$ils/ && $3 eq $depart[1]) { push (@{$depart[4]}, [$1, $4, $2/100]); } } close (NAV) or die "je ne peux pas fermer $$fichier"; prt("Close ${$fichier}, returing ".scalar @selection." items.\n") if (VERB9()); 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]] ); #RECHERCHE DE LA BALISE LA PLUS PROCHE prt("Searching ".scalar @$navaid."... hdgs from $heading_from to $heading_to...\n") if (VERB9()); 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/; # on saute à la prochaine itération si la balise testée est celle d'une des # extrémités du segment next if ( ($2 == $leg->[0] && $3 == $leg->[1]) || ($2 == $leg->[2] && $3 == $leg->[3]) ); # on calcule l'écart de route en degrés 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); # on saute à la prochaine itération si l'écart est supérieur à l'écart autorisé next if ($deviation_to > $deviation_max && $deviation_from > $deviation_max); # on calcule les distances... 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]] ); # si c'est la plus proche et si la distance est suffisante if ( $navaid_dist < $ref_dist[$1] && $dist_to > $dist_min && $dist_from > $dist_min ) { # on retient cette option et on sauve la nouvelle distance de référence $ref_navaid[$1] = $index; $ref_dist[$1] = $navaid_dist; } } #RETOUR EN FONCTION DES CHOIX SWITCH : { #SI ON NE VEUT QUE DU VOR if ($vor_a_vor) { return $ref_navaid[$VOR]; last SWITCH; } #SI ON PREFERE LES VOR AUX NDB if ($vor_preferes && $ref_navaid[$NDB]) { return ($ref_navaid[$VOR])? $ref_navaid[$VOR] : $ref_navaid[$NDB]; last SWITCH; } #SI ON EST INDIFFERENT if ($ref_navaid[$VOR] && $ref_navaid[$NDB]) { return ($ref_dist[$VOR] < $ref_dist[$NDB])? $ref_navaid[$VOR] : $ref_navaid[$NDB]; last SWITCH; } #SI PAS DE VOR if (!$ref_navaid[$VOR] && $ref_navaid[$NDB]) { return $ref_navaid[$NDB]; last SWITCH; } #SI PAS DE NDB if ($ref_navaid[$VOR] && !$ref_navaid[$NDB]) { return $ref_navaid[$VOR]; } else { return $ref_navaid[0]; } } } sub construction_route ($$$$) { # on récupère les arguments de la fonction my ($depuis, $vers, $plan, $lev) = @_; my $lat1 = $depuis->[0]; my $lon1 = $depuis->[1]; my $lat2 = $vers->[0]; my $lon2 = $vers->[1]; # les coordonnées du segments [depuis-vers] # my $coord_leg = [$depuis->[0], $depuis->[1], $vers->[0], $vers->[1]]; my $coord_leg = [$lat1, $lon1, $lat2, $lon2]; # on calcule les coordonnées du milieu du segment [depuis-vers] # par une méthode peu orthodoxe... my $mi_trajet = [ $depuis->[0]+(($vers->[0]-$depuis->[0])/2), $depuis->[1]+(($vers->[1]-$depuis->[1])/2) ]; # on cherche la balise la plus proche du milieu du segment [depuis-vers] my $dist = distance_ ($coord_leg); prt("Leg: $lat1,$lon1 - $lat2,$lon2, dist ".(round($dist*100) / 100)." km\n") if (VERB9()); my $indexPlusProcheNavAid = getNavAidNearestMidPoint ($coord_leg, $mi_trajet, $dist/2); # si on en trouve une if ($indexPlusProcheNavAid) { # on récupère les coordonnées # $1 = latitude # $2 = longitude $navaid->[$indexPlusProcheNavAid] =~ /^.\s+(\S+)\s+(\S+)\s/; # on la nomme "waypoint" prt("waypoint $1,$2\n") if (VERB9()); my $waypoint = [$1,$2]; # on construit la route entre "depuis" et "waypoint" construction_route ($depuis, $waypoint, $plan, $lev + 1); # on sauve la balise la plus proche du milieu my @a = split /\s+/, $navaid->[$indexPlusProcheNavAid], 8 + $version; prt("Added: ".join(" ",@a)." to plan\n") if (VERB5()); push @$plan, \@a; push(@flt_plan,\@a); # on construit la route entre "waypoint" et "vers" construction_route ($waypoint, $vers, $plan, $lev + 1); } else { prt("Failed to get any navaids on route!\n") if (($lev == 0) && (VERB9())); } } # GESTION DES PROCÉDURES SID/STAR ################################# sub teste_existence_procedure ($$$) { # on récupère les arguments de la fonction my ($sidstar, $fichier, $marqueur) = @_; my @trouvailles; # si le fichier sid.dat ou star.dat n'existe pas on abandonne la procédure if (! -e $$fichier) { prt(sprintf( "le fichier %s n'existe pas, la procédure %s est abandonnée", $$fichier, ($marqueur == 60)? 'SID' : 'STAR')); return 0; } # on ouvre le fichier $$fichier =~ /.+\.(.+)$/; my $fichier_traite = ($1 eq 'gz')? 'gzip -d -c '.$$fichier.'|' : $$fichier; open (FICHIER, $fichier_traite) or die "impossible d'ouvrir le fichier $$fichier!!!"; # on parcourt le fichier à la recherche des procédures while (<FICHIER>) { chomp; if (/^$marqueur\s+(\S+)\s+(.+)/ && $1 eq $sidstar->[1]) { # ouverture de procédure qui correspond my @procedure; push @procedure, $2; while (<FICHIER>) { chomp; last if (/^\s*$/); # une ligne vide on arrête la recherche pour cette procédure push @procedure, $_; # tant qu'il y a des données on prend } # on place la procédure entière dans @trouvailles push @trouvailles, \@procedure; } } # on ferme le fichier close (FICHIER); # @trouvaille contient toutes les procédures connues pour notre aéroport # on sauve les résultats là où qu'il faut $sidstar->[0] = \@trouvailles; # on renvoie la taille du tableau @trouvailles (0 = rien trouvé) my $taille = @trouvailles; return $taille; } sub mise_en_forme_procedure ($$) { my ($procedure, $extremite) = @_; my @procedure_exploitable; # tableau contenant les étapes exploitables de la procédure entière my $nombre_d_entrees = 0; # pour contrôler le nombre d'entrées de la procédure rééellement exploitables # si il est nul, alors on abandonne # table de hachage utilisée par $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+)' ]); # retourne la ligne d'un fix ou d'une aide à la navigation depuis les bases de données correspondantes $sous_fonction = sub { my ($test, $nom) = @_; foreach my $element (@{$type{$test}->[0]}) { return $element if ($element =~ /$type{$test}->[1]/ && $1 eq $nom); } }; # pour vérifier si la procédure sera modifiée my $modifie = @{$procedure}; # on arrange chaque élément des procédures sid et star pour les incorporer à la route for (my $index = 1; $index < @{$procedure}; $index++) { $procedure->[$index] =~ /^(\S+)\s+(\S+)\s+(\S+)\s+(.+)$/; my $point_de_passage = $1; # si le point de passage est un fix, un vor ou un ndb... if ($point_de_passage == 65) { # on arrête si c'est l'arrivée (code A de la procédure star) # pour plus tard, les étapes de l'approche manquée seront sauvées quelque part pour traitement... last if ($2 eq 'A'); # on récupère toute l'info le concernant $procedure->[$index] = &$sous_fonction ($2, $3); # on continue pour le prochain point de passage si on ne trouve rien next if !$procedure->[$index]; # si c'est un vor ou un ndb on rajoute l'altitude minimale au dessus du point if ($2 eq 'V' || $2 eq 'N') { $procedure->[$index] .= " $4"; } # s'il s'agit d'un fix, on reformate pour que la taille corresponde avec les autres point du plan de vol 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"; } } # ...ou si le point de passage est un gps, on reformate comme pour les fix 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"; } # ...ou si c'est un trajet d'attente, on l'abandonne (pour l'instant) elsif ($point_de_passage == 64) { next; } # on découpe les points de passage my @etape = split (/\s+/, $procedure->[$index]); $nombre_d_entrees++; push @procedure_exploitable, \@etape; } # on ne retient dans $depart[0]/$arrivee[0] que le nom de la procédure # et on indique si elle a été modifiée my $a_ete_modifie = ($nombre_d_entrees != $modifie)? ' (modifiée)' : undef; $extremite->[0] = ($nombre_d_entrees)? @{$procedure}[0].$a_ete_modifie : undef; # on retourne la procédure exploitable return \@procedure_exploitable; } sub sid_star ($$$$$$) { # on récupère les paramètres my ($proc, $procx, $extremite, $fichier, $marqueur, $autre_extremite) = @_; my $ref_dist = 99999; # distance de référence pour comparer my $ref_index; # index de référence pour se souvenir my $dist; # la distance entre les deux extrémités my @retenues; # contiendra la liste des procédures correspondant à la demande d'une piste particulière my $phrase_a_matcher; # faute de meilleur nom... # table de hachage utilisée par $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+)' ]); # retourne les coordonnées d'un fix ou d'une aide à la navigation $sous_fonction = sub { my ($test, $nom) = @_; foreach my $element (@{$type{$test}->[0]}) { return ($1, $2) if ($element =~ /$type{$test}->[1]/ && $3 eq $nom); } }; # si on trouve au moins une procédure sid/star: # elle(s) est(sont) placées dans $depart[0]/$arrivee[0] # et on charge les données nav et fix. 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); } # sinon on annule la demande de procédure sid/star # et on sort de la fonction else { ($extremite->[0], $$proc, $$procx) = (undef, undef, undef); prt(sprintf( "Aucune procédure %s n'a été trouvée pour %s\n", ($marqueur == 60)? 'SID':'STAR', $extremite->[1])); return; } # on commence par chercher la ou les procédures voulues if ($$proc) { foreach my $procedure (@{$extremite->[0]}) { push @retenues, $procedure if ($procedure->[0] =~ /\[RW$$proc.\s*/); } # si on a trouvé les pistes correspondantes à la demande if (@retenues != 0) { $extremite->[0] = \@retenues; } # sinon on annule la demande --sid/--star qui devient une demande --sidx/--starx else { prt(sprintf( "Aucune procédure %s n'a été trouvée pour la piste $$proc sur $extremite->[1]\n", ($marqueur == 60)? 'SID':'STAR')); $$proc = undef; $$procx = 1; } } # on choisit la meilleure procédure, # pour l'instant le choix se fait par le calcul de la plus petite distance # pour chaque procédure connue for (my $index = @{$extremite->[0]}; $index--; ) { my $entree = 1; # $1 contient l'info du type de dernier(sid)/premier(star) point de passage de la procédure: # - 4, ou 7: trajet d'attente (uniquement pour star) # - 5: vor, ndb ou fix # - 6: coordonnées gps POINT_DE_PASSAGE : { # on atteint le dernier élément de la procédure sid numéro $index # ou le premier de la procédure star numéro $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) { # c'est un trajet d'attente (holding pattern) # ben ça attendra encore un peu ... on lit l'étape suivante $entree++; next POINT_DE_PASSAGE; # je ne suis pas tout à fait certain de l'orthodoxie de cette syntaxe... } if ($1 == 5) { # c'est un fix ou un vor, ou un ndb... # ou un point d'arrivée (code A) de procédure star mais je considère cette possibilité comme nulle # on cherche le type et le nom $phrase_a_matcher =~ /^65\s+(\S)\s+(\S+)/; # on cherche ses coordonnées my ($lat, $lon) = &$sous_fonction ($1, $2); # on passe au point suivant si le point recherché n'est pas connu if (!$lat) { $entree++; next POINT_DE_PASSAGE; # je ne suis pas tout à fait certain de l'orthodoxie de cette syntaxe... } # on calcule la distance entre les deux extrémités $dist = distance_ ( [$lat, $lon, $autre_extremite->[1], $autre_extremite->[2]] ); # on retient la solution si la distance est inférieure à la distance de référence ($ref_dist, $ref_index) = ($dist, $index) if ($dist < $ref_dist); # on sort last POINT_DE_PASSAGE; } if ($1 == 6) { # c'est un point gps # on lit les coordonnées du point $phrase_a_matcher =~ /^66\s+\S+\s+(\S+)\s+(\S+)/; # on calcule la distance entre les deux extrémités $dist = distance_ ([$1/100000, $2/100000, $autre_extremite->[2], $autre_extremite->[3]]); # on retient la solution si la distance est inférieure à la distance de référence ($ref_dist, $ref_index) = ($dist, $index) if ($dist < $ref_dist); # on sort last POINT_DE_PASSAGE; # inutile mais c'est pour faire joli } } # POINT_DE_PASSAGE } # for (my $index = @{$extremite->[0]}; $index--; ) # on met en forme la procédure trouvée my $procedure_finale = mise_en_forme_procedure ($extremite->[0]->[$ref_index], $extremite); # on enregistre les coordonnées de l'extrémité sid/star, si trouvées $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]; # on retourne la procédure sid/star return $procedure_finale; } ## PLAN DE VOL ############## sub plan_de_vol { # les aides à la navigation my @NDBVOR; $navaid = \@NDBVOR; # les fix my @FIX; $fix = \@FIX; # l'aéroport de départ est le premier point 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]]; # # lat lon icao # 0 1 2 3 push(@flt_plan, [1, $depart[2], $depart[3], $depart[1] ]); # on trouve les coordonnées de sortie de la procedure sid, qui deviendront $depart[2] et $depart[3] # le trajet sera contenu dans $depart[0] my $procedure_sid = sid_star (\$sid, \$sidx, \@depart, \$SIDFILE, 60, \@arrivee) if ($sid || $sidx); # on trouve les coordonnées d'entrée de la procédure star, qui deviendront $arrivee[2] et $arrivee[3] # le trajet sera contenu dans $arrivee[0] my $procedure_star = sid_star (\$star, \$starx, \@arrivee, \$STARFILE, 61, \@depart) if ($star || $starx); # si ce n'est déjà fait on place les données nécessaires en mémoire pour aller plus vite # (@FIX seulement dans le cadre des procédures sid/star, pour le moment...) @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); prt("Constructing the route, deviation max = $deviation_max, dist min $dist_min km... moment...\n") if (VERB1()); # on ajoute tous ses points de passage sid dans le plan de vol if ($depart[0]) { push @route, @{$procedure_sid}; push(@flt_plan, @{$procedure_sid}); } # on construit la route entre les deux extrémités construction_route ( [$depart[2], $depart[3]], [$arrivee[2], $arrivee[3]], \@route, 0); # on ajoute tous les points de passage star dans le plan de vol if ($arrivee[0]) { push @route, @{$procedure_star}; push(@flt_plan,@{$procedure_star}); } # on prend les coordonnées de la piste qui sera utilisée $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); # IL RESTE À TROUVER LA DERNIÈRE BALISE (ÉVENTUELLE) SITUÉE SUR L'AÉROPORT D'ARRIVÉE # si aucune procédure star n'est demandée (ou valable) # l'aéroport d'arrivée est le dernier point 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]]; # # lat lon icao push(@flt_plan, [1, $arrivee[2], $arrivee[3], $arrivee[1] ]); my $cnt = scalar @route; prt("Done route with $cnt legs...\n") if (VERB1()); # on détruit les listes des aides à la navigation désormais inutiles $navaid = undef; $fix = undef; } # FONCTIONS DE SORTIE DU RESULTAT ################################# sub fichier_csv () { $sous_fonction = sub { my $i = $_[0].$_[3].$_[1].$_[3].$_[2]; $i =~ s/\./$_[4]/g; return $i; }; # ouverture du fichier if (!open (CSV, ">$CSVFILE")) { prt("Error: Failed to open $CSVFILE!\n"); return; } # 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); prt("CSV output written to $CSVFILE.\n"); } #my @all_airports = (); #my $done_all = 0; sub get_airport($) { my $t = shift; my $ap = undef; my $marge = 2; my $latA = $t->[0]; # from my $lonA = $t->[1]; my $latB = $t->[2]; # to my $lonB = $t->[3]; my ($max,$max_lat,$max_lon,$min_lat,$min_lon); $max = scalar @all_airports; if ($latA < $latB) { $min_lat = $latA - $marge; $max_lat = $latB + $marge; } else { $min_lat = $latB - $marge; $max_lat = $latA + $marge; } if ($lonA < $lonB) { $min_lon = $lonA - $marge; $max_lon = $lonB + $marge; } else { $min_lon = $lonB - $marge; $max_lon = $lonA + $marge; } prt("Find an ap in $min_lon,$min_lat,$max_lon,$max_lat... in $max lines...\n") if (VERB9()); my ($i,$i2,$raa,$rwa,$alat,$alon,$typ); my @aps = (); for ($i = 0; $i < $max; $i++) { $raa = $all_airports[$i]; $typ = ${$raa}[0]; if ($typ == 1) { $i2 = $i + 1; ### prt("Test ".join(" ",@{$raa})."\n"); for (; $i2 < $max; $i2++) { $rwa = $all_airports[$i2]; $typ = ${$rwa}[0]; if ($typ == 10) { $alat = ${$rwa}[1]; $alon = ${$rwa}[2]; if (($alat >= $min_lat)&& ($alat <= $max_lat)&& ($alon >= $min_lon)&& ($alon <= $max_lon)) { push(@aps,[$raa,$alat,$alon,$i]); ###prt("Found ".join(" ",@{$raa})."\n"); $i = $i2; last; } } elsif ($typ == 1) { if ($i2 > ($i + 1)) { $i2--; $i = $i2; } last; } } } } $max = scalar @aps; if ($max) { # hmmm, this is based on DISTANCE only. # a 'better' idea might be one CLOSEST to this TRACK my ($ap2,$dist_min,$dist,$dist1,$dist2,$index); for ($i = 0; $i < $max; $i++) { $rwa = $aps[$i]; $raa = ${$rwa}[0]; $alat = ${$rwa}[1]; $alon = ${$rwa}[2]; $dist1 = distance_( [$latA,$lonA,$alat,$alon] ); $dist2 = distance_( [$latB,$lonB,$alat,$alon] ); $dist = ($dist1 < $dist2) ? $dist1 : $dist2; if ($i == 0) { $dist_min = $dist; $index = ${$rwa}[3]; $ap2 = $rwa; } elsif ($dist < $dist_min) { $dist_min = $dist; $index = ${$rwa}[3]; $ap2 = $rwa; } } # chosen airport - TODO: more choice criteria $raa = ${$ap2}[0]; $alat = ${$ap2}[1]; $alon = ${$ap2}[2]; prt("Found ".join(" ",@{$raa}).", $alat,$alon, of $max, index $index\n") if (VERB9()); $max = scalar @all_airports; my @a = (); for ($i = $index; $i < $max; $i++) { $rwa = $all_airports[$i]; $typ = ${$rwa}[0]; if ($i == $index) { push(@a,$rwa); } else { last if ($typ == 1); push(@a,$rwa); } } # $raa = $all_airports[$index]; # get header of this chosen airport # $raa = ${$ap2}[0]; $ap = [$raa,$alat,$alon,\@a]; # pass back ALL entries for this airport } else { prt("No airport found in $min_lon,$min_lat,$max_lon,$max_lat! marg $marge\n"); exit 1; } return $ap; } sub get_apt_pos($) { my $apt = shift; my $max = scalar @{$apt}; my $rwys = ''; my ($ra,$i,$rtyp,$rlat,$rlon); for ($i = 0; $i < $max; $i++) { $ra = ${$apt}[$i]; $rtyp = ${$ra}[0]; if ($rtyp == 10) { $rlat = ${$ra}[1]; $rlon = ${$ra}[2]; return ($rlat,$rlon); } } prt("Error: apt array contains NO runways! *** FIX ME ***\n"); exit 1; } sub get_rw_list2($) { my $apt = shift; my $max = scalar @{$apt}; my $rwys = ''; my ($ra,$i,$i2,$rtyp,$rlat,$rlon,$rnm,$rhdg,$rlen); # 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 # 10 36.962213 127.031071 14 /32 131.52 8208 1595.0620 0000.0000 150 321321 1 0 3 0.25 0 0300.0300 my @arr = (); for ($i = 0; $i < $max; $i++) { $i2 = $i + 1; $ra = ${$apt}[$i]; $rtyp = ${$ra}[0]; if ($rtyp == 10) { $rlat = ${$ra}[1]; $rlon = ${$ra}[2]; $rnm = ${$ra}[3]; $rhdg = ${$ra}[4]; $rlen = ${$ra}[5]; push(@arr,[$rtyp,$rlat,$rlon,$rnm,$rhdg,$rlen]); } } $max = scalar @arr; for ($i = 0; $i < $max; $i++) { $i2 = $i + 1; $ra = $arr[$i]; $rlat = ${$ra}[1]; $rlon = ${$ra}[2]; $rnm = ${$ra}[3]; $rhdg = ${$ra}[4]; $rlen = ${$ra}[5]; $rwys .= "{\"lat\":".sprintf("%.8f",$rlat).",\"lon\":".sprintf("%.8f",$rlon).",\"marks\":\"$rnm\",\"heading\":".sprintf("%.1f",$rhdg).",\"length_ft\":".sprintf("%d",int($rlen))."}"; $rwys .= ",\n" if ($i2 < $max); # there are more } return $rwys; } sub get_rw_list($) { my $ap = shift; my $apt = ${$ap}[3]; # array of AIRPORT items return get_rw_list2($apt); } # ATC frequencies Example Usage # 53 Identifies this as an airport ATC frequency line. Codes in the 50 - 59 range are used to identity # different ATC types. # 12190 Airport ATC frequency, in Megahertz multiplied by 100 (ie. 121.90 MHz in this example). # GND Name of the ATC frequency. This is often an abbreviation (such as GND for "Ground"). sub get_coms_list2($) { my $apt = shift; my $max = scalar @{$apt}; my $coms = ''; my ($ra,$i,$i2,$rtyp,$freq,$name); # 0 1 2 # 53 12190 GND my @arr = (); for ($i = 0; $i < $max; $i++) { $ra = ${$apt}[$i]; $rtyp = ${$ra}[0]; # on garde aussi les fréquences COM... if (($rtyp >= 50)&&($rtyp <= 59)) { $freq = ${$ra}[1]; $name = ${$ra}[2]; push(@arr,[$rtyp,$freq,$name]); } } $max = scalar @arr; for ($i = 0; $i < $max; $i++) { $i2 = $i + 1; $ra = $arr[$i]; $rtyp = ${$ra}[0]; $freq = ${$ra}[1] / 100; $name = ${$ra}[2]; $coms .= "{\"type\":".sprintf("%d",$rtyp).",\"freq\":".sprintf("%.2f",$freq).",\"name\":\"$name\"}"; ##$coms .= "{\"t\":".sprintf("%d",$rtyp).",\"f\":".sprintf("%.2f",$freq).",\"n\":\"$name\"}"; $coms .= ',' if ($i2 < $max); } return $coms; } sub get_coms_list($) { my $ap = shift; my $apt = ${$ap}[3]; # array of AIRPORT items return get_coms_list2($apt); } # output the track in 'xgraph' format # should also consider generating a JSON string to load in a browser # which could have a MAP, just show the track on a map # Airport Line. eg '1 5355 1 0 KABQ Albuquerque Intl Sunport' # 0 1 - this as an airport header line. 16 is a seaplane/floatplane base, 17 a heliport. # 1 5355 - Airport elevation (in feet above MSL). # 2 1 - Airport has a control tower (1=yes, 0=no). # 3 0 - Display X-Plane’s default airport buildings (1=yes, 0=no). # 4 KABQ - Identifying code for the airport (the ICAO code, if one exists). # 5+ Albuquerque Intl Sunport - Airport name. # Navaid line # # lat lon alt freq rng # 0 1 (lat) 2 (lon) 3(alt) 4(feq) 5(rng) 6 7 8++ # 2 38.087769 -077.324919 284 396 25 0.000 APH A P Hill NDB # 3 36.66383333 -121.60319444 80 11730 130 17.0 SNS SALINAS VORTAC # 3 35.67247222 -120.62711111 817 11430 40 16.0 PRB PASO ROBLES VORTAC # 3 34.95236111 -120.52147222 0 11100 25 16.0 GLJ GUADALUPE VOR # 3 34.50952778 -119.77100000 3623 11490 130 14.0 RZS SAN MARCUS VORTAC sub get_navaid_xg($) { my $rna = shift; my $xg = "# navaids VOR/NDB ".scalar @{$rna}."\n"; $xg .= "color gray\n"; my ($az1,$s,$lat1,$lon1,$lat2,$lon2,$az2,$res,$inc); my ($raa,$lat,$lon,$nalt,$nfrq,$nrng); $inc = 10; # A Compass Rose # Outer circle = True North # Inner circle = Magnetic North foreach $raa (@{$rna}) { $lat = ${$raa}[1]; $lon = ${$raa}[2]; $nalt = ${$raa}[3]; $nfrq = ${$raa}[4]; $nrng = ${$raa}[5]; if ($nrng > 0) { $s = $nrng * $NM2KM * 1000; $az1 = 0; $res = fg_geo_direct_wgs_84( $lat, $lon, $az1, $s, \$lat1, \$lon1, \$az2 ); $az1 = 180; $res = fg_geo_direct_wgs_84( $lat, $lon, $az1, $s, \$lat2, \$lon2, \$az2 ); $xg .= "$lon1 $lat1\n"; $xg .= "$lon2 $lat2\n"; $xg .= "NEXT\n"; $az1 = 90; $res = fg_geo_direct_wgs_84( $lat, $lon, $az1, $s, \$lat1, \$lon1, \$az2 ); $az1 = 270; $res = fg_geo_direct_wgs_84( $lat, $lon, $az1, $s, \$lat2, \$lon2, \$az2 ); $xg .= "$lon1 $lat1\n"; $xg .= "$lon2 $lat2\n"; $xg .= "NEXT\n"; # print circle for ($az1 = 0; $az1 <= 360; $az1 += $inc) { $res = fg_geo_direct_wgs_84( $lat, $lon, $az1, $s, \$lat1, \$lon1, \$az2 ); $xg .= "$lon1 $lat1\n"; } $xg .= "NEXT\n"; } } return $xg; } sub get_apt_info($$) { my ($ara,$flg) = @_; my $max = scalar @{$ara}; my ($i,$typ,$ra); my $info = ""; for ($i = 0; $i < $max; $i++) { $ra = ${$ara}[$i]; $typ = ${$ra}[0]; if ($typ == 1) { # 0 1 2 3 4 5+ # 1 elev_ft twr bld icao name if ($flg == 1) { $info = ${$ra}[1].' ft. '.join(' ', splice(@{$ra},5)); # Name } else { $info = join(" ",@{$ra}); } last; } } return $info; } sub fichier_xg() { my $max = scalar @flt_hops; return if ($max == 0); prt("Got $max hops...\n"); my ($icaod,$icaoa); my ($i,$j,$rra,$max2,$lat1,$lon1,$type,$lat2,$lon2,$ra,$icao); my ($max_lat,$max_lon,$min_lat,$min_lon); my ($res,$az1,$az2,$dist,$k); my ($nalt,$nfrq,$nrng,$nid,$nnam,$cnt); my $tot = 0; my $tot_dist = 0; my $tot4leg = 0; $lat1 = 0; $lon1 = 0; $max_lat = -400; $max_lon = -400; $min_lat = 400; $min_lon = 400; my @navaids = (); my %distaz = (); my $wpinfo = ""; my @wpnext = (); for ($i = 0; $i < $max; $i++) { $rra = $flt_hops[$i]; $max2 = scalar @{$rra}; $tot += $max2; my @d = (); my $leg_total = 0; $tot4leg = 0; for ($j = 0; $j < $max2; $j++) { $k = $j + 1; $ra = ${$rra}[$j]; $type = ${$ra}[0]; $lat2 = $lat1; $lon2 = $lon1; $lat1 = ${$ra}[1]; $lon1 = ${$ra}[2]; $max_lat = $lat1 if ($lat1 > $max_lat); $max_lon = $lon1 if ($lon1 > $max_lon); $min_lat = $lat1 if ($lat1 < $min_lat); $min_lon = $lon1 if ($lon1 < $min_lon); if (($type == 2)||($type == 3)) { push(@navaids,$ra); ##prt(join(" ",@{$ra})."\n"); } $wpinfo = "$i:$j: ".join(" ",@{$ra})." "; if ($j) { $res = fg_geo_inverse_wgs_84($lat2, $lon2, $lat1, $lon1, \$az1, \$az2, \$dist); $leg_total += $dist; push(@d,[$dist,$az1,$leg_total]); $tot_dist += $dist; # display $az2 = int(($leg_total / 1000) * $KM2NM); $az1 = int($az1 + 0.5); $dist = int(($dist / 1000) * $KM2NM); $wpinfo .= "$dist nm on $az1 tot $az2 nm "; $wpinfo .= "END " if (($j + 1) == $max2); } else { $wpinfo .= "START "; } if ($k < $max2) { $ra = ${$rra}[$k]; $type = ${$ra}[0]; $lat2 = ${$ra}[1]; $lon2 = ${$ra}[2]; $res = fg_geo_inverse_wgs_84($lat1, $lon1, $lat2, $lon2, \$az1, \$az2, \$dist); $tot4leg += $dist; # display only $az1 = int($az1 + 0.5); $dist = int(($dist / 1000) * $KM2NM); $wpinfo .= ", NXT "; if ($type == 1) { $icao = ${$ra}[3]; $wpinfo .= "APT $icao "; } elsif ($type == 2) { $nalt = ${$ra}[3]; $nfrq = ${$ra}[4]; $nrng = ${$ra}[5]; $nid = ${$ra}[7]; $nnam = join(" ",splice(@{$ra},8)); $wpinfo .= "NDB $nid $nfrq "; } elsif ($type == 3) { $nalt = ${$ra}[3]; $nfrq = ${$ra}[4]; $nrng = ${$ra}[5]; $nid = ${$ra}[7]; $nnam = join(" ",splice(@{$ra},8)); $nfrq /= 100; $wpinfo .= "VOR $nid $nfrq $nalt ft. "; } else { $wpinfo .= "NAV "; } $wpinfo .= "$dist nm, on $az1 "; } $az2 = int(($tot4leg / 1000) * $KM2NM); $wpinfo .= "tot $az2 " if ($j); prt("$wpinfo\n"); prt("\n") if (($j + 1) == $max2); push(@wpnext,$wpinfo); } $distaz{$i} = \@d; } my $xg = "# plan de vol dep ".$depart[1]." to ".$arrivee[1]." in $max hops, $tot legs.\n"; $xg .= "# generated ".lu_get_YYYYMMDD_hhmmss_UTC(time())." UTC by $pgmname\n"; $xg .= "# bbox $min_lon,$min_lat,$max_lon,$max_lat\n"; if ($add_xg_bbox) { $xg .= "color gray\n"; $xg .= "$min_lon $min_lat\n"; $xg .= "$min_lon $max_lat\n"; $xg .= "$max_lon $max_lat\n"; $xg .= "$max_lon $min_lat\n"; $xg .= "$min_lon $min_lat\n"; $xg .= "NEXT\n"; } $xg .= get_navaid_xg(\@navaids) if (@navaids); my %apts = (); $cnt = 0; for ($i = 0; $i < $max; $i++) { $j = $i + 1; $rra = $flt_hops[$i]; $max2 = scalar @{$rra}; $icaod = @{$rra}[0]->[3]; $icaoa = @{$rra}[$max2-1]->[3]; $xg .= "# Hop $j, $max2 legs\n"; $xg .= "color blue\n"; for ($j = 0; $j < $max2; $j++) { $wpinfo = $wpnext[$cnt]; $cnt++; $xg .= "# $wpinfo\n"; $ra = ${$rra}[$j]; $type = ${$ra}[0]; $lat2 = $lat1; $lon2 = $lon1; $lat1 = ${$ra}[1]; $lon1 = ${$ra}[2]; if ($type == 1) { $icao = ${$ra}[3]; if (!defined $apts{$icao}) { $apts{$icao} = 1; if (defined $apt_icao{$icao}) { my $raa = $apt_icao{$icao}; # 0 1 2 3 4 5+ # 1 elev_ft twr bld icao name my $aptinfo = get_apt_info($raa,1); $xg .= "anno $lon1 $lat1 apt $icao $aptinfo\n"; } else { $xg .= "anno $lon1 $lat1 APT $icao\n"; } } } elsif (($type == 2)||($type == 3)) { # 0 1 (lat) 2 (lon) 3(alt) 4(feq) 5(rng) 6 7 8++ # 2 38.087769 -077.324919 284 396 25 0.000 APH A P Hill NDB $nalt = ${$ra}[3]; $nfrq = ${$ra}[4]; $nrng = ${$ra}[5]; $nid = ${$ra}[7]; $nnam = join(" ",splice(@{$ra},8)); if ($type == 2) { $wpinfo = "NDB"; $wpinfo .= " $nfrq $nrng nm $nid $nnam"; } else { $wpinfo = "VOR"; $nfrq /= 100; $wpinfo .= " $nalt ft $nfrq $nrng nm $nid $nnam"; } $xg .= "anno $lon1 $lat1 $wpinfo\n"; } #elsif ($typ == 65){ # $waypointtype = "FIX"; #} #elsif ($typ == 66){ # $waypointtype = "GPS"; #} $xg .= "$lon1 $lat1\n"; } $xg .= "NEXT\n"; } $xg .= "# eof\n"; my $out_fil = $XGFILE; if ($debug_on) { $out_fil = "$FGROOT/Routes/$xml_base.xg"; } rename_2_old_bak($out_fil); # ouverture du fichier if (!open (XG, ">$out_fil")) { prt("Error: Failed to open $out_fil!\n"); return; } print XG $xg; close XG; prt("Written XG file $out_fil\n"); } sub fichier_xg_ORG() { my ($name,$lat,$lon,$lat2,$lon2); my $div = ($km) ? 1 : $NM2KM; # 1.852; my $unit = ($km) ? "km" : "nm"; my $rng = ($km) ? $max_range * $NM2KM : $max_range; # max range without refuel = 696; # nm rename_2_old_bak($XGFILE); # ouverture du fichier if (!open (XG, ">$XGFILE")) { prt("Error: Failed to open $XGFILE!\n"); return; } my @air2air = (); # airport to airport path my @navaids = (); my ($max_lat,$max_lon,$min_lat,$min_lon); my ($waypointtype,$wpinfo,$max,$index,$typ); my ($leg,$heading,$distance,$distance_totale,$dist_cum,$wp_count); my ($raa,$name,$alat,$alon,$icao,$aalt); my ($nalt,$nfrq,$nrng); my $json = "{\"success\":true,\"source\":\"plandevol01.pl\",\"generated\":\"".lu_get_YYYYMMDD_hhmmss_UTC(time())." UTC\",\"waypoints\":[\n"; $distance_totale = 0; $dist_cum = 0; $wp_count = 0; $max_lat = -400; $max_lon = -400; $min_lat = 400; $min_lon = 400; # on écrit le contenu du fichier $max = scalar @route; print XG "# plan de vol dep ".$depart[1]." to ".$arrivee[1]." in $max legs\n"; $lat = 0; $lon = 0; for ($index = 0; $index < $max; $index++) { $typ = $route[$index]->[0]; if (($typ == 2)||($typ == 3)) { push(@navaids,$route[$index]); } } if (@navaids) { print XG "# navaids VOR/NDB ".scalar @navaids."\n"; print XG "color gray\n"; my ($az1,$s,$lat1,$lon1,$lat2,$lon2,$az2,$res,$inc); $inc = 10; # A Compass Rose # Outer circle = True North # Inner circle = Magnetic North foreach $raa (@navaids) { $lat = ${$raa}[1]; $lon = ${$raa}[2]; $nalt = ${$raa}[3]; $nfrq = ${$raa}[4]; $nrng = ${$raa}[5]; if ($nrng > 0) { $s = $nrng * $NM2KM * 1000; $az1 = 0; $res = fg_geo_direct_wgs_84( $lat, $lon, $az1, $s, \$lat1, \$lon1, \$az2 ); $az1 = 180; $res = fg_geo_direct_wgs_84( $lat, $lon, $az1, $s, \$lat2, \$lon2, \$az2 ); print XG "$lon1 $lat1\n"; print XG "$lon2 $lat2\n"; print XG "NEXT\n"; $az1 = 90; $res = fg_geo_direct_wgs_84( $lat, $lon, $az1, $s, \$lat1, \$lon1, \$az2 ); $az1 = 270; $res = fg_geo_direct_wgs_84( $lat, $lon, $az1, $s, \$lat2, \$lon2, \$az2 ); print XG "$lon1 $lat1\n"; print XG "$lon2 $lat2\n"; print XG "NEXT\n"; # print circle for ($az1 = 0; $az1 <= 360; $az1 += $inc) { $res = fg_geo_direct_wgs_84( $lat, $lon, $az1, $s, \$lat1, \$lon1, \$az2 ); print XG "$lon1 $lat1\n"; } print XG "NEXT\n"; } } } print XG "color yellow\n"; for ($index = 0; $index < $max; $index++) { $typ = $route[$index]->[0]; $lat = $route[$index]->[1]; $lon = $route[$index]->[2]; if ($index > 0) { ###$leg = [@{$route[$index-1]}[1],@{$route[$index-1]}[2],@{$route[$index]}[1],@{$route[$index]}[2]]; $leg = [$lat2,$lon2,$lat,$lon]; $heading = round (llll2dir_ ($leg)); $distance = distance_ ($leg) / $div; # check for a re-fueling stop - if next beyond range, and NOT last waypoint if ((($dist_cum + $distance) > $rng) && (!($index == ($max - 1)))) { # time to insert an airport for refueling my $ap = get_airport($leg); if ($ap) { # final point of this leg is this airport $raa = ${$ap}[0]; $aalt = ${$raa}[1]; $icao = ${$raa}[4]; $name = join(' ', splice(@{$raa},5)); # Name $alat = ${$ap}[1]; $alon = ${$ap}[2]; $leg = [$lat2,$lon2,$alat,$alon]; $heading = round (llll2dir_ ($leg)); $distance = distance_ ($leg) / $div; $distance_totale += $distance; print XG "$alon $alat\n"; $json .= "{\"lat\":".sprintf("%.8f",$alat).",\"lon\":".sprintf("%.8f",$alon); $json .= ",\"alt\":".sprintf("%d",$aalt); $json .= ",\"icao\":\"$icao\""; $json .=",\"name\":\"$name\",\"type\":\"APT\",\n"; # ,\"info\":\"".join(" ",@{$raa})."\",\n"; $json .= "\"runways\":[".get_rw_list($ap)."],\n"; $json .= "\"coms\":[".get_coms_list($ap)."]"; push(@air2air,${$ap}[3]); # array of airport items # TODO Add any ILS for this airport $json .= "},\n"; $wp_count++; print XG "NEXT\n"; print XG "# re-fuel at airport $name\n"; print XG "anno $alon $alat APT: ".join(" ",@{$raa})." h=$heading d=$distance $unit\n"; print XG "$alon $alat\n"; # start next leg $leg = [$alat,$alon,$lat,$lon]; $heading = round (llll2dir_ ($leg)); $distance = distance_ ($leg) / $div; } $dist_cum = 0; } $dist_cum += $distance; $distance_totale += $distance; # for display only $distance = round ($distance); } else { $heading = ''; $distance = ''; } # next waypoint $name = $route[$index]->[6 + $version].' '.$route[$index]->[7 + $version]; $waypointtype = "APT"; $wpinfo = "none"; if ($typ == 2) { $nalt = $route[$index]->[3]; $nfrq = $route[$index]->[4]; $nrng = $route[$index]->[5]; $wpinfo = "a=$nalt f=$nfrq r=$nrng"; $waypointtype = "NDB"; } elsif ($typ == 3) { $nalt = $route[$index]->[3]; $nfrq = $route[$index]->[4]; $nrng = $route[$index]->[5]; $wpinfo = "a=$nalt f=$nfrq r=$nrng"; $waypointtype = "VOR"; } elsif ($typ == 65){ $waypointtype = "FIX"; } elsif ($typ == 66){ $waypointtype = "GPS"; } if (length($heading)) { $wpinfo .= " b=$heading d=$distance $unit."; } if ($index == 0) { $wpinfo .= " BEGIN OF ROUTE"; } if ($index == ($max - 1)) { $wpinfo .= " END OF ROUTE"; } printf XG "anno %f %f %s\n", $lon, $lat, "$name $waypointtype $wpinfo"; printf XG "%f %f\n", $lon, $lat; # get bounding box $max_lat = $lat if ($lat > $max_lat); $max_lon = $lon if ($lon > $max_lon); $min_lat = $lat if ($lat < $min_lat); $min_lon = $lon if ($lon < $min_lon); $json .= "{\"lat\":".sprintf("%.8f",$lat).",\"lon\":".sprintf("%.8f",$lon).",\"name\":\"$name\",\"type\":\"$waypointtype\",\"info\":\"$wpinfo\""; if ($waypointtype eq "APT") { #add runways and coms, and ils if any $raa = $route[$index]->[4]; $aalt = ${$raa}[0][1]; $icao = ${$raa}[0][4]; $json .= ",\"alt\":".sprintf("%d",$aalt); $json .= ",\"icao\":\"$icao\""; $json .= ",\n\"runways\":[".get_rw_list2($raa)."],\n"; $json .= "\"coms\":[".get_coms_list2($raa)."]"; push(@air2air,$raa); # TODO Add any ILS for this airport } elsif (($typ == 2)||($typ == 3)) { # would be nice to add FREQUENT ALTITUDE RANGE to json # 0 1 (lat) 2 (lon) 3(alt) 4(feq) 5(rng) 6 7 8++ # 2 38.087769 -077.324919 284 396 25 0.000 APH A P Hill NDB # 3 57.103719 009.995578 57 11670 100 1.000 AAL Aalborg VORTAC $nalt = $route[$index]->[3]; $nfrq = $route[$index]->[4]; $nrng = $route[$index]->[5]; if ($typ == 3) { $nfrq = sprintf("%.2f",$nfrq); } else { $nfrq = sprintf("%d",$nfrq); } $json .= ",\"alt_ft\":".sprintf("%d",$nalt).",\"freq\":$nfrq,\"rng_nm\":".sprintf("%d", int($nrng)); } $json .= "},\n"; $wp_count++; $lat2 = $lat; $lon2 = $lon; } print XG "NEXT\n"; print XG "# bbox=$min_lon,$min_lat,$max_lon,$max_lat\n"; print XG "# route dist ".round($distance_totale)." $unit.\n"; # add an airport to airport track if (@air2air) { print XG "color red\n"; foreach $raa (@air2air) { ($alat,$alon) = get_apt_pos($raa); print XG "$alon $alat\n"; } print XG "NEXT\n"; } # on ferme le fichier close (XG); prt("# bbox=$min_lon,$min_lat,$max_lon,$max_lat\n"); prt("XG output written to $XGFILE.\n"); my $jfile = $XGFILE.".json"; if (open(XG,">$jfile")) { if ($wp_count) { $json =~ s/,\n$/\n/g; } $json .= "],\"count\":$wp_count}\n"; print XG $json; close XG; prt("JSON output written to $jfile.\n"); } } my %airport_icao = (); sub get_apt_pos($) { my $ara = shift; my $max = scalar @{$ara}; my ($i,$typ,$ra); my $lat = 0; my $lon = 0; my $cnt = 0; for ($i = 0; $i < $max; $i++) { $ra = ${$ara}[$i]; $typ = ${$ra}[0]; if ($typ == 10) { $lat += ${$ra}[1]; $lon += ${$ra}[2]; $cnt++; } } if ($cnt > 0) { $lat /= $cnt; $lon /= $cnt; } return ($lat,$lon); } sub find_leg_ap($$$$) { my ($leg,$pos,$rap,$fudge) = @_; my ($lat1,$lon1,$lat2,$lon2,$lat,$lon); my ($i,$max,$ra,$typ,$icao,$ind,$fnd); $lat1 = ${$leg}[0]; $lon1 = ${$leg}[1]; $lat2 = ${$leg}[2]; $lon2 = ${$leg}[3]; if ($lat1 > $lat2) { $lat = $lat1; $lat1 = $lat2; $lat2 = $lat; } if ($lon1 > $lon2) { $lon = $lon1; $lon1 = $lon2; $lon2 = $lon; } $lat1 -= $fudge; $lat1 += 180 if ($lat1 < -180); $lat1 -= 180 if ($lat1 > 180); $lat2 += $fudge; $lat2 -= 180 if ($lat2 > 180); $lat2 += 180 if ($lat2 < -180); $lon1 -= $fudge; $lon1 += 360 if ($lon1 < -180); $lon1 -= 360 if ($lon1 > 180); $lon2 += $fudge; $lon2 += 360 if ($lon2 < -180); $lon2 -= 360 if ($lon2 > 180); #$lat = ($lat1 + $lat2) / 2; #$lon = ($lon1 + $lon2) / 2; $max = scalar @all_airports; # load ALL airports my @apts = (); for ($i = 0; $ i < $max; $i++) { $ra = $all_airports[$i]; $typ = ${$ra}[0]; if ($typ == 1) { # 0 1 2 3 4 5+ # # elev_ft twr bld icao name my @apt = (); $fnd = 0; $ind = $i; $icao = ${$ra}[4]; # set icao next if (defined $airport_icao{$icao}); push(@apt,$ra); $i++; for (; $i < $max; $i++) { $ra = $all_airports[$i]; $typ = ${$ra}[0]; if ($typ == 1) { $i--; last; } push(@apt,$ra); if ($typ == 10) { # 0 1 2 3 4 5 #push(@a,[10, $rlat, $rlon, $rwynm, $az1, $dist, 0.0, 0.0, 75, 161161, 1, 0, 0, 0.25, 0, 0]); $lat = ${$ra}[1]; $lon = ${$ra}[2]; if (($lat >= $lat1)&& ($lat <= $lat2)&& ($lon >= $lon1)&& ($lon <= $lon2)) { $fnd++; } } } if ($fnd > 0) { $typ = scalar @apt; ### prt("Adding ref to $typ apt components ($fnd)\n"); push(@apts,\@apt); } } } $max = scalar @apts; prt("Found $max airports in box $lat1,$lon1,$lat2,$lon2, fudge=$fudge ") if (VERB9()); if ($max > 0) { $ind = 0; if ($max > 1) { # TODO: Select the ONE closest the TRACK, or ON some other criteria # maybe closest to this point $lat = ${$pos}[0]; $lon = ${$pos}[1]; my ($az1,$az2,$s,$dist); for ($i = 0; $i < $max; $i++) { $ra = $apts[$i]; my ($alat,$alon) = get_apt_pos($ra); my $res = fg_geo_inverse_wgs_84($lat, $lon, $alat, $alon, \$az1, \$az2, \$s); if ($i == 0) { $dist = $s; $ind = $i; } elsif ($s < $dist) { $dist = $s; $ind = $i; } } } # push(@{$rap},$apts[0]); $ra = $apts[$ind]; ${$rap} = $ra; $icao = ${$ra}[4]; # get icao # $apt_icao{$icao} = $ra; prt("$ind $icao") if (VERB9()); } prt("\n") if (VERB9()); return $max; } # ################################################################################# # Like the XG output, repect the short range of small plane, probably a VFR flight. # sub get_wp_set() { my ($lat1,$lon1,$lat2,$lon2); my ($az1,$az2,$dist,$total,$res); my ($i,$j,$max,$max2,$type,$alt,$rra,$nm,$tmp,$ap,$leg,$lat,$lon); my $range = $max_range * 0.9; # keep 10% spare my @bearings = (); my @route3 = (); # can NOT find these airport - ends excluded my $icaod = $depart[1]; my $icaoa = $arrivee[1]; # $extremite->[2], $extremite->[3], $extremite->[4] $apt_icao{$icaod} = $depart[4]; $apt_icao{$icaoa} = $arrivee[4]; $airport_icao{$icaod} = 1; $airport_icao{$icaoa} = 1; $xml_base = $icaod.'-'.$icaoa.'-'.$aircraft; # base file name ##prt(Dumper(\@flt_plan)); ##$load_log = 1; ##pgm_exit(1,"TEMP EXIT"); ##$max = scalar @route; $max = scalar @flt_plan; if ($max < 2) { prt("Error: Insufficent route points!\n"); return; } $max -= 1; # exclude last point $total = 0; ##$rra = $route[0]; $rra = $flt_plan[0]; $lat1 = ${$rra}[1]; $lon1 = ${$rra}[2]; ###push(@route2,$rra); # add first ###push(@route3,$flt_plan[0]); # start apt [1, icao, lat, lon] push(@route3,$rra); # start apt [1,lat,lon,icao] for ($i = 1; $i < $max; $i++) { $lat2 = $lat1; $lon2 = $lon1; ###$rra = $route[$i]; $rra = $flt_plan[$i]; $type = ${$rra}[0]; $lat1 = ${$rra}[1]; $lon1 = ${$rra}[2]; $alt = $def_altitude; $res = fg_geo_inverse_wgs_84($lat2, $lon2, $lat1, $lon1, \$az1, \$az2, \$dist); $nm = (($total + $dist) / 1000) * $KM2NM; ### if (($nm > $range) && (($i + 1) < $max)) { if ($nm > $range) { # need to find an airport on this leg my $s = ($range - (($total / 1000) * $KM2NM)) * $NM2KM * 1000; $res = fg_geo_direct_wgs_84( $lat2, $lon2, $az1, $s, \$lat, \$lon, \$az2 ); my $pos = [$lat,$lon]; $leg = [$lat2,$lon2,$lat1,$lon1]; $nm = round(($s / 1000) * $KM2NM); $az1 = round($az1); prt("leg: $lat2,$lon2,$lat1,$lon1 pos: $lat,$lon s $nm nm on $az1\n") if (VERB9()); my $fudge = -0.5; while (!find_leg_ap($leg,$pos,\$ap,$fudge)) { $fudge += 0.1; } ($lat,$lon) = get_apt_pos($ap); $res = fg_geo_inverse_wgs_84($lat2, $lon2, $lat, $lon, \$az1, \$az2, \$dist); push(@bearings, round($az1)); $nm = round((($total + $dist) / 1000) * $KM2NM); my $icao = @{$ap}[0]->[4]; $apt_icao{$icao} = $ap; ##push(@route2,$ap); # add last push(@route3,[1,$lat,$lon,$icao]); # last airport my @a = @route3; push(@flt_hops,\@a); ##@route2 = (); @route3 = (); ##push(@route2,$ap); # add first push(@route3,[1,$lat,$lon,$icao]); # first airport prt("Refuel at airport $icao, $nm nm, $lat,$lon\n"); $res = fg_geo_inverse_wgs_84($lat, $lon, $lat1, $lon1, \$az1, \$az2, \$dist); $total = 0; $nm = round(($dist / 1000) * $KM2NM); $az1 = round($az1); prt("Continue to next wp $lat1,$lon1, $nm nm on $az1\n"); } ##push(@route2,$rra); # add next push(@route3,$rra); # add next $total += $dist; push(@bearings, round($az1)); } push(@route3,$flt_plan[$max]); # end apt [1,lat,lon,icao] push(@flt_hops,\@route3); $max = scalar @flt_hops; prt("Got $max hops...\n"); } sub target_example_xml() { my $txt = <<EOF; <?xml version="1.0"?> <PropertyList> <version type="int">2</version> <departure> <airport type="string">YPPH</airport> <runway type="string">24</runway> </departure> <destination> <airport type="string">YSSY</airport> </destination> <route> <wp> <type type="string">runway</type> <departure type="bool">true</departure> <ident type="string">24</ident> <icao type="string">YPPH</icao> </wp> <wp n="1"> <type type="string">navaid</type> <alt-restrict type="string">at</alt-restrict> <altitude-ft type="double">5000</altitude-ft> <ident type="string">BIU</ident> <lon type="double">116.769469</lon> <lat type="double">-30.591642</lat> </wp> <!-- if just lat.lon given --> <wp n="4"> <type type="string">basic</type> <ident type="string">W030N121</ident> <lon type="double">-30.789722</lon> <lat type="double">121.452778</lat> </wp> <!-- continue with waypoints --> <wp n="nn"> <type type="string">navaid</type> <approach type="bool">true</approach> <ident type="string">YSSY</ident> <lon type="double">151.1813468</lon> <lat type="double">-33.949273</lat> </wp> </route> </PropertyList> EOF return $txt; } sub out_wp_set() { my ($max,$i,$j,$rra,$max2,$icaod,$icaoa); my ($type,$lat1,$lon1,$alt); $max = scalar @flt_hops; prt("Got $max hops..."); if ($max < 2) { prt(" no 'set' to generate...\n"); return; } else { prt(" generating set with base $xml_base name...\n"); } my ($xml_file,$xml,$id); for ($i = 0; $i < $max; $i++) { $j = $i + 1; $rra = $flt_hops[$i]; $max2 = scalar @{$rra}; $icaod = @{$rra}[0]->[3]; $icaoa = @{$rra}[$max2-1]->[3]; $xml_file = $xml_base."-$j-$icaod-$icaoa.xml"; prt("hop $j: $max2 legs $xml_file\n"); $xml = "<?xml version=\"1.0\"?>\n"; $xml .= "<PropertyList>\n"; $xml .= " <version type=\"int\">2</version>\n"; $xml .= " <departure>\n"; $xml .= " <airport type=\"string\">".$icaod."</airport>\n"; # if we knew the runway add " <runway type="string">24</runway>" $xml .= " </departure>\n"; $xml .= " <destination>\n"; $xml .= " <airport type=\"string\">".$icaoa."</airport>\n"; $xml .= " </destination>\n"; $xml .= " <route>\n"; for ($j = 0; $j < $max2; $j++) { my $ra = ${$rra}[$j]; $type = ${$ra}[0]; $lat1 = ${$ra}[1]; $lon1 = ${$ra}[2]; prt(join(" ",@{$ra})."\n") if (VERB9()); if ($j == 0) { $xml .= " <wp>\n"; } else { $xml .= sprintf(" <wp n=\"%d\">\n", $j); } if ($j == 0) { $xml .= " <type type=\"string\">basic</type>\n"; $xml .= " <departure type=\"bool\">true</departure>\n"; $xml .= sprintf(" <lon type=\"double\">%f</lon>\n", $lon1); $xml .= sprintf(" <lat type=\"double\">%f</lat>\n", $lat1); $xml .= " <icao type=\"string\">".$icaod."</icao>\n"; } elsif (($j +1) == $max2) { $xml .= " <type type=\"string\">basic</type>\n"; $xml .= " <approach type=\"bool\">true</approach>\n"; $xml .= " <ident type=\"string\">".$icaoa."</ident>\n"; $xml .= sprintf(" <lon type=\"double\">%f</lon>\n", $lon1); $xml .= sprintf(" <lat type=\"double\">%f</lat>\n", $lat1); } else { $id = ${$ra}[6 + $version]; $xml .= " <type type=\"string\">navaid</type>\n"; $xml .= " <ident type=\"string\">$id</ident>\n"; $xml .= sprintf(" <lat type=\"double\">%f</lat>\n", $lat1); $xml .= sprintf(" <lon type=\"double\">%f</lon>\n", $lon1); if (($type == 2)||($type == 3)) { $alt = $def_altitude; $alt += (int((${$ra}[3] + 500) / 1000)) * 1000; $xml .= " <alt-restrict type=\"string\">at</alt-restrict>\n"; $xml .= sprintf(" <altitude-ft type=\"double\">%d</altitude-ft>\n", $alt); } } $xml .= " </wp>\n"; } $xml .= " </route>\n"; $xml .= "</PropertyList>\n"; my $out_fil = "$FGROOT/Routes/$xml_file"; rename_2_old_bak($out_fil); write2file($xml,$out_fil); prt("Written XML to $out_fil\n"); #prt(Dumper($rra)); } ##$load_log = 1; } sub fichier_wp() { my ($lat1,$lon1,$lat2,$lon2); my ($az1,$az2,$dist,$total,$res); my ($i,$max,$type,$alt); my $range = $max_range * 0.9; # keep 10% my @bearings = (); $max = scalar @route; if ($max < 2) { prt("Error: Insufficent route points!\n"); return; } $max -= 1; # exclude last point $total = 0; $WPFILE = $depart[1]."-".$arrivee[1]."-".$aircraft; if (! -d "$FGROOT/Routes") { prt("Error: Directory $FGROOT/Routes does NOT exist! Create it first...\n"); return; } my $out_fil = "$FGROOT/Routes/$WPFILE.xml"; rename_2_old_bak($out_fil); # ouverture du fichier if (!open (WP, ">$out_fil")) { prt("Error: Failed to open '$out_fil'!\n"); return; } printf WP "<?xml version=\"1.0\"?>\n"; print WP "<PropertyList>\n"; print WP " <version type=\"int\">2</version>\n"; print WP " <departure>\n"; print WP " <airport type=\"string\">".$depart[1]."</airport>\n"; # if we knew the runway add " <runway type="string">24</runway>" print WP " </departure>\n"; print WP " <destination>\n"; print WP " <airport type=\"string\">".$arrivee[1]."</airport>\n"; print WP " </destination>\n"; print WP " <route>\n"; # the first wp should be the departure runway # <wp> # <type type="string">runway</type> # <departure type="bool">true</departure> # <ident type="string">24</ident> # <icao type="string">YPPH</icao> # </wp> # try just a basic departure point $lat1 = $route[0]->[1]; $lon1 = $route[0]->[2]; print WP " <wp>\n"; print WP " <type type=\"string\">basic</type>\n"; print WP " <departure type=\"bool\">true</departure>\n"; printf WP " <lon type=\"double\">%f</lon>\n", $lon1; printf WP " <lat type=\"double\">%f</lat>\n", $lat1; print WP " <icao type=\"string\">".$depart[1]."</icao>\n"; print WP " </wp>\n"; my $template = <<EOF; <type type="string">navaid</type> <ident type="string">%s</ident> <lat type="double">%f</lat> <lon type="double">%f</lon> EOF # 0 1 (lat) 2 (lon) 3(alt) 4(feq) 5(rng) 6 7 8++ # 2 38.087769 -077.324919 284 396 25 0.000 APH A P Hill NDB for ($i = 1; $i < $max; $i++) { $lat2 = $lat1; $lon2 = $lon1; $type = $route[$i]->[0]; $lat1 = $route[$i]->[1]; $lon1 = $route[$i]->[2]; $alt = $def_altitude; $res = fg_geo_inverse_wgs_84($lat2, $lon2, $lat1, $lon1, \$az1, \$az2, \$dist); $total += $dist; push(@bearings, round($az1)); # output to file $alt += (int(($route[$i]->[3] + 500) / 1000)) * 1000; printf WP " <wp n=\"%d\">\n", $i; printf WP $template, $route[$i]->[6 + $version], $lat1, $lon1; if (($type == 2)||($type == 3)) { print WP " <alt-restrict type=\"string\">at</alt-restrict>\n"; printf WP " <altitude-ft type=\"double\">%d</altitude-ft>\n", $alt; } print WP " </wp>\n"; } # destination point $lat2 = $lat1; $lon2 = $lon1; $lat1 = $route[$i]->[1]; $lon1 = $route[$i]->[2]; $res = fg_geo_inverse_wgs_84($lat2, $lon2, $lat1, $lon1, \$az1, \$az2, \$dist); $total += $dist; push(@bearings, round($az1)); printf WP " <wp n=\"%d\">\n", $i; print WP " <type type=\"string\">basic</type>\n"; print WP " <approach type=\"bool\">true</approach>\n"; print WP " <ident type=\"string\">".$arrivee[1]."</ident>\n"; printf WP " <lon type=\"double\">%f</lon>\n", $lon1; printf WP " <lat type=\"double\">%f</lat>\n", $lat1; print WP " </wp>\n"; print WP " </route>\n"; print WP "</PropertyList>\n"; # fermeture du fichier close (WP); prt("File $out_fil written...\n"); ############################################################# $lat1 = $route[0]->[1]; $lon1 = $route[0]->[2]; $lat2 = $route[$max]->[1]; $lon2 = $route[$max]->[2]; $res = fg_geo_inverse_wgs_84($lat1, $lon1, $lat2, $lon2, \$az1, \$az2, \$dist); $dist = round(($dist / 1000) * $KM2NM); $az1 = round($az1); prt("Direct $dist nm on $az1 "); $dist = round(($total / 1000) * $KM2NM); prt("Route $dist nm, on ".join(" ",@bearings)."\n"); out_wp_set() if ($dist > $range); } sub fichier_wp_XML () { $WPFILE = $depart[1]."-".$arrivee[1].".xml"; my $WPFILE_test = $WPFILE; my $count = 1; if (! -d "$FGROOT/Routes") { prt("Error: Directory $FGROOT/Routes does NOT exist! Create it first...\n"); } rename_2_old_bak("$FGROOT/Routes/$WPFILE_test"); while ( -e "$FGROOT/Routes/$WPFILE_test" ) { $WPFILE_test = $WPFILE; $WPFILE_test .= $count; $WPFILE_test .= ".xml"; $count++; } $WPFILE = $WPFILE_test; # ouverture du fichier if (!open (WP, ">$FGROOT/Routes/$WPFILE.xml")) { prt("Error: Failed to open $FGROOT/Routes/$WPFILE.xml!\n"); return; } my $template = <<EOT; <Waypoint n="%s"> <ID type="string">%s</ID> <name type="string">%s</name> <latitude-deg type="double">%s</latitude-deg> <longitude-deg type="double">%s</longitude-deg> <altitude-ft type="double">0</altitude-ft> <waypoint-type type="string">%s</waypoint-type> <desc type="string">%s</desc> </Waypoint>\n EOT print WP "<PropertyList>\n"; # on écrit le contenu for (my $index = 1; $index < @route; $index++) { my $waypointtype = "APT"; my $wpinfo = "none"; if ($route[$index]->[0] == 2) { $wpinfo = "FREQ: ".$route[$index]->[4]; $waypointtype = "NDB"; } elsif ($route[$index]->[0] == 3) { $wpinfo = "FREQ: ".$route[$index]->[4]; $waypointtype = "VOR"; } elsif ($route[$index]->[0] == 65){ $waypointtype = "FIX"; } elsif ($route[$index]->[0] == 66){ $waypointtype = "GPS"; } if ($index == @route - 1) { $wpinfo .= " END OF ROUTE"; } printf WP $template, $index - 1, $route[$index]->[6 + $version], $route[$index]->[7 + $version], $route[$index]->[1], $route[$index]->[2], $waypointtype, $wpinfo; } print WP "</PropertyList>\n"; # fermeture du fichier close (WP); prt("File $FGROOT/Routes/$WPFILE written.\n"); } sub sortie_standard () { # cette procédure est de la bouillie pour les chats et pour les chiens! my $div = ($km) ? 1 : $NM2KM; # 1.852; my ($leg, $distance, $distance_totale, $heading); my ($localizer, $piste, $index); my ($lat1,$lat2,$lon1,$lon2,$az1,$az2,$s,$res); $sous_fonction = sub { print "\033[30;1m" if $add_couleur; prt("$_[0]\n"); print "\033[m" if $add_couleur; }; if ($com_dep) { &$sous_fonction ("\nFréquences utiles pour le départ"); foreach (@{$depart[4]}) { prt(sprintf("$_->[@{$_}-1]: %s\n", $_->[1]/100)) if ($_->[0] >= 50 && $_->[0] <= 59 && $_->[@{$_}-1] ne 'APP'); } } prt( "procédure SID : $depart[0]\n" ) if ($depart[0]); prt( "procédure STAR : $arrivee[0]\n" ) if $arrivee[0]; &$sous_fonction ("\nCode - Nom complet"); prt(sprintf( "\t| Frequences | Heading | Course/RNW | Distance en %s\n", ($km)? 'km':'nm')); &$sous_fonction ("$depart[4]->[0]->[4] - $depart[4]->[0]->[5]"); if ($depart[0]) { # prt( "procédure SID : $depart[0]\n" ); } else { $index = 0; $lat1 = @{$route[$index]}[1]; $lon1 = @{$route[$index]}[2]; $lat2 = @{$route[$index+1]}[1]; $lon2 = @{$route[$index+1]}[2]; if ($use_sg_math) { $res = fg_geo_inverse_wgs_84($lat1, $lon1, $lat2, $lon2, \$az1, \$az2, \$s); $heading = round($az1); $distance = round($s / 1000 / $div); } else { $leg = [$lat1,$lon1,$lat2,$lon2]; $heading = round (llll2dir_ ($leg)); $distance = distance_ ($leg) / $div; } $distance = round ($distance); if (@{$route[$index]}[0] == 1) { # aéroport de d'depart if ($depart[0] =~ /\[RW(...)\s*/) { $piste = $1; $localizer = "RW $piste"; foreach (@{$depart[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 (@{$depart[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)); } } } } } prt(sprintf("%s", ($depart[0] =~ /\RW(...)\s+/) ? "décollage piste $1\n" : '')); for ($index = 1; $index < @route; $index++) { $lat1 = @{$route[$index-1]}[1]; $lon1 = @{$route[$index-1]}[2]; $lat2 = @{$route[$index]}[1]; $lon2 = @{$route[$index]}[2]; if ($use_sg_math) { $res = fg_geo_inverse_wgs_84($lat1, $lon1, $lat2, $lon2, \$az1, \$az2, \$s); $heading = round($az1); $distance = round($s / 1000 / $div); } else { # $leg = [@{$route[$index-1]}[1],@{$route[$index-1]}[2],@{$route[$index]}[1],@{$route[$index]}[2]]; $leg = [$lat1,$lon1,$lat2,$lon2]; $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 )); &$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); 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]"); last ETAPE; } if (@{$route[$index]}[0] == 65) { # étape fix prt(sprintf( "\t| FIX | %-6s | -- | $distance\n", $heading)); &$sous_fonction ("@{$route[$index]}[6 + $version]"); 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 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]"); last ETAPE; } } } $leg = [$depart[2], $depart[3], $arrivee[2], $arrivee[3]]; prt(sprintf( "\ndistance totale parcourue: %s %s (vol direct: %s)\n\n", round ($distance_totale), ($km)? 'km':'nm', round (distance_ ($leg) / $div))); if ($com_app) { &$sous_fonction ("Fréquences utiles pour l'approche"); foreach (@{$arrivee[4]}) { prt(sprintf ("$_->[@{$_}-1]: %s\n", $_->[1]/100)) if ($_->[0] >= 50 && $_->[0] <= 59 && $_->[@{$_}-1] ne 'DEP'); } prt("\n"); } } sub get_stdin($) { my ($rc) = shift; ${$rc} = <STDIN>; } sub wait_key_input($) { my ($msg) = shift; if (length($msg)) { prt($msg); } my $char = ''; get_stdin(\$char); if ($char =~ /^y/i) { return 1; } return 0; } ####################### # FONCTION PRINCIPALE # ####################### sub main () { # exit 1; # si aucune option n'est demandée ou si l'option -h est appelée, on affiche l'aide et on quitte my $noicao = ((length($depart[1]) == 0) || (length($arrivee[1]) == 0)) ? 1 : 0; my $nofgroot = (-d $FGROOT) ? 0 : 1; my ($tmp); if ($noicao || $nofgroot || !$options || $help || $nofgroot) { prt( $texte_aide ); prt("Error: No departure or arrival!\n") if ($noicao); prt("Error: Can NOT 'stat' FG_ROOT $FGROOT!\n") if ($nofgroot); exit 1; } if ($wpt ) { if (! -d "$FGROOT/Routes") { prt("Error: Directory $FGROOT/Routes does NOT exist! Create it first...\n"); exit 1; } } if ($com) { $com_dep = 1; $com_app = 1; } if ($debug_on) { $XGFILE = $out_xg if (!$XGFILE); $wpt = 1; #$CSVFILE = $out_csv if (!$CSVFILE); #$verbosity = 2 if (!VERB2()); #$com_dep = 1; #$com_app = 1; $no_stdout = 1; ##$vor_preferes = 1; $verbosity = 9; } if ($debug_on) { $tmp = "$FGROOT/Routes"; if (! -d $tmp) { prt("Error: Output directory '$tmp' does NOT exist!\n"); prt("Create this directory first...\n"); exit 1; } } prt("Plan de vol d=".$depart[1]." to a=".$arrivee[1]."...\n"); prt("Options: "); prt("Out xg $XGFILE ") if ($XGFILE); ###prt("Out wpt file, ") if ($wpt); if ($no_stdout) { prt("no stdout, "); } else { prt("Out stdout, "); } prt("vor preferred, ") if ($vor_preferes); prt("Verb $verbosity, "); prt("\n"); prt("aircraft $aircraft, speed $cruise_speed kn, max-range $max_range nm, def-alt $def_altitude ft.\n"); #if ($wpt ) { prt("wpt out: $FGROOT/Routes/$depart[1]-$arrivee[1]-$aircraft.xml\n"); #} if (!wait_key_input("Enter 'y'+ENTER to continue : ")) { prt("Did NOT get a 'y'! Aborting...\n"); exit 1 } load_nav_data(); # load ALL navaids load_airports(); ###pgm_exit(1,"TEMP EXIT"); # si le départ et l'arrivée ont été trouvés on commence la construction # du plan de vol, sinon on affiche un message d'erreur. (configure_extremite (\@depart, \$sid, \$sidx ) && configure_extremite (\@arrivee,\$star,\$starx)) ? plan_de_vol : prt(sprintf($erreur)); get_wp_set(); # sets $xml_base with "ICAO1-ICAO2" # redirection du résultat selon les choix sortie_standard if (!$no_stdout ); fichier_csv if ($CSVFILE ); fichier_wp if ($wpt ); fichier_xg if ($XGFILE ); pgm_exit(0,""); } main; # eof