#!/usr/bin/perl # 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 ... # 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 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 Env qw(HOME FGROOT FGHOME); # pour lire HOME FGHOME et FGROOT ## DECLARATION DES VARIABLES GLOBALES ##################################### my @depart = (undef, "LFPG", 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, "LFBD", 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) my $fgfs; # socket de connexion à fgfs my @route; # contient la route à suivre 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 $quiet = 1; # extra output # VARIABLES DES OPTIONS DU SCRIPT ################################# my $FGROOT = (exists $ENV{FGROOT})? $FGROOT : "F:\\fgdata"; my $FGHOME = (exists $ENV{FGHOME})? $FGHOME : "$HOME/.fgfs"; my $vor_a_vor; # exclusivement du vor my $vor_preferes; # si on veut du vor, mais sinon du ndb my $deviation_max = 30; # virage maximal my $dist_min = 10; # distance minimale entre deux waypoints 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, $com_dep, $com_app); # pour afficher les fréqences de communication my $INSTRFILE; # création d'un fichier .xml 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 $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" => \$wpt, "instr" => \$INSTRFILE, "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" => \$com, "com-dep" => \$com_dep, "com-app" => \$com_app, "ansi" => \$add_couleur); ($com_dep, $com_app) = ($com, $com) if $com; ## 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 ## DÉCLARÉ COMME VARIABLE MAIS UTILISÉ COMME CONSTANTE ###################################################### my $texte_aide = <] [--wpt] [--csv ] [--csv-conf ] [--xg ] [-d | --dep ] [-a | --arr ] [--dev-max ] [--dist-min ] [--sid ][--star ] [--sidx][--starx] [--com-dep][--com-app][--com] [--ansi] [--help] -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 : chemin contenant les fichiers de FlightGear défaut: $FGROOT --wpt : enregistre la route dans \$FGROOT/Routes (nommage auto) directory must exist. It will not be created. --csv : fichier CSV ( séparateur = : , virgule décimale = , ) pour affichage du trajet en graphique (via oocalc par exemple) --xg : fichier XG. Can be viewed by polyView2D. See https://sites.google.com/site/polyview2d/ --csv-conf : 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_conf -d | --dep : point de départ. il est possible de spécifier: - soit le code oaci de l'aéroport (ex: --dep=lfqq), défaut --dep=lfpt --arr=lfbd - 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]) -a | --arr : point d'arrivée. même possibilités que l'option --dep --dev-max : déviation maximale d'une balise à une autre par rapport au trajet en cours (défaut: $deviation_max°) --dist-min : distance minimale entre deux balises (défaut: $dist_min km) --sid --star : cherche le trajet en tenant compte de la procédure sid (ou star) 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 : affiche les fréquences COM pour le départ et l'arrivée (équi- valent de --com-dep --com-app) --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) 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; sub prt($) { print shift; } # FONCTIONS DE CONNEXION AVEC FGFS PAR 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; } # 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; } # 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 sub getPositionParTelnet ($) { # si on est pas déjà connecté, alors on se connecte if (!$fgfs) { if ( !($fgfs = &connect("localhost", $_[0], 5)) ) { print "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 @donnees_aeroport; my ($ver,$rtype); # si le fichier de base d'aéroports existe, on l'ouvre sinon on termine le programme if ( -e $APTFILE ) { open (APT, "gzip -d -c $APTFILE|") or die "je ne peux pas ouvrir $APTFILE\n" ; while () { if (/^(\d+)\s+Version\s+/) { $ver = $1; last; } } } else { print "fichier $APTFILE introuvable\n"; print "veuillez vérifier \$FGROOT\n"; print "ou utilisez l'option --fg-root=répertoire\n"; die "ou encore modifiez le script ligne 80\n"; } if ($ver) { prt("Searching file $APTFILE, version $ver, for ${$extremite}[1]... moment...\n") if (!$quiet); } else { close APT; die "Failed to find version in $APTFILE!\n"; } # on parcours le fichier à la recherche de l'aéroport souhaité while () { if (/^1\s+-?\d+\s\d\s\d\s(\w+)\s(.+)/ && $1 eq $_[0]->[1]) { chomp; prt("Airport: $_\n") if (!$quiet); my @header = split (/\s+/, $_, 6); push @donnees_aeroport, \@header; my $autre_bout; foreach () { last if /^\s*$/; my @donnee = split (/\s+/, $_); $rtype = $donnee[0]; # s'il s'agit d'une piste, on la renomme en ajoutant son autre extrémité if ($rtype == 10 && $donnee[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 $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) } elsif ($rtype == 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 = $donnee[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 = $donnee[9]; # $of_lat1 my $rlon1 = $donnee[10]; # $of_lon1 my $rlat2 = $donnee[18]; # $of_lat2 my $rlon2 = $donnee[19]; # $of_lon2 my $rlat = ($rlat1 + $rlat2) / 2; my $rlon = ($rlon1 + $rlon2) / 2; my $dist = distance_( [$rlat1, $rlon1, $rlat2, $rlon2] ); $dist = int( $dist * $KM2FEET ); # runway length, in feet my $az1 = llll2dir_( [$rlat1, $rlon1, $rlat2, $rlon2] ); $az1 = round( $az1 * 100 ) / 100; 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); prt("Runway: 10, $rlat, $rlon, $rwynm, $az1, $dist, ...\n") if (!$quiet); push (@donnees_aeroport, \@a); } # on garde aussi les fréquences COM... push (@donnees_aeroport, \@donnee) if (($rtype >= 50)&&($rtype <= 56)); } } } close (APT); prt("Closed $APTFILE...\n") if (!$quiet); # 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]; $rtype = ${$ra}[0]; ### prt("$i: rtype $rtype\n"); if ($rtype == 10) { $alat = ${$ra}[1]; $alon = ${$ra}[2]; $extremite_ok = 1; last; } } if ($extremite_ok) { prt("Success: lat/lon $alat,$alon, $lcnt records...\n") if (!$quiet); # return @{$donnees_aeroport[1]}[1], @{$donnees_aeroport[1]}[2], \@donnees_aeroport; return $alat,$alon,\@donnees_aeroport; } $erreur = 'No runways found for '.$_[0]->[1]."..."; } else { # ces lignes ne atteintes que si aucun aéroport a été trouvé dans la base $erreur = $_[0]->[1]." n'a pas été trouvé dans la base de données aéroports..."; } }; # to UPPER case $extremite->[1] =~ tr/a-z/A-Z/; 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; } # NAV_TO_RAM ############ sub nav_to_ram ($$$) { my ($fichier, $phrase, $decale) = @_; prt("Loading file ${$fichier}, p=$phrase d=$decale\n") if (!$quiet); 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 (!$quiet); 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 (