#!/usr/bin/perl -w # NAME: flightplan-ok.pl # AIM: Given a starting and ending airport, try to develop a flight plan # Method: get center point and find nearest navaid, then get the center of each # and so on... BUT PRESENTLY NOT WORKING WELL # 29/09/2014 geoff mclane http://geoffair.net/mperl use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use Time::HiRes qw( gettimeofday tv_interval ); use POSIX qw(ceil floor); use Cwd; 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"; open_log($outfile); my $t0 = [gettimeofday]; # user variables my $VERS = "0.0.2 2014-09-26"; my $load_log = 0; my $in_file = ''; my $verbosity = 0; my $out_file = ''; my $track_color = 'green'; my $runway_color = 'red'; my $bbox_color = 'gray'; my $bgn_icao = ''; my $end_icao = ''; my ($bgn_lat,$bgn_lon,$bgn_alt); my ($end_lat,$end_lon,$end_alt); my ($bgn_az,$tot_dist); # offset into @g_aptlist my $bgn_off = -1; my $end_off = -1; my ($actnav); my $fp_type = 'VFR'; my $min_dist = 40; # nm my $max_dist = 100; # nm my $max_max_dist = 400; # 350; # 300; # 250; # 200; # nm my $deg_spread = 10; my $max_deg_spread = 46; # 40; # 30; my $extension_nm = 40; #nm sub set_defs() { # YGIL 1050 ft -31.69684576,148.63677076 Gilgandra, 345 km on 137, to # YSSY 21 ft -33.94927300,151.18134683 Sydney Intl $bgn_lat = -31.69684576; $bgn_lon = 148.63677076; $bgn_alt = 1050; $end_lat = -33.94927300; $end_lon = 151.18134683; $end_alt = 21; $bgn_az = 137; $tot_dist = 345000; prt("YGIL 1050 ft -31.69684576,148.63677076 Gilgandra, 345 km on 137, to\n"); prt("YSSY 21 ft -33.94927300,151.18134683 Sydney Intl\n"); } # ============================================================================= # This NEEDS to be adjusted to YOUR particular default location of these files. my $CDATROOT="F:/fgdata"; # 20140127 - 3.1 my $FGROOT = (exists $ENV{'FG_ROOT'})? $ENV{'FG_ROOT'} : $CDATROOT; my $APTFILE = "$FGROOT/Airports/apt.dat.gz"; # the airports data file my $NAVFILE = "$FGROOT/Navaids/nav.dat.gz"; # the NAV, NDB, etc. data file # add these files my $FIXFILE = "$FGROOT/Navaids/fix.dat.gz"; # the FIX data file my $AWYFILE = "$FGROOT/Navaids/awy.dat.gz"; # Airways data my $g_aptdat = $APTFILE; my $g_navdat = $NAVFILE; my $g_fixfile = $FIXFILE; my $g_awyfile = $AWYFILE; # ### DEBUG ### my $debug_on = 1; my $def_bgn = 'YPPH'; # perth ##my $def_bgn = 'ZSPD'; #'YGIL'; my $def_end = 'YSSY'; # sydney #my $def_end = 'YSDU'; ### program variables my @warnings = (); my $cwd = cwd(); sub VERB1() { return $verbosity >= 1; } sub VERB2() { return $verbosity >= 2; } sub VERB5() { return $verbosity >= 5; } sub VERB9() { return $verbosity >= 9; } sub show_warnings($) { my ($val) = @_; if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { prt( "\nNo warnings issued.\n\n" ) if (VERB9()); } } 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); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub process_in_file($) { my ($inf) = @_; if (! open INF, "<$inf") { pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); } my @lines = ; close INF; my $lncnt = scalar @lines; prt("Processing $lncnt lines, from [$inf]...\n"); my ($line,$inc,$lnn); $lnn = 0; foreach $line (@lines) { chomp $line; $lnn++; if ($line =~ /\s*#\s*include\s+(.+)$/) { $inc = $1; prt("$lnn: $inc\n"); } } } my @apt_lines = (); my @g_naptlist = (); my @g_aptlist = (); my @g_nav_lines = (); my @g_navlist = (); my @g_allnavs = (); # nav.dat.gz CODES my $navNDB = '2'; my $navVOR = '3'; my $navILS = '4'; my $navLOC = '5'; my $navGS = '6'; my $navOM = '7'; my $navMM = '8'; my $navIM = '9'; my $navVDME = '12'; my $navNDME = '13'; my @navset = ( $navNDB, $navVOR, $navILS, $navLOC, $navGS, $navOM, $navMM, $navIM, $navVDME, $navNDME ); my @navtypes = qw( NDB VOR ILS LOC GS OM MM IM VDME NDME ); # VDME - VOR (VHF (Very High Frequency) Omni-directional Radio-range) with Distance Measuring Equipment - usually belongs to Government & Military. # NDB - European from 280 kHz to 530 kHz # with a gap between 495 and 505 kHz because 500 kHz was the international maritime distress (emergency) frequency. sub in_world_range($$) { my ($lt,$ln) = @_; return 0 if ($lt < -90); return 0 if ($lt > 90); return 0 if ($ln < -180); return 0 if ($ln > 180); return 1; } sub load_nav_data() { my $t1 = [gettimeofday]; prt("\n[v9] Loading $g_navdat file ...\n"); # if (VERB9()); mydie("ERROR: Can NOT locate [$g_navdat]!\n") if ( !( -f $g_navdat) ); open NIF, "gzip -d -c $g_navdat|" or mydie( "ERROR: CAN NOT OPEN $g_navdat...$!...\n" ); @g_nav_lines = ; close NIF; my $elap = secs_HHMMSS( tv_interval( $t1, [gettimeofday] ) ); prt("[v9] Got ".scalar @g_nav_lines." lines in $elap...\n"); # if (VERB9()); } sub load_apt_data() { my ($cnt,$msg); prt("[v9] Loading $g_aptdat file... moment... 15-20 secs...\n"); # if (VERB9()); pgm_exit(1,"ERROR: Can NOT locate $g_aptdat ...$!...\n") if ( !( -f $g_aptdat) ); open IF, "gzip -d -c $g_aptdat|" or mydie( "ERROR: CAN NOT OPEN $g_aptdat...$!...\n" ); @apt_lines = ; close IF; $cnt = scalar @apt_lines; my $elapsed = tv_interval ( $t0, [gettimeofday]); $elapsed = secs_HHMMSS($elapsed); prt("[v9] Done in $elapsed, got $cnt lines to scan... 20-30 secs\n"); # if (VERB9()); } sub is_valid_nav($) { my ($t) = shift; if ($t && length($t)) { my $txt = "$t"; my $cnt = 0; foreach my $n (@navset) { if ($n eq $txt) { $actnav = $navtypes[$cnt]; return 1; } $cnt++; } } return 0; } sub get_nav_type($) { my ($t) = shift; my $txt = "$t"; my $cnt = 0; foreach my $n (@navset) { if ($n eq $txt) { $txt = $navtypes[$cnt]; last; } $cnt++; } $txt .= ' ' while (length($txt) < 4); return $txt; } sub search_nav_lines() { my $rnls = \@g_nav_lines; my $nav_cnt = scalar @{$rnls}; prt("Processing $nav_cnt navaid records, getting distances to $bgn_lat,$bgn_lon and $end_lat,$end_lon...\n"); my ($ln,$line,$len,$lnn,@arr,$typ,$nc,$i,$res); my ($nlat,$nlon,$nalt,$nfrq,$nrng,$nfrq2,$nid,$name,$km,$az); my ($dist1,$az11,$az12); my ($dist2,$az21,$az22); # limit the navaid items to those likely to be in the path my $marge = 2; # increase box by this margin (degrees) my ($max_lat,$max_lon,$min_lat,$min_lon); if ($bgn_lat > $end_lat) { $max_lat = $bgn_lat + $marge; $min_lat = $end_lat - $marge; } else { $max_lat = $end_lat + $marge; $min_lat = $bgn_lat - $marge; } if ($bgn_lon > $end_lon) { $max_lon = $bgn_lon + $marge; $min_lon = $end_lon - $marge; } else { $max_lon = $end_lon + $marge; $min_lon = $bgn_lon - $marge; } for ($ln = 0; $ln < $nav_cnt; $ln++) { $lnn = $ln + 1; $line = ${$rnls}[$ln]; $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 4 5 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"); } if ( is_valid_nav($typ) ) { $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]; } $res = fg_geo_inverse_wgs_84 ($bgn_lat,$bgn_lon,$nlat,$nlon,\$az11,\$az12,\$dist1); $res = fg_geo_inverse_wgs_84 ($end_lat,$end_lon,$nlat,$nlon,\$az21,\$az22,\$dist2); #$km = $dist / 1000; #$km = (int(($km + 0.05) * 10) / 10); #$az = (int(($az1 + 0.05) * 10) / 10); #prt( "[v5] $actnav, $typ, $nlat, $nlon, $nalt, $nfrq, $nrng, $nfrq2, $nid, $name, $km, $az\n") if (VERB5()); # 0=typ,1=lat, 2=lon, 3=alt, 4=frq, 5-rng, 6-frq2, 7=nid,8=name,9=dist,10=az1,11=az2 # store in ALL push(@g_allnavs, [$typ, $nlat, $nlon, $nalt, $nfrq, $nrng, $nfrq2, $nid, $name, $dist1, $az11, $dist2, $az21] ); if (($nlat <= $max_lat)&& ($nlat >= $min_lat)&& ($nlon <= $max_lon)&& ($nlon >= $min_lon)) { push(@g_navlist, [$typ, $nlat, $nlon, $nalt, $nfrq, $nrng, $nfrq2, $nid, $name, $dist1, $az11, $dist2, $az21] ); } } else { pgm_exit(1,"ERROR: FIX ME! Unknown type [$line]\n"); } } $nid = scalar @g_allnavs; $nc = scalar @g_navlist; prt("Loaded $nid navaids, selected $nc within bbox $min_lon,$min_lat,$max_lon,$max_lat...\nfrom $g_navdat\n"); } sub load_all_navaids() { my $t1 = [gettimeofday]; load_nav_data(); search_nav_lines(); my $elap = secs_HHMMSS( tv_interval( $t1, [gettimeofday] ) ); prt("Loaded full navaid array in $elap\n"); } sub find_airports() { my ($line,$len,$type,@arr,@arr2); my ($trwycnt,$version); my ($alat,$alon,$aalt,$actl,$abld,$icao,$name); my ($rlat,$rlon,$rwyt,$add); my ($rlat1,$rlon1,$rlat2,$rlon2); my ($ftyp,$cfrq,$frqn); my $rwycnt = 0; my $wwcnt = 0; my $helicnt = 0; my $lncnt = 0; my @line_array = (); my $glat = 0; my $glon = 0; my $apt = ''; my $totaptcnt = 0; my @runways = (); # clear RUNWAY list my @waterways = (); # clear RUNWAY list my @heliways = (); # clear RUNWAY list my @freqs = (); # clear frequencies my $fndcnt = 0; foreach $line (@apt_lines) { $lncnt++; $line = trim_all($line); $len = length($line); next if ($len == 0); next if ($line =~ /^I/); @arr = split(/\s+/,$line); if ($line =~ /^\d+\s+Version\s+/) { # my $ind = index($line,','); $version = $arr[0]; $len = index($line,','); $len = 80 if ($len <= 0); prt(substr($line,0,$len)." ($version) file: $g_aptdat\n"); next; } ###prt("$line\n"); push(@line_array,$line); $type = $arr[0]; # if 1=Airport, 16=SeaPlane, 17=Heliport if (($type == 1)||($type == 16)||($type == 17)) { # start with 1, 16, 17 # 0 1 2 3 4 # 17 126 0 0 EH0001 [H] VU medisch centrum # ID ALT C B NAME++ $trwycnt = $rwycnt; $trwycnt += $wwcnt; $trwycnt += $helicnt; if (length($apt) && ($trwycnt > 0)) { # average position $alat = $glat / $trwycnt; $alon = $glon / $trwycnt; @arr2 = split(/\s+/,$apt); # split airport line $aalt = $arr2[1]; # Airport (general) ALTITUDE AMSL $actl = $arr2[2]; # control tower $abld = $arr2[3]; # buildings $icao = $arr2[4]; # ICAO $name = join(' ', splice(@arr2,5)); # Name my @ra = @runways; my @wa = @waterways; my @ha = @heliways; my @fa = @freqs; if (($icao eq $bgn_icao)||($icao eq $end_icao)) { # 0 1 2 3 4 5 6 7 8 push(@g_aptlist, [$icao, $name, $alat, $alon, $aalt, \@ra, \@wa, \@ha, \@fa ]); $fndcnt++; # show_frequencies(\@fa); } else { # 0 1 2 3 4 5 6 7 8 push(@g_naptlist, [$icao, $name, $alat, $alon, $aalt, \@ra, \@wa, \@ha, \@fa ]); } } @line_array = (); # clear ALL lines of this AIRPORT push(@line_array,$line); $apt = $line; $rwycnt = 0; $wwcnt = 0; $helicnt = 0; @runways = (); # clear RUNWAY list @waterways = (); # clear RUNWAY list @heliways = (); # clear RUNWAY list @freqs = (); # clear frequencies $glat = 0; $glon = 0; $totaptcnt++; # count another AIRPORT ###} elsif ($line =~ /^$rln\s+/) { } elsif ($type == 10) { # 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 $rlat = $arr[1]; $rlon = $arr[2]; $rwyt = $arr[3]; # text 'xxx'=taxiway, 'H1x'=heleport, else a runway ###prt( "$line [$rlat, $rlon]\n" ); if ( $rwyt ne "xxx" ) { # $rwyt =~ s/x//g; # remove trailing 'x' $glat += $rlat; $glon += $rlon; $rwycnt++; push(@runways, \@arr); } ###} elsif ($line =~ /^5(\d+)\s+/) { } elsif ( ($type >= 50) && ($type <= 56) ) { # frequencies # 50 12775 ATIS $ftyp = $type - 50; $cfrq = $arr[1]; $frqn = $arr[2]; $add = 0; if ($ftyp == 0) { $add = 1; # ATIS } elsif ($ftyp == 1) { $add = 1; # Unicom } elsif ($ftyp == 2) { $add = 1; # clearance } elsif ($ftyp == 3) { $add = 1; # ground } elsif ($ftyp == 4) { $add = 1; # tower } elsif ($ftyp == 5) { $add = 1; # approach } elsif ($ftyp == 6) { $add = 1; # departure } else { pgm_exit(1,"Unknown [$line]\n"); } if ($add) { my @fa3 = @arr; push(@freqs, \@fa3); # save the freq array } else { pgm_exit(1, "WHAT IS THIS [5$ftyp $cfrq $frqn] [$line]\n FIX ME!!!"); } } elsif ($type == 14) { # tower location } elsif ($type == 15) { # ramp startup } elsif ($type == 18) { # Airport light beacon } elsif ($type == 19) { # Airport windsock # ============================================================================= # 20140110 - Switch to LATEST git fgdata - IE 1000 Version - data cycle 2013.10 # So must ADD all the NEW 'types', just like x-plane } elsif ($type == 20) { # 20 22.32152700 114.19750500 224.10 0 3 {@Y,^l}31-13{^r} } elsif ($type == 21) { # 21 22.31928000 114.19800800 3 134.09 3.10 13 PAPI-4R } elsif ($type == 100) { # See full version 1000 specs below # 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 $rlat1 = $arr[9]; # $of_lat1 $rlon1 = $arr[10]; # $of_lon1 $rlat2 = $arr[18]; # $of_lat2 $rlon2 = $arr[19]; # $of_lon2 $rlat = ($rlat1 + $rlat2) / 2; $rlon = ($rlon1 + $rlon2) / 2; ###prt( "$line [$rlat, $rlon]\n" ); $glat += $rlat; $glon += $rlon; my @a2 = @arr; push(@runways, \@a2); $rwycnt++; } elsif ($type == 101) { # Water runways # 0 1 2 3 4 5 6 7 8 # 101 243.84 0 16 29.27763293 -089.35826258 34 29.26458929 -089.35340410 # 101 22.86 0 07 29.12988952 -089.39561501 25 29.13389936 -089.38060001 # prt("$.: $line\n"); $rlat1 = $arr[4]; $rlon1 = $arr[5]; $rlat2 = $arr[7]; $rlon2 = $arr[8]; $rlat = sprintf("%.8f",(($rlat1 + $rlat2) / 2)); $rlon = sprintf("%.8f",(($rlon1 + $rlon2) / 2)); if (!in_world_range($rlat,$rlon)) { prtw( "WARNING: $.: $line [$rlat, $rlon] NOT IN WORLD\n" ); next; } $glat += $rlat; $glon += $rlon; my @a2 = @arr; push(@waterways, \@a2); $wwcnt++; } elsif ($type == 102) { # Heliport # my $heli = '102'; # Helipad # 0 1 2 3 4 5 6 7 8 9 10 11 # 102 H2 52.48160046 013.39580674 355.00 18.90 18.90 2 0 0 0.00 0 # 102 H3 52.48071507 013.39937648 2.64 13.11 13.11 1 0 0 0.00 0 # prt("$.: $line\n"); $rlat = sprintf("%.8f",$arr[2]); $rlon = sprintf("%.8f",$arr[3]); if (!in_world_range($rlat,$rlon)) { prtw( "WARNING: $.: $line [$rlat, $rlon] NOT IN WORLD\n" ); next; } $glat += $rlat; $glon += $rlon; my @a2 = @arr; push(@heliways, \@a2); $helicnt++; } elsif ($type == 110) { # 110 2 0.00 134.10 runway sholder } elsif ($type == 111) { # 111 22.30419700 114.21613100 } elsif ($type == 112) { # 112 22.30449500 114.21644400 22.30480900 114.21677000 51 102 } elsif ($type == 113) { # 113 22.30370300 114.21561700 } elsif ($type == 114) { # 114 43.29914799 -008.38013558 43.29965322 -008.37970933 } elsif ($type == 115) { # 115 22.31009400 114.21038500 } elsif ($type == 116) { # 116 43.30240028 -008.37799316 43.30271076 -008.37878407 } elsif ($type == 120) { # 120 hold lines W A13 } elsif ($type == 130) { # 130 Airport Boundary } elsif ($type == 1000) { # 1000 Northerly flow } elsif ($type == 1001) { # 1001 KGRB 270 020 999 } elsif ($type == 1002) { # 1002 KGRB 0 } elsif ($type == 1003) { # 1003 KGRB 0 } elsif ($type == 1004) { # 1004 0000 2400 } elsif ($type == 1100) { # 1100 36 12654 all heavy|jets|turboprops|props 000360 000360 Northerly } elsif ($type == 1101) { # 1101 36 left } elsif ($type == 1200) { # ???? } elsif ($type == 1201) { # 1201 42.75457409 -073.80880021 both 2110 _start } elsif ($type == 1202) { # 1202 2110 2112 twoway taxiway } elsif ($type == 1204) { # 1204 arrival 01,19 } elsif ($type == 1300) { # 1300 30.32875704 -009.41140596 323.85 misc jets|props Ramp # =============================================================================== } elsif ($type == 99) { ### } elsif ($line =~ /^$lastln\s?/) { # 99, followed by space, count 0 or more ... prt( "Reached END OF FILE ... \n" ) if (VERB9()); last; } else { my $cnt = scalar @apt_lines; my $elapsed = tv_interval ( $t0, [gettimeofday]); $elapsed = secs_HHMMSS($elapsed); prt("FIX ME - LINE UNCASED $type - Line ".get_nn($lncnt)." of ".get_nn($cnt)." - $elapsed\n"); prt("$line\n"); pgm_exit(1,""); } } } sub process_inputs() { load_apt_data(); my $t1 = [gettimeofday]; find_airports(); my $max = scalar @g_aptlist; my $acnt = scalar @g_naptlist; my $elap = secs_HHMMSS( tv_interval( $t1, [gettimeofday] ) ); prt("From $acnt airports, found $max in $elap...\n"); my ($ra); # 0 1 2 3 4 5 6 7 8 #push(@g_naptlist, [$icao, $name, $alat, $alon, $aalt, \@ra, \@wa, \@ha, \@fa ]); my ($i,$rlat,$rlon,$calt); my ($icao1,$name1,$alat1,$alon1,$aalt1,$rra1,$rwa1,$rha1,$rfa1); my ($icao2,$name2,$alat2,$alon2,$aalt2,$rra2,$rwa2,$rha2,$rfa2); my ($dist,$az1,$az2,$s,$ret); for ($i = 0; $i < $max; $i++) { $ra = $g_aptlist[$i]; $icao1 = ${$ra}[0]; if ($icao1 eq $bgn_icao) { $bgn_off = $i; } elsif ($icao1 eq $end_icao) { $end_off = $i; } } $ret = 0; if ($bgn_off == -1) { prt("icao $bgn_icao NOT FOUND! "); $ret++; } if ($end_off == -1) { prt("icao $end_icao NOT FOUND! "); $ret++; } if ($ret > 0) { prt("FAILED!\n"); return; } $ra = $g_aptlist[$bgn_off]; $icao1 = ${$ra}[0]; $name1 = ${$ra}[1]; $alat1 = ${$ra}[2]; $alon1 = ${$ra}[3]; $aalt1 = ${$ra}[4]; $rra1 = ${$ra}[5]; $rwa1 = ${$ra}[6]; $rha1 = ${$ra}[7]; $rfa1 = ${$ra}[8]; $ra = $g_aptlist[$end_off]; $icao2 = ${$ra}[0]; $name2 = ${$ra}[1]; $alat2 = ${$ra}[2]; $alon2 = ${$ra}[3]; $aalt2 = ${$ra}[4]; $rra2 = ${$ra}[5]; $rwa2 = ${$ra}[6]; $rha2 = ${$ra}[7]; $rfa2 = ${$ra}[8]; $bgn_lat = $alat1; $bgn_lon = $alon1; $bgn_alt = $aalt1; $end_lat = $alat2; $end_lon = $alon2; $end_alt = $aalt2; $ret = fg_geo_inverse_wgs_84($bgn_lat, $bgn_lon, $end_lat, $end_lon, \$az1, \$az2, \$s); $bgn_az = $az1; $tot_dist = $s; # just for display $rlat = sprintf("%.8f",$alat1); $rlon = sprintf("%.8f",$alon1); $calt = sprintf("%5d",$aalt1). " ft"; #$ret = fg_geo_inverse_wgs_84($alat1, $alon1, $alat2, $alon2, \$az1, \$az2, \$s); $az2 = int( $az1 + 0.5 ); $dist = int( ($s + 0.5) / 1000 )." km"; prt("$icao1 $calt $rlat,$rlon $name1, $dist on $az2, to\n"); $rlat = sprintf("%.8f",$alat2); $rlon = sprintf("%.8f",$alon2); $calt = sprintf("%5d",$aalt2). " ft"; prt("$icao2 $calt $rlat,$rlon $name2\n"); } # FLight Plan # # US FCC Type # 1. Type - VFR (I), IFR (V), DVFR - mixed Y - init IFR, Z - init VFR # Type of flight - S=Sceduled, N=Non-sceduled, G=General Aviation, M=Militry, X=Other? # 2. Aircraft - IDENT # 3. Aircraft Type / Special Equipment: H=Heavy (136K kg or more), M=Medium (7K kg +), L-Light (<7K kg) # Radio communication, navigation and approach aid equipment and capabilities # N=No COM/NAV/approach, S=standard COM/NAV/Approach + A=GBAS landing system, B=LPV (APV with SBAS) # C=Loran, D=DME, E1=FMC WPR ACARS, E2=D-FIS ACARS, E3=PDC ACARS, F=ADF, G=GNSS, # H=HF RTF, I=Intertial Navigation, J1=CPDLC ATN VDL Mode 2, J2=CPDLC FANS 1/A HFDL, # J3=CPDLC FANS 1/A VDL Mode A, J4=CPDLC FANS 1/A VDL Mode 2, J5=CPDLC FANS 1/A SATCOM(INMARSAT), # J6=CPDLC FANS 1/A SATCOM (MTSAT), J7=CPDLC FANS 1/A SATCOM (Iridium), K=MLS, L=ILS, # M1=ATC RTF SATCOM (INMARSAT), M2=ATC RTF (MTSAT), M3=ATC RTF (Iridium), O=VOR P1�P9 Reserved for RCP # R=PBN approved, S=VHF RTF, VOR, and ILS, T=TACAN, U=UHF RTF, V=VHF RTF, W=RVSM approved, X=MNPS approved, # Y=VHF with 8.33 kHz channel spacing capability, Z=Other equipment with COM/, NAV/ and/or DAT/, as appropriate. # 4. True Airspeed - KTS # 5. Departure Point - SID, ICAO, ALT # 6. Departure Time - Zulu - Proposed/Actual # 7. Crusing Altitude - feet or FL - Flight level, expressed as F followed by 3 figures (for example, F085; F330), or # Standard Metric Level in tens of meters, expressed as S followed by 4 figures (for example, S1130), or # Altitude in hundreds of feet, expressed as A followed by 3 figures (for example, A045; A100), or # Altitude in tens of meters, expressed as M followed by 4 figures (for example, M0840), or # for uncontrolled VFR flights, the letters VFR. # 8. ROUTE OF FLIGHT - Each waypoint # The identification of the significant point, followed by the bearing from the point in the form # of 3 figures giving degrees magnetic, followed by the distance from the point in the form of 3 # figures expressing nautical miles. For example, a point 180 magnetic at a distance of 40 nautical # miles from VOR DUB should be expressed as DUB180040. # 9. Destination - STAR, ICAO, ALT #10. Est. Time Enroute - HH:MM #11. Remarks #12. Fuel on Board - in HH:MM #13. Alternate Airports #14. Pilot - Name, address, telephone #15. Number on board: #16. Color of aircraft # sub show_airport($) { my $ra = shift; my ($icao, $name, $alat, $alon, $aalt, $rrwa, $wa, $ha, $fa); $icao = ${$ra}[0]; $name = ${$ra}[1]; $alat = ${$ra}[2]; $alon = ${$ra}[3]; $aalt = ${$ra}[4]; $rrwa = ${$ra}[5]; $wa = ${$ra}[6]; $ha = ${$ra}[7]; $fa = ${$ra}[0]; # for display $alon = sprintf("%.8f",$alon); $alat = sprintf("%.8f",$alat); $aalt = sprintf("%5d",$aalt)." ft"; prt("$icao $alat,$alon,$aalt $name\n"); } #/** Feet to Meters */ my $FEET_TO_METER = 0.3048; # offset 10 in runway array my %runway_surface = ( 1 => 'Asphalt', 2 => 'Concrete', 3 => 'Turf/grass', 4 => 'Dirt', 5 => 'Gravel', 6 => 'H-Asphalt', # helepad (big 'H' in the middle). 7 => 'H-Concrete', # helepad (big 'H' in the middle). 8 => 'H-Turf', # helepad (big 'H' in the middle). 9 => 'H-Dirt', # helepad (big 'H' in the middle). 10 => 'T-Asphalt', # taxiway - with yellow hold line across long axis (not available from WorldMaker). 11 => 'T-Concrete', # taxiway - with yellow hold line across long axis (not available from WorldMaker). 12 => 'Dry Lakebed', # (eg. at KEDW Edwards AFB). 13 => 'Water' # runways (marked with bobbing buoys) for seaplane/floatplane bases (available in X-Plane 7.0 and later). ); sub get_ll_stg($$) { my ($lat,$lon) = @_; my $stg = sprintf("%.8f,%.8f",$lat,$lon); $stg .= ' ' while (length($stg) < 23); return $stg; } # radio frequency listing # Radio Frequencies # AWOS (Automatic Weather Observation System), ASOS (Automatic Surface Observation System) my $minatc = '50'; # ATIS (Automated Terminal Information System). AWIS (Automatic Weather Information Service) my $unicom = '51'; # Unicom or CTAF (USA), radio (UK) - open channel for pilot position reporting at uncontrolled airports. my $cleara = '52'; # Clearance delivery. my $goundf = '53'; # ground my $twrfrq = '54'; # like 12210 TWR my $appfrq = '55'; # like 11970 ROTTERDAM APP my $maxatc = '56'; # Departure. my %off2name = ( 0 => 'ATIS', 1 => 'Unicom', 2 => 'Clearance', 3 => 'Ground', 4 => 'Tower', 5 => 'Approach', 6 => 'Departure' ); my %off2name2 = ( 0 => 'ATIS', 1 => 'UNICOM', 2 => 'CLR', 3 => 'GRD', 4 => 'TWR', 5 => 'APP', 6 => 'DEP' ); my $use_full_list = 0; # seems better to GROUP frequencies my $add_name_show = 0; # does NOT seem helpful my $use_short_names = 1; # Use APP instead of Approach sub show_frequencies($) { my $rfa = shift; my $rfc = scalar @{$rfa}; my ($tmp,$rtlen); my ($rfna,$line,$block,$len,$ra); my ($ev,$fr,$fn,$evnm,$ftyp); my %names = (); my $max_line = 100; my $info = ''; if ($rfc) { $tmp = "radio:".$rfc." ["; $rtlen = length($tmp); $info .= $tmp; foreach $ra (@{$rfa}) { # 50 12775 ATIS $ev = ${$ra}[0]; # number in file 50, 51, ...., 56 $fr = ${$ra}[1]; # frequency x 100 $fn = ${$ra}[2]; # type AWIS, CTAF, ... if ($ev && $fr && $fn) { #### prt("$ev $fr $fn\n"); $fr /= 100; } else { pgm_exit(1,"ERROR: Frequency array FAILED\n"); } # prepare information $evnm = 'UNK'.$ev.'?'; $ftyp = $ev - 50; if ( ($ftyp >= 0) && ($ftyp <= 6) ) { if ($use_short_names) { $evnm = $off2name2{$ftyp}; } else { $evnm = $off2name{$ftyp}; } } #$info .= " $ev $fr $fn"; #$info .= " $evnm $fn $fr"; if ($use_full_list) { $info .= " $evnm $fr ($fn)"; } else { $names{$evnm} = [] if (!defined $names{$evnm}); $rfna = $names{$evnm}; if ($add_name_show) { push(@{$rfna}, "$fr ($fn)"); } else { push(@{$rfna},$fr); } } } if (!$use_full_list) { my ($key,$val,$wrap); if ($add_name_show) { $wrap = 0; foreach $key (sort keys %names) { $rfna = $names{$key}; $info .= " $key:"; foreach $val (@{$rfna}) { $info .= " $val"; } $wrap++; if ($wrap == 3) { $wrap = 0; $info .= "\n"; } } } else { $line = $info; # start the line $info = ''; foreach $key (sort keys %names) { $rfna = $names{$key}; $block = ''; foreach $val (@{$rfna}) { $block .= ' ' if (length($block)); $block .= $val; } $block = "$key: $block"; $len = length($line) + length($block); #prt("got len $len\n"); if ($len > $max_line) { $info .= "$line\n" if (length($line)); $line = ' ' x $rtlen; #prt("wrapped line\n"); } $line .= "$block "; } $info .= $line if (length($line)); $info =~ s/\s+$//; } } $info .= ']'; } else { $info .= " [No freq. info]"; } prt("$info\n"); } sub show_runways($$$) { my ($rrwys,$rwater,$rheli) = @_; my $rwycnt = scalar @{$rrwys}; my $info = "runway:$rwycnt: "; my ($ra,$type,$tmp,$rtyp,$hdg,$rlen,$disp1,$disp2,$rwid,$rlit,$surf,$rhdg); my ($displ1,$displ2,$stopw1,$stopw2,$rwy1,$rwy2); my ($elon1,$elon2,$elat1,$elat2,$s,$az1,$az2); my ($rwlen,$rwlen2,$hdgr,$eaz1,$eaz2,$hdg1,$hdg2); my $annoxg = ''; foreach $ra (@{$rrwys}) { $tmp = scalar @{$ra}; $type = ${$ra}[0]; # get first 'type' entry ###prt(join(" ",@{$ra})." t=$type c=$tmp\n"); ###next; if ($type == 10) { # 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 if ($tmp < 15) { foreach $hdg (@{$ra}) { $info .= "[$hdg] "; } pgm_exit(1,"ERROR: Invalid runway array cnt $tmp! $info\n"); } $rtyp = ${$ra}[3]; $hdg = ${$ra}[4]; $rlen = ${$ra}[5]; # length, in feet # For example, for displaced threshold lengths of 543 feet and 1234 feet, # the code would be 543.1234. $tmp = ${$ra}[6]; # get displacements - feet - threshold $displ1 = int($tmp); $displ2 = ($tmp - $displ1) * 10000; $tmp = ${$ra}[7]; # get stopway - feet $stopw1 = int($tmp); $stopw2 = ($tmp - $stopw1) * 10000; $rwid = ${$ra}[8]; # WIDTH in feet $rlit = ${$ra}[9]; # LIGHTS $surf = ${$ra}[10]; # add surface type $rtyp =~ s/x+$//; # REMOVE any TRAILIN 'x', but may have 'L', 'R', 'C', 'S' appended if ($rtyp =~ /^\d+$/) { $rhdg = $rtyp * 10; # 2010-12-15 - get opposite end numbers } else { $rhdg = $hdg; # get opp heading, but may NOT be per numbers } $rhdg += 180; # reverse it $rhdg -= 360 if ($rhdg >= 360); # drop wrap $rwy1 = $rtyp; $rwy2 = int($rhdg / 10); $rhdg = int($rhdg / 10); $rhdg = "0$rhdg" if ($rhdg < 10); # display it ####################################################### $info .= "\n"; # if (VERB1()); # new line $info .= " $rtyp/$rhdg ($hdg) "; $info .= $rlen." ft."; # length in FEET if (defined $runway_surface{$surf}) { $info .= " (s=".$runway_surface{$surf}.")"; } $rwlen2 = (${$ra}[5] * $FEET_TO_METER) / 2; $hdgr = $hdg + 180; $hdgr -= 360 if ($hdgr >= 360); fg_geo_direct_wgs_84( ${$ra}[1], ${$ra}[2], $hdg , $rwlen2, \$elat1, \$elon1, \$eaz1 ); fg_geo_direct_wgs_84( ${$ra}[1], ${$ra}[2], $hdgr, $rwlen2, \$elat2, \$elon2, \$eaz2 ); $hdg1 = $hdg; $hdg2 = $hdgr; $az1 = $hdg1; $az2 = $hdg2; if (VERB1()) { $info .= " ".${$ra}[1].",".${$ra}[2]; if (VERB2()) { # show ENDS of runway $info .= "\n $rtyp: $elat1,$elon1 $rhdg: $elat2,$elon2"; $info .= " th=$displ1/$displ2 sp=$stopw1/$stopw2"; } } } elsif ($type == 100) { # 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 $rwid = ${$ra}[1]; # WIDTH in meters? NOT SHOWN $surf = ${$ra}[2]; # add surface type $rwy1 = ${$ra}[8]; $elat1 = ${$ra}[9]; $elon1 = ${$ra}[10]; $rwy2 = ${$ra}[17]; $elat2 = ${$ra}[18]; $elon2 = ${$ra}[19]; my $res = fg_geo_inverse_wgs_84 ($elat1,$elon1,$elat2,$elon2,\$az1,\$az2,\$s); # display it # ========================================================================== $info .= "\n"; # if (VERB1()); # new line $s = (int(($s + 0.05) * 10) / 10); $az1 = (int(($az1 + 0.05) * 10) / 10); $rwy1 .= ' ' while (length($rwy1) < 3); $rwy2 .= ' ' while (length($rwy2) < 3); $info .= " $rwy1: ".get_ll_stg($elat1,$elon1)." $rwy2: ".get_ll_stg($elat2,$elon2)." b=$az1 l=$s m."; if (defined $runway_surface{$surf}) { $info .= " (s=".$runway_surface{$surf}.")"; } } else { pgm_exit(1,"Uncoded RUNWAY type $type - FIX ME!\n".join(" ",@{$ra})."\n"); } $annoxg .= "$elon1 $elat1\n"; $annoxg .= "$elon2 $elat2\n"; $annoxg .= "NEXT\n"; } $info .= "\n"; # 0 1 2 3 4 5 6 7 8 # 101 243.84 0 16 29.27763293 -089.35826258 34 29.26458929 -089.35340410 # 101 22.86 0 07 29.12988952 -089.39561501 25 29.13389936 -089.38060001 # from : http://data.x-plane.com/file_specs/XP%20APT1000%20Spec.pdf # 0 101 - Raw code for waterway # 1 22.86 - width in meters # 2 0 - perimeter buoys # 3 16 - runway number # 4 29.129 - lat # 5 -089.39 - lon # 6 25 - runway number # 7 29.133 - lat # 8 -089.38 - lon $rwycnt = scalar @{$rwater}; if ($rwycnt) { $info .= "waterway:$rwycnt:\n"; foreach $ra (@{$rwater}) { $rwid = ${$ra}[1]; # WIDTH in meters? NOT SHOWN $surf = ${$ra}[2]; # buoys $rwy1 = ${$ra}[3]; $elat1 = ${$ra}[4]; $elon1 = ${$ra}[5]; $rwy2 = ${$ra}[6]; $elat2 = ${$ra}[7]; $elon2 = ${$ra}[8]; my $res = fg_geo_inverse_wgs_84 ($elat1,$elon1,$elat2,$elon2,\$az1,\$az2,\$s); # display it # ========================================================================== $s = (int(($s + 0.05) * 10) / 10); $az1 = (int(($az1 + 0.05) * 10) / 10); $rwy1 .= ' ' while (length($rwy1) < 3); $rwy2 .= ' ' while (length($rwy2) < 3); $info .= " $rwy1: ".get_ll_stg($elat1,$elon1)." $rwy2: ".get_ll_stg($elat2,$elon2)." b=$az1 l=$s m."; $info .= "\n"; # if (VERB1()); # new line } } $rwycnt = scalar @{$rheli}; if ($rwycnt) { # 0 1 2 3 4 5 6 7 8 9 10 11 # 102 H1 47.53918248 -122.30722302 2.00 10.06 10.06 1 0 0 0.25 0 # 102 Helipad # 0 102 Row code for a helipad # 1 H1 Designator for a helipad. Must be unique at an airport. Usually “H” suffixed by an integer (eg. “H1”, “H3”) # 2 47.53918248 Latitude of helipad centre # 3 -122.30722302 Longitude of helipad centre in decimal degrees # 4 2.00 Orientation (true heading) of helipad in degrees # 5 10.06 Helipad length in metres Two decimal places recommended (metres), must be >=1.00 # 6 10.06 Helipad width in metres Two decimal places recommended (metres), must be >= 1.00 # 7 1 Helipad surface code Integer value for a Surface Type Code (see below) # 8 0 Helipad markings 0 (other values not yet supported) # 9 0 Code defining a helipad shoulder surface type 0=no shoulder, 1=asphalt shoulder, 2=concrete shoulder #10 0.25 Helipad smoothness (not used by X-Plane yet) 0.00 (smooth) to 1.00 (very rough). Default is 0.25 #11 0 Helipad edge lighting 0=no edge lights, 1=yellow edge lights $info .= "helipad:$rwycnt:\n"; $rwy1 = ${$ra}[1]; $elat1 = ${$ra}[2]; $elon1 = ${$ra}[3]; $rwlen = ${$ra}[5]; $rwlen2= ${$ra}[6]; $info .= " $rwy1: ".get_ll_stg($elat1,$elon1)." $rwlen x $rwlen2 m."; $info .= "\n"; # if (VERB1()); # new line } prt($info); } sub get_runways_xg($) { my $ra = shift; my ($rrwa, $wa, $ha, $fa); my ($tmp,$type,$rlat1,$rlat2,$rlon1,$rlon2,$rlat3,$rlon3,$rlat4,$rlon4); my ($elat1,$elon1,$elat2,$elon2,$rwid2,$res,$rcnt); my ($az1,$az2,$dist,$az); show_airport($ra); $rrwa = ${$ra}[5]; $wa = ${$ra}[6]; $ha = ${$ra}[7]; $rcnt = scalar @{$rrwa}; my $xg = ''; if ($rcnt > 0) { $xg .= "color $runway_color\n"; foreach $ra (@{$rrwa}) { $tmp = scalar @{$ra}; $type = ${$ra}[0]; # get first 'type' entry if ($type == 10) { # 0 1 2 3 # 10 36.962213 127.031071 14x 131.52 8208 1595.0620 0000.0000 150 321321 1 0 3 0.25 0 0300.0300 } elsif ($type == 100) { # 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 $rwid2 = ${$ra}[1] / 2; $elat1 = ${$ra}[9]; $elon1 = ${$ra}[10]; $elat2 = ${$ra}[18]; $elon2 = ${$ra}[19]; $res = fg_geo_inverse_wgs_84 ($elat1,$elon1,$elat2,$elon2,\$az1,\$az2,\$dist); $az2 = $az1 + 90; $az2 -= 360 if ($az2 >= 360); $res = fg_geo_direct_wgs_84($elat1,$elon1,$az2,$rwid2,\$rlat1, \$rlon1,\$az); $res = fg_geo_direct_wgs_84($elat2,$elon2,$az2,$rwid2,\$rlat3, \$rlon3,\$az); $az2 = $az1 - 90; $az2 += 360 if ($az2 < 0); $res = fg_geo_direct_wgs_84($elat1,$elon1,$az2,$rwid2,\$rlat2, \$rlon2,\$az); $res = fg_geo_direct_wgs_84($elat2,$elon2,$az2,$rwid2,\$rlat4, \$rlon4,\$az); # got the 4 corners $xg .= "$rlon1 $rlat1\n"; $xg .= "$rlon2 $rlat2\n"; $xg .= "$rlon3 $rlat3\n"; $xg .= "$rlon4 $rlat4\n"; $xg .= "NEXT\n"; } } } return $xg; } sub show_airport_all($) { my $ra = shift; my ($rrwa, $wa, $ha, $fa); show_airport($ra); $rrwa = ${$ra}[5]; $wa = ${$ra}[6]; $ha = ${$ra}[7]; $fa = ${$ra}[8]; show_runways($rrwa,$wa,$ha); show_frequencies($fa); } # BBOX lef_lon, bot_lat, rit_lon, top_lat sub find_apts($$) { my ($bbox,$rapts) = @_; my ($lef_lon, $bot_lat, $rit_lon, $top_lat); my @arr = split(",",$bbox); my $cnt = scalar @arr; return 0 if ($cnt != 4); $lef_lon = $arr[0]; $bot_lat = $arr[1]; $rit_lon = $arr[2]; $top_lat = $arr[3]; @arr = (); ## 0 1 2 3 4 5 6 7 8 #push(@g_naptlist, [$icao, $name, $alat, $alon, $aalt, \@ra, \@wa, \@ha, \@fa ]); my ($ra, $icao, $name, $alat, $alon, $aalt, $rrwa, $wa, $ha, $fa); foreach $ra (@g_naptlist) { $icao = ${$ra}[0]; $name = ${$ra}[1]; $alat = ${$ra}[2]; $alon = ${$ra}[3]; $aalt = ${$ra}[4]; $rrwa = ${$ra}[5]; $wa = ${$ra}[6]; $ha = ${$ra}[7]; $fa = ${$ra}[0]; if (($alon >= $lef_lon)&& ($alon <= $rit_lon)&& ($alat >= $bot_lat)&& ($alat <= $top_lat)) { push(@arr,$ra); } } $cnt = scalar @arr; if ($cnt > 0) { @{$rapts} = @arr; } return $cnt; } sub show_navaid($) { my $ra = shift; # 0 1 2 3 4 5 6 7 8 9 10 11 12 # push(@g_navlist, [$typ, $nlat, $nlon, $nalt, $nfrq, $nrng, $nfrq2, $nid, $name, $dist1, $az11, $dist2, $az21] ); my ($typ, $nlat, $nlon, $nalt, $nfrq, $nrng, $nfrq2, $nid, $name, $dist1, $az11, $dist2, $az21); $typ = ${$ra}[0]; $nlat = ${$ra}[1]; $nlon = ${$ra}[2]; $nalt = ${$ra}[3]; $nfrq = ${$ra}[4]; $nrng = ${$ra}[5]; $nfrq2 = ${$ra}[6]; $nid = ${$ra}[7]; $name = ${$ra}[8]; $dist1 = ${$ra}[9]; $az11 = ${$ra}[10]; $dist2 = ${$ra}[11]; $az21 = ${$ra}[12]; # for display $nlon = sprintf("%.8f",$nlon); $nlat = sprintf("%.8f",$nlat); $nalt = sprintf("%5d",$nalt)." ft"; $dist1 = int(($dist1 + 0.5) / 1000). " km"; $dist2 = int(($dist2 + 0.5) / 1000). " km"; $az11 = int($az11 + 0.5); $az21 = int($az21 + 0.5); prt("$typ, $nlat, $nlon, $nalt, $nfrq, $nrng, $nfrq2, $nid, $name, $dist1, $az11, $dist2, $az21\n"); } # BBOX lef_lon, bot_lat, rit_lon, top_lat # 20140930 - Find ONLY VOR and NDB unless $all flag is ON sub find_wpts($$$) { my ($bbox,$rwpts,$all) = @_; # 0 1 2 3 4 5 6 7 8 9 10 11 12 # push(@g_navlist, [$typ, $nlat, $nlon, $nalt, $nfrq, $nrng, $nfrq2, $nid, $name, $dist1, $az11, $dist2, $az21] ); my ($ra,$nlat,$nlon,$ntyp); my ($lef_lon, $bot_lat, $rit_lon, $top_lat); my @arr = split(",",$bbox); my $cnt = scalar @arr; return 0 if ($cnt != 4); $lef_lon = $arr[0]; $bot_lat = $arr[1]; $rit_lon = $arr[2]; $top_lat = $arr[3]; @arr = (); foreach $ra (@g_navlist) { $ntyp = ${$ra}[0]; if ($all || (($ntyp == 2)||($ntyp == 3))) { $nlat = ${$ra}[1]; $nlon = ${$ra}[2]; if (($nlon >= $lef_lon)&& ($nlon <= $rit_lon)&& ($nlat >= $bot_lat)&& ($nlat <= $top_lat)) { push(@arr,$ra); } } } $cnt = @arr; if ($cnt > 0) { @{$rwpts} = @arr; return $cnt; } return 0; } # have a bgn_lat,bgn_lon,bgn_alt, and an end_lat,end_lon,end_alt # Have a FULL array of ALL airports loaded # Have a FULL array of ALL navaids loaded # need to construct a quadrilateral, from bgn towards end, # min max # -----|----------| # / | need | # / | navaids | # B -> E | in this | # \ | box | # \ | | # -----|----------| # # BBOX left lon, bottom lat, right lon, top lat sub latlon_2_bbox($$$$$$$$) { my ($min_lat1,$min_lon1,$max_lat1,$max_lon1,$min_lat2,$min_lon2,$max_lat2,$max_lon2) = @_; my $left_lon = $min_lon1; $left_lon = $max_lon1 if ($max_lon1 < $left_lon); $left_lon = $min_lon2 if ($min_lon2 < $left_lon); $left_lon = $max_lon2 if ($max_lon2 < $left_lon); my $bot_lat = $min_lat1; $bot_lat = $max_lat1 if ($max_lat1 < $bot_lat); $bot_lat = $min_lat2 if ($min_lat2 < $bot_lat); $bot_lat = $max_lat2 if ($max_lat2 < $bot_lat); my $rit_lon = $min_lon1; $rit_lon = $max_lon1 if ($max_lon1 > $rit_lon); $rit_lon = $min_lon2 if ($min_lon2 > $rit_lon); $rit_lon = $max_lon2 if ($max_lon2 > $rit_lon); my $top_lat = $min_lat1; $top_lat = $max_lat1 if ($max_lat1 > $top_lat); $top_lat = $min_lat2 if ($min_lat2 > $top_lat); $top_lat = $max_lat2 if ($max_lat2 > $top_lat); if (VERB9()) { prt("Polgon ($min_lat1,$min_lon1,$max_lat1,$max_lon1,$min_lat2,$min_lon2,$max_lat2,$max_lon2)\n". "BBOX = $left_lon,$bot_lat,$rit_lon,$top_lat\n"); } return "$left_lon,$bot_lat,$rit_lon,$top_lat"; } # BBOX left lon, bottom lat, right lon, top lat sub bbox_2_xg($) { my $bbox = shift; my @arr = split(",",$bbox); my $cnt = scalar @arr; return "# bbox $bbox FAILED ($cnt)\n" if ($cnt != 4); my $lef_lon = $arr[0]; my $bot_lat = $arr[1]; my $rit_lon = $arr[2]; my $top_lat = $arr[3]; my $xg = "$lef_lon $bot_lat\n"; $xg .= "$lef_lon $top_lat\n"; $xg .= "$rit_lon $top_lat\n"; $xg .= "$rit_lon $bot_lat\n"; $xg .= "$lef_lon $bot_lat\n"; $xg .= "NEXT\n"; return $xg; } my ($g_min_lat,$g_min_lon,$g_max_lat,$g_max_lon); sub set_extended_bbox($$) { my ($lat,$lon) = @_; $g_min_lon = $lon if ($lon < $g_min_lon); $g_max_lon = $lon if ($lon > $g_max_lon); $g_min_lat = $lat if ($lat < $g_min_lat); $g_max_lat = $lat if ($lat > $g_max_lat); } sub set_initial_bbox($$$$) { my ($bgn_lat,$bgn_lon,$end_lat,$end_lon) = @_; $g_min_lon = $bgn_lon; $g_min_lon = $end_lon if ($end_lon < $g_min_lon); $g_max_lon = $bgn_lon; $g_max_lon = $end_lon if ($end_lon > $g_max_lon); $g_min_lat = $bgn_lat; $g_min_lat = $end_lat if ($end_lat < $g_min_lat); $g_max_lat = $bgn_lat; $g_max_lat = $end_lat if ($end_lat > $g_max_lat); # but this is just the start point and end point # need to extend this by say 10 nm around each point # $extension_nm my ($res,$elat,$elon,$s,$az); $s = nm_2_meter($extension_nm); $res = fg_geo_direct_wgs_84( $bgn_lat, $bgn_lon, 0, $s, \$elat, \$elon, \$az ); set_extended_bbox($elat,$elon); $res = fg_geo_direct_wgs_84( $bgn_lat, $bgn_lon, 90, $s, \$elat, \$elon, \$az ); set_extended_bbox($elat,$elon); $res = fg_geo_direct_wgs_84( $bgn_lat, $bgn_lon, 180, $s, \$elat, \$elon, \$az ); set_extended_bbox($elat,$elon); $res = fg_geo_direct_wgs_84( $bgn_lat, $bgn_lon, 270, $s, \$elat, \$elon, \$az ); set_extended_bbox($elat,$elon); $res = fg_geo_direct_wgs_84( $end_lat, $end_lon, 0, $s, \$elat, \$elon, \$az ); set_extended_bbox($elat,$elon); $res = fg_geo_direct_wgs_84( $end_lat, $end_lon, 90, $s, \$elat, \$elon, \$az ); set_extended_bbox($elat,$elon); $res = fg_geo_direct_wgs_84( $end_lat, $end_lon, 180, $s, \$elat, \$elon, \$az ); set_extended_bbox($elat,$elon); $res = fg_geo_direct_wgs_84( $end_lat, $end_lon, 270, $s, \$elat, \$elon, \$az ); set_extended_bbox($elat,$elon); } my @route = (); ####################################################################### # FONCTIONS DE CALCULS GEOGRAPHIQUES # par Frank Melchior #################################### my $PI = 3.1415926535897932384626433832795029; my $D2R = $PI / 180; my $R2D = 180 / $PI; my $ERAD = 6378138.12; my $NDB = 2; my $VOR = 3; #my $KM2FEET = 3280.84; 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 - degrees my $dist_min = 10; # distance minimale entre deux waypoints (km) my $km; # affichage des distances en kilomètres my $quiet = 1; 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 (HORS SID/STAR) ############################################### sub getNavAidNearestMidPoint_NOT_USED ($$$) { 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 (!$quiet); my $index = 0; #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]; } } } my %selected_indexes = (); sub get_nearest_to_center($$$) { my $leg = $_[0]; my $milieu = $_[1]; # 0 1 2 3 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]] ); my ($ra,$ntyp,$nlat,$nlon,$index); $index = 0; foreach $ra (@g_navlist) { next if (defined $selected_indexes{$index}); $ntyp = ${$ra}[0]; if (($ntyp == $VOR)||($ntyp == $NDB)) { $nlat = ${$ra}[1]; $nlon = ${$ra}[2]; # on saute à la prochaine itération si la balise testée est celle d'une des # extrémités du segment next if ( ($nlat == $leg->[0] && $nlon == $leg->[1]) || ($nlat == $leg->[2] && $nlon == $leg->[3]) ); # on calcule l'écart de route en degrés my $deviation_to = abs(llll2dir_ ([$leg->[0], $leg->[1], $nlat, $nlon]) - $heading_from); my $deviation_from = abs(llll2dir_ ([$nlat, $nlon, $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], $nlat, $nlon] ); my $dist_to = distance_( [$leg->[0], $leg->[1], $nlat, $nlon] ); my $dist_from = distance_( [$nlat, $nlon, $leg->[2], $leg->[3]] ); # si c'est la plus proche et si la distance est suffisante if ( $navaid_dist < $ref_dist[$ntyp] && $dist_to > $dist_min && $dist_from > $dist_min ) { # on retient cette option et on sauve la nouvelle distance de référence $ref_navaid[$ntyp] = $index; $ref_dist[$ntyp] = $navaid_dist; } } $index++; } #SI ON NE VEUT QUE DU VOR if ($vor_a_vor) { if ($ref_navaid[$VOR]) { $index = $ref_navaid[$VOR]; $selected_indexes{$index} = 1; } return $ref_navaid[$VOR]; } #SI ON PREFERE LES VOR AUX NDB if ($vor_preferes && $ref_navaid[$NDB]) { if ($ref_navaid[$VOR]) { $index = $ref_navaid[$VOR]; $selected_indexes{$index} = 1; } elsif ($ref_navaid[$NDB]) { $index = $ref_navaid[$NDB]; $selected_indexes{$index} = 1; } return ($ref_navaid[$VOR]) ? $ref_navaid[$VOR] : $ref_navaid[$NDB]; } #SI ON EST INDIFFERENT if ($ref_navaid[$VOR] && $ref_navaid[$NDB]) { if ($ref_dist[$VOR] < $ref_dist[$NDB]) { if ($ref_navaid[$VOR]) { $index = $ref_navaid[$VOR]; $selected_indexes{$index} = 1; } } else { if ($ref_navaid[$NDB]) { $index = $ref_navaid[$NDB]; $selected_indexes{$index} = 1; } } return ($ref_dist[$VOR] < $ref_dist[$NDB]) ? $ref_navaid[$VOR] : $ref_navaid[$NDB]; } #SI PAS DE VOR if (!$ref_navaid[$VOR] && $ref_navaid[$NDB]) { if ($ref_navaid[$NDB]) { $index = $ref_navaid[$NDB]; $selected_indexes{$index} = 1; } return $ref_navaid[$NDB]; } #SI PAS DE NDB if ($ref_navaid[$VOR] && !$ref_navaid[$NDB]) { if ($ref_navaid[$VOR]) { $index = $ref_navaid[$VOR]; $selected_indexes{$index} = 1; } return $ref_navaid[$VOR]; } return $ref_navaid[0]; # = undef } ####################################################################### sub get_route($$$$); sub get_route($$$$) { my ($depart,$arrive,$plan,$lev) = @_; my $lat1 = $depart->[0]; my $lon1 = $depart->[1]; my $alt1 = $depart->[2]; my $lat2 = $arrive->[0]; my $lon2 = $arrive->[1]; my $alt2 = $arrive->[2]; my $leg = [$lat1, $lon1, $lat2, $lon2]; my $traj = [ $lat1 + ( ($lat2 - $lat1) / 2 ), $lon1 + ( ($lon2 - $lon1) / 2 ) ]; my $dist = distance_($leg); if ($dist < $dist_min) { prt("$lev: Leg: $lat1,$lon1 - $lat2,$lon2, dist ".(round($dist*100) / 100)." km less than $dist_min\n"); # if (!$quiet); return; } prt("$lev: Leg: $lat1,$lon1 - $lat2,$lon2, dist ".(round($dist*100) / 100)." km\n"); # if (!$quiet); my $navaid = get_nearest_to_center( $leg, $traj, $dist / 2 ); my ($ra,$nlat,$nlon,$nalt); if ($navaid) { my $ra = $g_navlist[$navaid]; ### show_navaid($ra); $nlat = ${$ra}[1]; $nlon = ${$ra}[2]; $nalt = ${$ra}[3]; # on la nomme "waypoint" prt("waypoint $nlat,$nlon\n") if (!$quiet); my $waypoint = [$nlat,$nlon]; # on construit la route entre "depuis" et "waypoint" get_route ($depart, $waypoint, $plan, $lev + 1); # on sauve la balise la plus proche du milieu prt("Added: ".join(" ",@{$ra})." to plan\n"); # if (!$quiet); push(@{$plan}, $ra); # on construit la route entre "waypoint" et "vers" get_route ($waypoint, $arrive, $plan, $lev + 1); } elsif ($lev == 0) { prt("Failed to find FIRST mid-point navaid!\n"); } else { prt("$lev: Failed to find a mid-point navaid!\n"); } } sub get_flight_plan() { my $from = [ $bgn_lat, $bgn_lon, $bgn_alt ]; my $to = [ $end_lat, $end_lon, $end_alt ]; get_route( $from, $to, \@route, 0 ); } ######################################### ### MAIN ### parse_args(@ARGV); if ($debug_on) { #set_defs(); } process_inputs(); load_all_navaids(); get_flight_plan(); pgm_exit(0,""); ######################################## sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have a following argument!\n") if (!@av); } sub parse_args { my (@av) = @_; my ($arg,$sarg,$cnt); my $verb = VERB2(); $cnt = 0; while (@av) { $arg = $av[0]; if ($arg =~ /^-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /^-/); if (($sarg =~ /^h/i)||($sarg eq '?')) { give_help(); pgm_exit(0,"Help exit(0)"); } elsif ($sarg =~ /^v/) { if ($sarg =~ /^v.*(\d+)$/) { $verbosity = $1; } else { while ($sarg =~ /^v/) { $verbosity++; $sarg = substr($sarg,1); } } $verb = VERB2(); prt("Verbosity = $verbosity\n") if ($verb); } elsif ($sarg =~ /^l/) { if ($sarg =~ /^ll/) { $load_log = 2; } else { $load_log = 1; } prt("Set to load log at end. ($load_log)\n") if ($verb); } elsif ($sarg =~ /^o/) { need_arg(@av); shift @av; $sarg = $av[0]; $out_file = $sarg; prt("Set out file to [$out_file].\n") if ($verb); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { if ($cnt == 0) { $bgn_icao = $arg; prt("Set begin ICAO to [$bgn_icao]\n") if ($verb); } elsif ($cnt == 1) { $end_icao = $arg; prt("Set end ICAO to [$end_icao]\n") if ($verb); } else { pgm_exit(1,"Already have begin $bgn_icao, and end $end_icao!\nWhat is this [$arg]?\n"); } $cnt++; } shift @av; } if ($debug_on) { prtw("WARNING: DEBUG is ON!\n"); if (length($bgn_icao) == 0) { $bgn_icao = $def_bgn; prt("Set DEFAULT begin to [$bgn_icao]\n"); } if (length($end_icao) == 0) { $end_icao = $def_end; prt("Set DEFAULT end to [$end_icao]\n"); } } if (length($bgn_icao) == 0) { pgm_exit(1,"ERROR: No begin icao found in command!\n"); } if (length($end_icao) == 0) { pgm_exit(1,"ERROR: No end icao found in command!\n"); } } sub give_help { prt("$pgmname: version $VERS\n"); prt("Usage: $pgmname [options] begin-icao end-icao\n"); prt("Options:\n"); prt(" --help (-h or -?) = This help, and exit 0.\n"); prt(" --verb[n] (-v) = Bump [or set] verbosity. def=$verbosity\n"); prt(" --load (-l) = Load LOG at end. ($outfile)\n"); prt(" --out (-o) = Write output to this file.\n"); } # eof - template.pl