Generated: Sun Aug 21 11:11:27 2011 from shwsct.pl 2010/11/28 57.1 KB.
#!/usr/bin/perl -w # NAME: shwsct.pl # AIM: Extract info from an avio sct file # includes some Standard Instrument Departures (SIDs) and Standard Terminal Arrivals (STARs) # # 27/11/2010 geoff mclane http://geoffair.net/mperl use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use Cwd; my $perl_dir = 'C:\GTools\perl'; unshift(@INC, $perl_dir); require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; require 'fg_wsg84.pl' or die "Unable to load fg_wsg84.pl ...\n"; require "Bucket2.pm" or die "Unable to load Bucket2.pm ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $perl_dir."\\temp.$pgmname.txt"; open_log($outfile); # user variables my $load_log = 0; my $in_file = ''; my $SG_EPSILON = 0.0000001; # EQUALS SG_EPSILON 20101121 my $ERAD = 6378138.12; my $DIST_FACTOR = $ERAD; my $use_fg_format = 0; # just for visible compares my $use_agreed_ll = 1; # agreed lat,lon = 3.8 form my $debug_on = 1; my $def_file = 'C:\Program Files\IVAO\IvAc\SectorFiles\temp01.sct'; my $use_6_decimal_lat_lon = 1; # alternative is to use 8 decimals my $show_all_found = 1; ### program variables my @warnings = (); my $cwd = cwd(); my $os = $^O; my ($ghr_loaded); my $verbosity = 0; my ($g_fg_nav_list); my $done_fg_nav = 0; my $g_ap_count = 0; my $g_vor_count = 0; my $g_ndb_count = 0; my $g_fix_count = 0; my $g_sid_count = 0; my $g_star_count = 0; my $g_atcc_count = 0; my $g_awy_count = 0; my $g_geo_count = 0; my $CDATROOT="C:/FGCVS/FlightGear/data"; # my $CDATROOT="C:/FGCVS/FlightGear/data"; # ============================================================================= # This NEEDS to be adjusted to YOUR particular default location of these files. my $FGROOT = (exists $ENV{'FG_ROOT'})? $ENV{'FG_ROOT'} : $CDATROOT; #my $FGROOT = (exists $ENV{'FG_ROOT'})? $ENV{'FG_ROOT'} : "C:/FG/27/data"; my $APTFILE = "$FGROOT/Airports/apt.dat.gz"; # the airports data file my $NAVFILE = "$FGROOT/Navaids/nav.dat.gz"; # the NAV, NDB, etc. data file 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" ); } } 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); } # ======================================================= # FG constants # set lengths for common outputs my $maxnnlen = 4; my $g_maxidl = 4; # like navaind ID my $g_maxnaltl = 5; my $g_maxnfrql = 7; # was 5. but 118.550 looks better; my $g_maxnrngl = 5; my $g_maxnfq2l = 10; my $g_maxnnidl = 4; my $g_maxnlatl = 12; my $g_maxnlonl = 13; my $g_nav_hdr = "Type Latitude Logitude Alt. Freq. Range Frequency2 ID Name"; sub format_fg_nav_stg($$$$$$$$$) { my ($atyp,$dlat,$dlon,$nalt,$nfrq,$nrng,$nfrq2,$nid,$name) = @_; my $nlat = (int($dlat * 100000000)) / 100000000; my $nlon = (int($dlon * 100000000)) / 100000000; $nlat = sprintf("%3.8f",$nlat); $nlon = sprintf("%4.8f",$nlon); $atyp .= ' ' while (length($atyp) < $maxnnlen); $nlat = ' '.$nlat while (length($nlat) < $g_maxnlatl); $nlon = ' '.$nlon while (length($nlon) < $g_maxnlonl); $nalt = ' '.$nalt while (length($nalt) < $g_maxnaltl); $nfrq = ' '.$nfrq while (length($nfrq) < $g_maxnfrql); $nrng = ' '.$nrng while (length($nrng) < $g_maxnrngl); $nfrq2 = ' '.$nfrq2 while (length($nfrq2) < $g_maxnfq2l); $nid = ' '.$nid while (length($nid) < $g_maxnnidl); return "$atyp $nlat, $nlon, $nalt, $nfrq, $nrng, $nfrq2, $nid, $name"; } ### my @sct_sections = qw( INFO Airport Runway VOR NDB Fixes ARTCC SID STAR GEO ); my @sct_sections = ( "INFO", "Airport", "Runway", "VOR", "NDB", "Fixes", "LOW AIRWAY", "HIGH AIRWAY", "ARTCC", "ARTCC LOW", "ARTCC HIGH", "SID", "STAR", "GEO" ); sub get_annon_hash() { my %h = (); return \%h; } # FG DATA sub load_gzip_file($) { my ($fil) = shift; prt("[v2] Loading [$fil] file... moment...\n") if (VERB2()); mydie("ERROR: Can NOT locate [$fil]!\n") if ( !( -f $fil) ); open NIF, "gzip -d -c $fil|" or mydie( "ERROR: CAN NOT OPEN $fil...$!...\n" ); my @arr = <NIF>; close NIF; return \@arr; } # sub load_fix_file { return load_gzip_file($g_fixfile); } # sub load_awy_file { return load_gzip_file($g_awyfile); } sub get_low_airway_sample() { my $stg = <<EOF; [LOW AIRWAY] J904 N050.53.21.480 E005.40.51.280 MAS MAS ; J906 N050.49.18.120 E005.39.15.010 NAVAK NAVAK J906 NAVAK NAVAK MAPAD MAPAD ; L17 PETIK PETIK MOLIX MOLIX ; L19 TULIP TULIP EVELI EVELI L19 EVELI EVELI MOLIX MOLIX ; L60 SUPUR SUPUR KOLAG KOLAG EOF return $stg; } sub get_high_airway_sample() { my $stg = <<EOF; [HIGH AIRWAY] UJ906 N050.49.18.120 E005.39.15.010 NAVAK NAVAK UJ906 NAVAK NAVAK MAPAD MAPAD ; UL7 PAM PAM SPY SPY UL7 SPY SPY LONAM LONAM ; UL17 PETIK PETIK MOLIX MOLIX ; UL19 TULIP TULIP EVELI EVELI UL19 EVELI EVELI MOLIX MOLIX ; UL60 SUPUR SUPUR KOLAG KOLAG ; UL74 LARAS LARAS RTM RTM UL74 RTM RTM TULIP TULIP UL74 TULIP TULIP MONIL MONIL UL74 MONIL MONIL AMGOD AMGOD UL74 AMGOD AMGOD TOPPA TOPPA EOF return $stg; } sub get_artcc_low_sample() { my $stg = <<EOF; [ARTCC LOW] ;- EELDE TCA N053.01.28.999 E007.12.34.920 N053.00.41.980 E007.12.58.021 N053.00.41.980 E007.12.58.021 N053.00.00.000 E007.12.29.999 N053.00.00.000 E007.12.29.999 N052.52.59.999 E006.13.59.999 N052.52.59.999 E006.13.59.999 N053.00.00.000 E006.11.04.999 N053.00.00.000 E006.11.04.999 N053.12.24.998 E006.09.33.001 EOF return $stg; } sub get_artcc_high_sample() { my $stg = <<EOF; [ARTCC HIGH] SECTOR N N051.57.02.000 E002.23.12.000 N051.57.14.000 E002.30.00.000 N051.57.14.000 E002.30.00.000 N051.57.56.000 E003.10.19.000 N051.57.56.000 E003.10.19.000 N051.28.50.000 E003.10.19.000 N051.28.50.000 E003.10.19.000 N051.38.13.000 E002.30.00.000 N051.38.13.000 E002.30.00.000 N051.27.20.000 E002.30.00.000 Sector O N053.18.13.000 E002.44.00.000 N053.14.41.000 E003.11.02.000 N053.14.41.000 E003.11.02.000 N053.10.29.000 E003.21.58.000 N053.10.29.000 E003.21.58.000 N052.28.19.000 E002.46.44.000 N053.18.13.000 E002.44.00.000 N053.20.00.000 E002.30.00.000 N053.20.00.000 E002.30.00.000 N052.40.10.000 E002.30.00.000 N052.40.10.000 E002.30.00.000 N052.37.04.000 E002.53.56.000 ;- NIEUW MILLIGEN MTCA SCTR A N053.40.00.001 E006.30.00.000 N053.37.59.999 E006.34.59.999 N053.37.59.999 E006.34.59.999 N053.31.00.001 E006.40.59.999 N053.31.00.001 E006.40.59.999 N053.30.15.001 E006.44.30.001 EOF return $stg; } sub get_info_sample() { my $stg = <<EOF; EHAA-FIR THE NETHERLANDS v13 by Paul de Jong / Marco Meerkerk EHAA_W_CTR EHAM N052.18.30.000 E004.45.30.000 60 36 1 1 EOF return $stg; } sub get_airport_sample() { my $stg = <<EOF; [Airport] ;BELGIUM EBAW 121.400 N051.11.32.000 E004.27.23.000 C ; ANTWERP EBBL 122.100 N051.10.05.999 E005.28.12.000 C ; KLEINE BROGEL ;NETHERLANDS EHAL 118.350 N053.27.06.005 E005.40.37.999 C ; AMELAND EHAM 119.200 N052.18.31.010 E004.45.50.000 C ; SCHIPHOL EOF return $stg; } sub split_nums($) { my ($stg) = @_; my @arr = (); my $len = length($stg); my ($ch,$num,$i,$inn); $num = ''; $inn = 0; if ($len) { $ch = substr($stg,0,1); if ($ch =~ /(N|S|E|W)/) { $num = $ch; $stg = substr($stg,1); } } for ($i = 0; $i < $len; $i++) { $ch = substr($stg,$i,1); if ($inn) { if ($ch =~ /\D/) { $inn = 0; push(@arr,$num) if (length($num)); $num = ''; next; } $num .= $ch; } else { # waiting number to start if ($ch =~ /\d/) { $num .= $ch; $inn = 1; } } } push(@arr,$num) if (length($num)); return @arr; } sub decode_lat($) { my ($stg) = @_; my $len = length($stg); return $stg if ($stg =~ /^\w+$/); #return -200 if ($len < 14); #my @arr = split(/\./,$stg); my @arr = split_nums($stg); my $cnt = scalar @arr; #return -200 if ($cnt < 4); $cnt = 0; my $lat = -200; my ($key,$ch); $ch = ''; foreach $key (@arr) { if ($cnt == 0) { # degrees $ch = substr($key,0,1); $key = substr($key,1); $lat = $key; } elsif ($cnt == 1) { # minutes $key =~ s/\'$//; $lat += $key / 60; } elsif ($cnt == 2) { # seconds $lat += $key / (60 * 60); } elsif ($cnt == 3) { $lat += $key / ((60 * 60) * 1000); } else { prtw("WARNING: Split too great [$stg]!\n"); } $cnt++; } if (($ch eq 'S')||($ch eq 'W')) { $lat = -$lat; } return $lat; } sub show_airport($) { my ($rh) = @_; my $icao = ${$rh}{'AP_ICAO'}; my $com1 = ${$rh}{'AP_COMM'}; my $lat = ${$rh}{'AP_CLAT'}; my $lon = ${$rh}{'AP_CLON'}; my $cat = ${$rh}{'AP_CLAS'}; # ${$rh}{'AP_CCHK'} = $arr[5]; # semi colon my $name = ${$rh}{'AP_NAME'}; prt("$icao $com1 $lat $lon $cat $name\n"); } sub get_airport($$) { my ($rh,$stg) = @_; if ($stg =~ /^(\w+)\s+(\d+\.\d+)\s+/) { my (@arr,$cnt,$i,$name); @arr = split(/\s+/,$stg); $cnt = scalar @arr; if ($cnt >= 6) { ${$rh}{'AP_ICAO'} = $arr[0]; ${$rh}{'AP_COMM'} = $arr[1]; ${$rh}{'AP_CLAT'} = decode_lat($arr[2]); ${$rh}{'AP_CLON'} = decode_lat($arr[3]); ${$rh}{'AP_CLAS'} = $arr[4]; ${$rh}{'AP_CCHK'} = $arr[5]; # semi colon ${$rh}{'AP_NAME'} = trim_all($arr[6]); for ($i = 7; $i < $cnt; $i++) { ${$rh}{'AP_NAME'} = ' '.$arr[$i]; } ${$rh}{'AP_NAME'} = trim_all(${$rh}{'AP_NAME'}); show_airport($rh) if (VERB9()); } } return $stg; } sub get_runway_sample() { my $stg = <<EOF; [Runway] ;EHAM 04 22 041 221 N052.18.01.339 E004.47.00.539 N052.18.50.490 E004.48.10.890 ; EHAM SCHIPHOL 06 24 058 000 N052.17.16.462 E004.44.02.468 N052.18.16.492 E004.46.39.061 ; EHAM SCHIPHOL 09 27 000 267 N052.18.59.918 E004.44.46.849 N052.19.06.150 E004.47.48.811 ; EHAM SCHIPHOL 18C 36C 183 003 N052.19.53.029 E004.44.24.112 N052.18.06.419 E004.44.15.000 ; EHAM SCHIPHOL 18R 36L 183 000 N052.21.45.652 E004.42.42.959 N052.19.42.892 E004.42.31.810 ; EHAM SCHIPHOL 18L 36R 000 003 N052.19.16.810 E004.46.47.842 N052.17.26.970 E004.46.38.449 ; EHAM SCHIPHOL ;EHBD 03 21 030 210 N051.15.05.479 E005.35.51.551 N051.15.39.071 E005.36.22.489 ; EHBD BUDEL ;EHVK 06R 24L 059 239 N051.38.54.190 E005.41.27.211 N051.39.46.181 E005.43.40.670 ; EHVK VOLKEL 06L 24R 059 239 N051.38.59.939 E005.41.21.379 N051.39.51.959 E005.43.34.939 ; EHVK VOLKEL EOF return $stg; } sub get_runway($$) { my ($rh,$stg) = @_; my (@arr,$cnt,$i); @arr = split(/\s+/,$stg); $cnt = scalar @arr; if ($stg =~ /^\d+/) { # 0 1 2 3 4 5 6 7 8 9 10 # 18C 36C 183 003 N052.19.53.029 E004.44.24.112 N052.18.06.419 E004.44.15.000 ; EHAM SCHIPHOL if ($cnt >= 10) { ${$rh}{'R_MKL'} = $arr[0]; ${$rh}{'R_MKR'} = $arr[1]; ${$rh}{'R_HDG1'} = $arr[2]; ${$rh}{'R_HDG2'} = $arr[3]; ${$rh}{'R_LAT1'} = decode_lat($arr[4]); ${$rh}{'R_LON1'} = decode_lat($arr[5]); ${$rh}{'R_LAT2'} = decode_lat($arr[6]); ${$rh}{'R_LON2'} = decode_lat($arr[7]); ${$rh}{'R_CHKR'} = $arr[8]; ${$rh}{'R_IAPT'} = trim_all($arr[9]); for ($i = 10; $i < $cnt; $i++) { ${$rh}{'R_IAPT'} = " ".$arr[$i]; } } } } sub get_vor_sample() { my $stg = <<EOF; [VOR] AFI 114.900 N050.54.28.001 E004.08.20.000 ; AFFLIGEM AMS 113.950 N052.19.58.001 E004.42.20.002 ; AMSTERDAM ANT 113.500 N051.11.26.002 E004.28.21.000 ; ANTWERPEN BAM 113.600 N051.19.39.911 E007.10.37.070 ; BARMEN BMN 117.450 N053.02.38.580 E008.46.55.700 ; BREMEN BUB 114.600 N050.54.07.999 E004.32.17.002 ; BRUSSELS NATL WYP 109.600 N051.02.54.071 E007.16.47.989 ; WIPPER ;TACANS DLN 112.200 N052.03.26.000 E005.52.22.000 ; DEELEN EHV 118.200 N051.26.53.000 E005.22.30.000 ; EINDHOVEN EOF return $stg; } sub pad_nav_id($) { my ($rid) = @_; my $id = ${$rid}; if (length($id) < 4) { $id = " $id"; $id .= ' ' while (length($id) < 4); ${$rid} = $id; } } sub not_valid_nav_ref($) { my ($rh) = @_; my @list = qw ( N_TYPE N_ICAO N_COMM N_CLAT N_CLON N_NAME ); my ($tst,$tcnt,$mcnt,$missed); $tcnt = 0; $missed = ''; foreach $tst (@list) { $tcnt++; if (! defined ${$rh}{$tst}) { $mcnt++; $missed .= ' ' if (length($missed)); $missed .= $tst; } } if ($mcnt) { prtw("WARNING: NR: Invalid! Missing [$missed]\n"); } return $mcnt; } sub set_nav_vars($$$$$$$) { my ($rh,$type,$id,$freq,$lat,$lon,$name) = @_; return 0 if (not_valid_nav_ref($rh)); ${$type} = ${$rh}{'N_TYPE'}; # VOR or NDB ${$id} = ${$rh}{'N_ICAO'}; ${$freq} = ${$rh}{'N_COMM'}; ${$lat} = ${$rh}{'N_CLAT'}; ${$lon} = ${$rh}{'N_CLON'}; # ${$rh}{'N_CCHK'} = $arr[4]; # semi ${$name} = ${$rh}{'N_NAME'}; return 1; } sub get_nav_stg($) { my ($rh) = @_; if (not_valid_nav_ref($rh)) { return "INVALID NAV REF!"; } my $type = ${$rh}{'N_TYPE'}; # VOR or NDB my $id = ${$rh}{'N_ICAO'}; my $freq = ${$rh}{'N_COMM'}; my $lat = ${$rh}{'N_CLAT'}; my $lon = ${$rh}{'N_CLON'}; # ${$rh}{'N_CCHK'} = $arr[4]; # semi my $name = ${$rh}{'N_NAME'}; if ($use_fg_format) { return format_fg_nav_stg($type, $lat, $lon, 0,$freq, 0, 0, $id,$name); # my ($atyp,$nlat,$nlon,$nalt,$nfrq,$nrng,$nfrq2,$nid,$name) = @_; } # VISUAL MODS ONLY # ================ my ($nlat,$nlon); $type .= ' ' while (length($type) < $maxnnlen); # pad_nav_id(\$id); $id .= ' ' while (length($id) < $g_maxidl); if ($use_6_decimal_lat_lon) { $nlat = (int(($lat + 0.0000005) * 1000000)) / 1000000; $nlon = (int(($lon + 0.0000005) * 1000000)) / 1000000; $nlat = sprintf("%3.6f",$nlat); $nlon = sprintf("%4.6f",$nlon); } else { $nlat = (int($lat * 100000000)) / 100000000; $nlon = (int($lon * 100000000)) / 100000000; $nlat = sprintf("%3.8f",$nlat); $nlon = sprintf("%4.8f",$nlon); } return "$type $id $freq $nlat $nlon $name"; } sub set_nav_ll($$$) { my ($rh,$rlat,$rlon) = @_; if (not_valid_nav_ref($rh)) { return 0; } ${$rlat} = ${$rh}{'N_CLAT'}; ${$rlon} = ${$rh}{'N_CLON'}; return 1; } sub show_nav($) { my ($rh) = @_; if (not_valid_nav_ref($rh)) { return; } my $ns = get_nav_stg($rh); prt("$ns\n"); } sub get_nav($$$) { my ($rh,$stg,$type) = @_; my (@arr,$cnt,$i); @arr = split(/\s+/,$stg); $cnt = scalar @arr; if ($stg =~ /^\w+\s+\d+\.\d+\s+/) { if ($cnt >= 6) { ${$rh}{'N_TYPE'} = $type; ${$rh}{'N_ICAO'} = $arr[0]; ${$rh}{'N_COMM'} = $arr[1]; ${$rh}{'N_CLAT'} = decode_lat($arr[2]); ${$rh}{'N_CLON'} = decode_lat($arr[3]); ${$rh}{'N_CCHK'} = $arr[4]; # semi ${$rh}{'N_NAME'} = trim_all($arr[5]); for ($i = 6; $i < $cnt; $i++) { ${$rh}{'N_NAME'} = ' '.$arr[$i]; } ${$rh}{'N_NAME'} = trim_all(${$rh}{'N_NAME'}); show_nav($rh) if (VERB9()); } } } sub get_vor($$) { my ($rh,$stg) = @_; get_nav($rh,$stg,"VOR"); } sub get_ndb_sample() { my $stg = <<EOF; [NDB] BC 365.500 N051.22.13.001 E004.29.26.999 ;- BRASSCHAAT BET 401.500 N052.17.16.199 E007.23.07.800 ;- RHEINE BENTLAGE BOT 406.500 N051.35.08.891 E007.01.22.840 ;- BOTTROP BYC 368.000 N052.17.28.201 E009.05.27.600 ;- BUCKEBURG EOF return $stg; } sub get_ndb($$) { my ($rh,$stg) = @_; get_nav($rh,$stg,"NDB"); } sub get_fixes_sample() { my $stg = <<EOF; [Fixes] ABAMI N051.25.30.000 E007.16.50.002 ABAXA N050.45.52.801 E007.23.08.999 ABEDA N052.19.40.001 E001.52.16.000 EOF return $stg; } sub show_fix($) { my ($rh) = @_; my ($key,$rll,$flat,$flon); foreach $key (keys %{$rh}) { $rll = ${$rh}{$key}; $flat = ${$rll}[0]; $flon = ${$rll}[1]; prt("FIX: $key $flat $flon\n"); } } sub get_fix($$) { my ($rh,$txt) = @_; my $stg = trim_all($txt); return if ($stg =~ /^\[/); if ($stg =~ /^;/) { $stg = substr($stg,1); $stg = trim_all($stg); prt("[v9] FIX: Comment [$stg]\n") if (VERB9() && length($stg)); return; } return if ((length($stg) == 0)||($stg =~ /^\s+$/)); my (@arr,$cnt,$i); @arr = split(/\s+/,$stg); my ($name,$flat,$flon); $name = $arr[0]; $cnt = scalar @arr; if ($cnt == 3) { $flat = decode_lat($arr[1]); $flon = decode_lat($arr[2]); ${$rh}{$name} = [ $flat, $flon ]; show_fix($rh) if (VERB9());; } else { # known exception if ($name eq 'RTM_O') { # RTM_O N051.57.15.000 E004 32.11.000 } elsif ($name eq 'RTM_F') { # RTM_F N051.54.36.000 E004 32.49.000 } else { pgm_exit(1,"ERROR: Fix split FAILED! FIX ME!! [$stg]\n"); } } } sub get_awy_low_sample() { my $stg = <<EOF; [LOW AIRWAY] J904 N050.53.21.480 E005.40.51.280 MAS MAS ; J906 N050.49.18.120 E005.39.15.010 NAVAK NAVAK J906 NAVAK NAVAK MAPAD MAPAD ; L17 PETIK PETIK MOLIX MOLIX Z310 WOODY WOODY BATAK BATAK Z310 BATAK BATAK SUSET SUSET ; Z311 BEKEM BEKEM BATAK BATAK ; Z717 MAS MAS GOBNO GOBNO ;TACAN ROUTES TB6 NOR32 NOR32 VBG VBG TB6 VBG VBG NAVPI NAVPI ; EOF return $stg; } sub get_awy_high_sample() { my $stg = <<EOF; [HIGH AIRWAY] UJ906 N050.49.18.120 E005.39.15.010 NAVAK NAVAK UJ906 NAVAK NAVAK MAPAD MAPAD ; UL7 PAM PAM SPY SPY UL7 SPY SPY LONAM LONAM ; UL17 PETIK PETIK MOLIX MOLIX ; UL19 TULIP TULIP EVELI EVELI UL19 EVELI EVELI MOLIX MOLIX ; UZ709 RUPIN RUPIN KUVEK KUVEK ; UZ717 MAS MAS GOBNO GOBNO ;WINDOWS W1 W1N W1N W1S W1S ; W2 W2N W2N W2S W2S EOF return $stg; } my $use_array_of_arrays = 1; sub show_awy($) { my ($rh) = @_; my ($name); my ($first,$secnd,$third,$fourh); my ($ra,$i,$cnt); if ($use_array_of_arrays) { foreach $name (keys %{$rh}) { $ra = ${$rh}{$name}; $cnt = scalar @{$ra}; for ($i = 0; $i < $cnt; $i++) { $first = ${$ra}[$i][0]; $secnd = ${$ra}[$i][1]; $third = ${$ra}[$i][2]; $fourh = ${$ra}[$i][3]; prt("AWY: $name: $first $secnd $third $fourh\n"); } } } else { foreach $name (keys %{$rh}) { $ra = ${$rh}{$name}; $first = ${$ra}[0]; $secnd = ${$ra}[1]; $third = ${$ra}[2]; $fourh = ${$ra}[3]; prt("AWY: $name: $first $secnd $third $fourh\n"); } } } sub get_awy($$) { my ($rh,$stg) = @_; return if ($stg =~ /^\s*\[/); if ($stg =~ /^\s*;/) { $stg =~ s/^\s*;//; $stg = trim_all($stg); prt("AWY: Comment [$stg]\n") if (length($stg)); return; } return if ((length($stg) == 0)||($stg =~ /^\s+$/)); my (@arr,$cnt,$i); @arr = split(/\s+/,$stg); my ($name); my ($first,$secnd,$third,$fourh,$ra4); $name = $arr[0]; $cnt = scalar @arr; if ($cnt >= 5) { $first = $arr[1]; $secnd = $arr[2]; $third = $arr[3]; $fourh = $arr[4]; if ($use_array_of_arrays) { ${$rh}{$name} = [ ] if (!defined ${$rh}{$name}); $ra4 = ${$rh}{$name}; push(@{$ra4}, [ $first, $secnd, $third, $fourh ]); } else { ${$rh}{$name} = [ $first, $secnd, $third, $fourh ]; } show_awy($rh) if (VERB9()); } else { # add any known exception pgm_exit(1,"ERROR: Fix split $cnt vs 5 FAILED! FIX ME!! [$stg]\n"); } } sub get_artcc_sample() { my $stg = <<EOF; [ARTCC] ;AMSTERDAM FIR EHAA-FIR N052.08.37.000 E006.52.37.999 N052.07.04.040 E006.50.12.959 N052.07.04.040 E006.50.12.959 N052.06.25.060 E006.45.18.000 N052.06.25.060 E006.45.18.000 N052.05.13.891 E006.44.50.978 [ARTCC LOW] ;- EELDE TCA N053.01.28.999 E007.12.34.920 N053.00.41.980 E007.12.58.021 N053.00.41.980 E007.12.58.021 N053.00.00.000 E007.12.29.999 N053.00.00.000 E007.12.29.999 N052.52.59.999 E006.13.59.999 N052.52.59.999 E006.13.59.999 N053.00.00.000 E006.11.04.999 N053.06.15.091 E007.12.14.911 N053.01.28.999 E007.12.34.920 ;- NIEUW MILLIGEN MTCA SCTR B N052.48.03.000 E005.17.11.000 N053.12.25.000 E006.09.33.000 N053.12.25.000 E006.09.33.000 N053.00.00.000 E006.11.05.000 N052.48.20.000 E005.20.00.000 N052.48.03.000 E005.17.11.000 ;- NIEUW MILLIGEN MTCA SCTR E N051.53.60.000 E006.36.45.000 N052.03.59.000 E005.45.45.000 N052.03.59.000 E005.45.45.000 N052.07.00.998 E005.45.45.000 N052.07.00.998 E005.45.45.000 N051.53.60.000 E006.36.45.000 ;- NIEUW MILLIGEN MTCA SCTR G1 N051.35.44.999 E003.52.19.999 N051.38.10.000 E003.56.04.999 N051.38.10.000 E003.56.04.999 N051.37.35.299 E003.56.57.098 [ARTCC HIGH] SECTOR N N051.57.02.000 E002.23.12.000 N051.57.14.000 E002.30.00.000 N051.57.14.000 E002.30.00.000 N051.57.56.000 E003.10.19.000 N051.57.56.000 E003.10.19.000 N051.28.50.000 E003.10.19.000 N051.28.50.000 E003.10.19.000 N051.38.13.000 E002.30.00.000 N051.38.13.000 E002.30.00.000 N051.27.20.000 E002.30.00.000 Sector O N053.18.13.000 E002.44.00.000 N053.14.41.000 E003.11.02.000 N053.14.41.000 E003.11.02.000 N053.10.29.000 E003.21.58.000 N053.10.29.000 E003.21.58.000 N052.28.19.000 E002.46.44.000 N053.18.13.000 E002.44.00.000 N053.20.00.000 E002.30.00.000 N053.20.00.000 E002.30.00.000 N052.40.10.000 E002.30.00.000 N052.40.10.000 E002.30.00.000 N052.37.04.000 E002.53.56.000 ;- NIEUW MILLIGEN MTCA SCTR A N053.40.00.001 E006.30.00.000 N053.37.59.999 E006.34.59.999 N053.37.59.999 E006.34.59.999 N053.31.00.001 E006.40.59.999 N053.31.00.001 E006.40.59.999 N053.30.15.001 E006.44.30.001 EOF return $stg; } sub get_artcc($) { my ($rparams) = @_; my ($rh,$line,$ri,$lncnt,$rlines,$heading); my (@arr,$cnt); my ($name,$lat1,$lon1,$lat2,$lon2); my ($rll,$i,$start,$off); $rh = ${$rparams}{'REF_HASH'}; $line = ${$rparams}{'CURR_LINE'}; $ri = ${$rparams}{'CNT_PTR'}; $lncnt = ${$rparams}{'LINE_CNT'}; $rlines = ${$rparams}{'REF_FILE_LINES'}; $heading = ${$rparams}{'LAST_HEADING'}; return if ($line =~ /^\[/); return if ($line =~ /^\s*;/); @arr = split(/\s+/,$line); $cnt = scalar @arr; $i = ${$ri}; $i++; if (defined ${$rparams}{'IN_POLYGON'}) { # had a polygon definition $start = 1; } else { $start = 1; } if ($start) { # EHAA-FIR N052.08.37.000 E006.52.37.999 N052.07.04.040 E006.50.12.959 if ($cnt >= 5) { ${$rparams}{'IN_POLYGON'} = 1; ${$rparams}{'POLY_PT_CNT'} = 0; $name = $arr[0]; for ($off = 1; $off < $cnt; $off++) { last if ($arr[$off] =~ /^\w{1}\d+/); $name .= " $arr[$off]"; } $lat1 = decode_lat($arr[$off]); $off++; $lon1 = decode_lat($arr[$off]); $off++; $lat2 = decode_lat($arr[$off]); $off++; $lon2 = decode_lat($arr[$off]); prt( "[v9] $name $lat1 $lon1 $lat2 $lon2\n" ) if (VERB9()); ${$rh}{$name} = [ ] if (! defined ${$rh}{$name}); $rll = ${$rh}{$name}; push(@{$rll}, [ $lat1, $lon1, $lat2, $lon2 ]); for (; $i < $lncnt; $i++) { $line = ${$rlines}[$i]; $line = trim_all($line); next if (length($line) == 0); if ($line =~ /^\s*;/) { next; } if ($line =~ /^\s*\[/) { $i--; last; } @arr = split(/\s+/,$line); $cnt = scalar @arr; if ($cnt >= 5) { $i--; last; } $lat1 = decode_lat($arr[0]); $lon1 = decode_lat($arr[1]); $lat2 = decode_lat($arr[2]); $lon2 = decode_lat($arr[3]); prt( " [v9] $lat1 $lon1 $lat2 $lon2\n" ) if (VERB9()); push(@{$rll}, [ $lat1, $lon1, $lat2, $lon2 ]); } ${$ri} = $i; ${$rparams}{'IN_POLYGON'} = 0; } else { pgm_exit(1,"ERROR: OUT OF SYNC\n"); } } } sub get_sid_sample() { my $stg = <<EOF; [SID] ;AMSTERDAM HELIPORT ROTOR DEPARTURE EHHA ROTOR-DEP016 N052.24.48.000 E004.48.15.000 N052.25.10.000 E004.48.25.000 N052.25.10.000 E004.48.25.000 N052.25.11.000 E004.48.46.000 N052.25.11.000 E004.48.46.000 N052.24.23.000 E004.49.14.000 N052.24.23.000 E004.49.14.000 N052.24.22.000 E004.50.04.000 N052.24.22.000 E004.50.04.000 N052.24.04.000 E004.50.48.000 N052.24.04.000 E004.50.48.000 N052.25.00.000 E004.51.51.000 N052.25.00.000 E004.51.51.000 ROTOP ROTOP EHHA ROTOR-DEP196 N052.24.48.000 E004.48.15.000 N052.24.29.000 E004.48.07.000 N052.24.29.000 E004.48.07.000 N052.24.28.000 E004.49.04.000 EOF return $stg; } sub get_stars_sample() { my $stg = <<EOF; [STAR] FUEL-CAROL TRACK N053.24.49.190 E003.56.31.138 N053.26.09.775 E003.57.34.415 N053.13.24.959 E005.45.06.840 N053.13.24.961 E004.09.54.402 N053.14.33.181 E004.02.47.372 N053.15.24.141 E004.00.45.297 N053.15.24.141 E004.00.45.297 N053.16.26.975 E003.58.59.907 ;STARS FOR EHAM EHAM-EELDE 1A EEL EEL NOVEN NOVEN NOVEN NOVEN ARTIP ARTIP EHAM-EELDE 1B EEL EEL NARSO NARSO NARSO NARSO ARTIP ARTIP EHAM-NORKU 2A NORKU NORKU SONSA SONSA SONSA SONSA ROBIS ROBIS ROBIS ROBIS OSKUR OSKUR OSKUR OSKUR ARTIP ARTIP EHAM-NORKU 2B NORKU NORKU SONSA SONSA SONSA SONSA NARSO NARSO NARSO NARSO ARTIP ARTIP EOF return $stg; } sub get_sid_star($) { my ($rparams) = @_; my ($rh,$line,$ri,$lncnt,$rlines,$heading); my (@arr,$cnt); my ($name,$lat1,$lon1,$lat2,$lon2); my ($rll,$i,$start,$off,$done); $done = ${$rparams}{'DONE_SID_STAR'}; $rh = ${$rparams}{'REF_HASH'}; $line = ${$rparams}{'CURR_LINE'}; $ri = ${$rparams}{'CNT_PTR'}; $lncnt = ${$rparams}{'LINE_CNT'}; $rlines = ${$rparams}{'REF_FILE_LINES'}; $heading = ${$rparams}{'LAST_HEADING'}; $line = trim_all($line); return if ($line =~ /^\[/); $i = ${$ri}; while ($line =~ /^;/) { $line = substr($line,1); $line = trim_all($line); $heading = $line if (length($line)); $i++; $line = ${$rlines}[$i]; $line = trim_all($line); } @arr = split(/\s+/,$line); $cnt = scalar @arr; if (defined ${$rparams}{'IN_POLYGON'}) { # had a polygon definition $start = 1; } else { $start = 1; } if ($start) { # ;AMSTERDAM HELIPORT ROTOR DEPARTURE # EHHA ROTOR-DEP016 N052.24.48.000 E004.48.15.000 N052.25.10.000 E004.48.25.000 # more of same # N052.25.00.000 E004.51.51.000 ROTOP ROTOP # change name # ;RWY 06 # EHAM 06-ANDIK 1R N052.17.21.000 E004.44.14.000 N052.20.16.000 E004.51.50.000 if ($cnt >= 5) { ${$rparams}{'IN_POLYGON'} = 1; ${$rparams}{'POLY_PT_CNT'} = 0; $off = 0; $name = $arr[$off]; for ($off = 1; $off < $cnt; $off++) { last if (($cnt - $off) <= 4); last if ($arr[$off] =~ /^\w{1}\d+/); $name .= " $arr[$off]"; } if (($off + 3) < $cnt) { $lat1 = decode_lat($arr[$off]); $off++; $lon1 = decode_lat($arr[$off]); $off++; $lat2 = decode_lat($arr[$off]); $off++; $lon2 = decode_lat($arr[$off]); prt( "[v9] $name $lat1 $lon1 $lat2 $lon2\n" ) if (VERB9()); ${$rh}{$name} = [ ] if (! defined ${$rh}{$name}); $rll = ${$rh}{$name}; push(@{$rll}, [ $lat1, $lon1, $lat2, $lon2 ]); $i++; for (; $i < $lncnt; $i++) { $line = ${$rlines}[$i]; $line = trim_all($line); next if (length($line) == 0); if ($line =~ /^;/) { $line = substr($line,1); $line = trim_all($line); $heading = $line if (length($line)); next; } if ($line =~ /^\s*\[/) { # encountered section $i--; last; } @arr = split(/\s+/,$line); $cnt = scalar @arr; if ($cnt >= 5) { $i--; last; # END the current polygon } if ($cnt == 4) { $lat1 = decode_lat($arr[0]); $lon1 = decode_lat($arr[1]); $lat2 = decode_lat($arr[2]); $lon2 = decode_lat($arr[3]); } else { pgm_exit(1,"ERROR:3: OUT OF SYNC [$line] count $cnt\n"); } prt( " [v9] $lat1 $lon1 $lat2 $lon2\n" ) if (VERB9()); push(@{$rll}, [ $lat1, $lon1, $lat2, $lon2 ]); } ${$rparams}{'IN_POLYGON'} = 0; } else { pgm_exit(1,"ERROR:1: OUT OF SYNC [$line]\n"); } } else { pgm_exit(1,"ERROR:2: OUT OF SYNC [$line]\n"); } } ${$ri} = $i; # update line change, if any if (!defined ${$rparams}{$done}) { ${$rparams}{$done} = 1; } } sub get_sid($) { my ($rparams) = @_; ${$rparams}{'DONE_SID_STAR'} = "DONE_SID"; get_sid_star($rparams); } sub get_star($) { my ($rparams) = @_; ${$rparams}{'DONE_SID_STAR'} = "DONE_STAR"; get_sid_star($rparams); } sub get_geo_sample() { my $stg = <<EOF; [GEO] ; NEDERLANDSE KUSTLIJN N049.46.04.318 E000.22.00.095 N049.46.10.654 E000.22.13.825 Coast N049.46.10.654 E000.22.13.825 N049.46.19.103 E000.22.27.552 Coast N049.46.19.103 E000.22.27.552 N049.46.24.384 E000.22.44.450 Coast ;Taxiways5 N051.57.18.390 E004.26.11.129 N051.57.18.423 E004.26.11.354 Taxiway N051.57.18.423 E004.26.11.354 N051.57.18.427 E004.26.11.402 Taxiway N051.57.18.427 E004.26.11.402 N051.57.18.352 E004.26.11.441 Taxiway ;EHR9 EHAA HARSKAMP SURFACE-005600AGL N052.09.29.998 E005.52.50.600 N052.07.29.999 E005.52.50.600 Restrict N052.09.20.599 E005.43.59.998 N052.11.30.200 E005.46.59.998 Restrict N052.07.29.999 E005.52.50.600 N052.06.39.999 E005.45.45.394 Restrict N052.11.30.200 E005.46.59.998 N052.09.29.998 E005.52.50.600 Restrict N052.06.39.999 E005.45.45.394 N052.09.20.599 E005.43.59.998 Restrict EOF return $stg; } sub get_sg_dist_hdg($$) { my ($sg_dist,$sg_az1) = @_; my $sg_km = $sg_dist / 1000; my $sg_im = int($sg_dist); my $sg_ikm = int($sg_km + 0.5); # if (abs($sg_pdist) < $CP_EPSILON) my $dist_hdg = "(SG: "; $sg_az1 = int(($sg_az1 * 10) + 0.05) / 10; if (abs($sg_km) > $SG_EPSILON) { # = 0.0000001; # EQUALS SG_EPSILON 20101121 if ($sg_ikm && ($sg_km >= 1)) { $sg_km = int(($sg_km * 10) + 0.05) / 10; $dist_hdg .= "$sg_km km"; } else { $dist_hdg .= "$sg_im m, <1km"; } } else { $dist_hdg .= "0 m"; } $dist_hdg .= " on $sg_az1"; $dist_hdg .= ")"; return $dist_hdg; } sub get_sg_dist_dir($$$$) { my ($lat1,$lon1,$lat2,$lon2) = @_; my ($sg_az1,$sg_az2,$sg_dist); my $res = fg_geo_inverse_wgs_84 ($lat1,$lon1,$lat2,$lon2,\$sg_az1,\$sg_az2,\$sg_dist); my $sg_km = $sg_dist / 1000; my $sg_im = int($sg_dist); my $sg_ikm = int($sg_km + 0.5); # if (abs($sg_pdist) < $CP_EPSILON) my $dist_hdg = "(SG: "; $sg_az1 = int(($sg_az1 * 10) + 0.05) / 10; if (abs($sg_km) > $SG_EPSILON) { # = 0.0000001; # EQUALS SG_EPSILON 20101121 if ($sg_ikm && ($sg_km >= 1)) { $sg_km = int(($sg_km * 10) + 0.05) / 10; $dist_hdg .= "$sg_km km"; } else { $dist_hdg .= "$sg_im m, <1km"; } } else { $dist_hdg .= "0 m"; } $dist_hdg .= " on $sg_az1"; $dist_hdg .= ")"; return $dist_hdg; } sub show_geo($) { my ($rh) = @_; my ($key,$rquad,$lat1,$lon1,$lat2,$lon2,$i,$cnt,$max); foreach $key (keys %{$rh}) { $rquad = ${$rh}{$key}; $max = scalar @{$rquad}; $cnt = 0; for ($i = 0; $i < $max; $i++) { $cnt++; $lat1 = ${$rquad}[$i][0]; $lon1 = ${$rquad}[$i][1]; $lat2 = ${$rquad}[$i][2]; $lon2 = ${$rquad}[$i][3]; if (($lat1 =~ /^\w+$/)||($lon1 =~ /^\w+$/)||($lat2 =~ /^\w+$/)||($lon2 =~ /^\w+$/) ) { prt("GEO: $lat1 $lon1 $lat2 $lon2 $key\n"); } else { my $sgdd = get_sg_dist_dir($lat1,$lon1,$lat2,$lon2); prt("GEO: $key $lat1 $lon1 $lat2 $lon2 $sgdd\n"); } } } } sub get_geo($$) { my ($rh,$stg) = @_; $stg = trim_all($stg); return if ($stg =~ /^;/); my @arr = split(/\s+/,$stg); my $cnt = scalar @arr; if ($cnt >= 5) { my ($lat1,$lon1,$lat2,$lon2,$type,$rquad,$i); $lat1 = decode_lat($arr[0]); $lon1 = decode_lat($arr[1]); $lat2 = decode_lat($arr[2]); $lon2 = decode_lat($arr[3]); $type = $arr[4]; if ($cnt > 5) { for ($i = 5; $i < $cnt; $i++) { $type .= " $arr[$i]"; } } ${$rh}{$type} = [ ] if (!defined ${$rh}{$type}); $rquad = ${$rh}{$type}; push(@{$rquad}, [ $lat1, $lon1, $lat2, $lon2 ]); prt("[v9] GEO: $type [ $lat1 $lon1 $lat2 $lon2 ]\n") if (VERB9()); show_geo($rh) if (VERB5()); } else { prtw("WARNING: GEO LINE FAILED [$stg]\n"); } } sub process_in_file($) { my ($inf) = @_; if (! open INF, "<$inf") { pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); } my @lines = <INF>; close INF; my $lncnt = scalar @lines; prt("Processing $lncnt lines, from [$inf]...\n"); my ($line,$inc,$lnn,$section,$heading); my ($inap,$invor,$inndb,$infix,$rh,$rinfo,$dosave,$inawy,$inartcc,$insid,$instar,$ingeo); my ($i,$tline,$stg); $lnn = 0; $inap = 0; $invor = 0; $inndb = 0; $infix = 0; $inawy = 0; $inartcc = 0; $insid = 0; $instar = 0; $ingeo = 0; $section = ''; my %h = (); my %params = (); my $rparams = \%params; $dosave = 0; for ($i = 0; $i < $lncnt; $i++) { $line = $lines[$i]; chomp $line; $lnn++; $tline = trim_all($line); # ; --- Version: 00:00:00 27-OCT-05 next if ($line =~ /^\s*;\s+---\s+/); # skip top comments if ($line =~ /\s*\#/) { # looks like colors # prt("$lnn: $line\n"); } elsif ($line =~ /^\s*\[(\w+)\]/) { $section = $1; prt("$lnn: Section: $section\n"); } elsif ($line =~ /^\s*\[(.+)\]/) { $section = $1; prt("$lnn: section: $section\n"); } elsif ($line =~ /^\s*;(.+)$/) { $heading = trim_all($1); #prt("$lnn: head: $heading\n"); } $dosave = 0; $inap = ($section eq 'Airport') ? 1 : 0; $invor = ($section eq 'VOR') ? 1 : 0; $inndb = ($section eq 'NDB') ? 1 : 0; $infix = ($section eq 'Fixes') ? 1 : 0; $inawy = (($section eq 'HIGH AIRWAY')||($section eq 'LOW AIRWAY')) ? 1 : 0; $inartcc = ($section =~ /^ARTCC/) ? 1 : 0; $insid = ($section eq 'SID') ? 1 : 0; $instar = ($section eq 'STAR') ? 1 : 0; $ingeo = ($section eq 'GEO') ? 1 : 0; if ($inap) { $stg = $tline; if ($stg =~ /^(\w+)\s+(\d+\.\d+)\s+/) { $rh = get_annon_hash(); get_airport($rh,$line); $dosave = 1; $g_ap_count++; } } if ($invor) { if ($line =~ /^\w+\s+\d+\.\d+\s+/) { $rh = get_annon_hash(); get_vor($rh,$line); $dosave = 1; $g_vor_count++; } } if ($inndb) { if ($line =~ /^\w+\s+\d+\.\d+\s+/) { $rh = get_annon_hash(); get_ndb($rh,$line); $dosave = 1; $g_ndb_count++; } } if ($infix) { if ($tline =~ /^;/) { $tline = substr($tline,1); $tline = trim_all($tline); prt("[v9] FIX: Comment [$tline]\n") if (length($tline) && VERB9()); } elsif ((length($tline) == 0)||($tline =~ /^\s+$/)) { # blank line } else { # hopefully a VALID fix entry $rh = get_annon_hash(); get_fix($rh,$line); $dosave = 1; $g_fix_count++; } } if ($inawy) { $stg = $tline; if ($stg =~ /^\[/) { # should have been END... } elsif ($stg =~ /^;/) { $stg = substr($stg,1); $stg = trim_all($stg); prt("[v9] AWY: Comment [$stg]\n") if (length($stg) && VERB9()); } elsif ((length($stg) == 0)||($stg =~ /^\s+$/)) { # blank line } else { $rh = get_annon_hash(); get_awy($rh,$line); $dosave = 1; $g_awy_count++; } } if ($inartcc) { $rh = get_annon_hash(); ${$rparams}{'REF_HASH'} = $rh; ${$rparams}{'CURR_LINE'} = $line; ${$rparams}{'CNT_PTR'} = \$i; ${$rparams}{'LINE_CNT'} = $lncnt; ${$rparams}{'REF_FILE_LINES'} = \@lines; ${$rparams}{'LAST_HEADING'} = $heading; get_artcc($rparams); $dosave = 1; $g_atcc_count++; } if ($insid || $instar) { $rh = get_annon_hash(); ${$rparams}{'REF_HASH'} = $rh; ${$rparams}{'CURR_LINE'} = $line; ${$rparams}{'CNT_PTR'} = \$i; ${$rparams}{'LINE_CNT'} = $lncnt; ${$rparams}{'REF_FILE_LINES'} = \@lines; ${$rparams}{'LAST_HEADING'} = $heading; if ($insid) { get_sid($rparams); $g_sid_count++; } else { $g_star_count++; get_star($rparams); } $dosave = 1; } if ($ingeo) { if ($tline =~ /^;/) { # comments / headings - depends } elsif ($tline =~ /^\[/) { # this is a section line - should be OUT OF HERE } elsif (length($tline)) { $rh = get_annon_hash(); get_geo($rh,$line); $dosave = 1; $g_geo_count++; } } if ($dosave) { $h{$section} = [ ] if (! defined $h{$section} ); $rinfo = $h{$section}; push(@{$rinfo},$rh); } } prt("A/P $g_ap_count, VOR $g_vor_count, NBD $g_ndb_count, FIX $g_fix_count, SID $g_sid_count, STAR $g_star_count, ATCC $g_atcc_count, AWY $g_awy_count, GEO $g_geo_count\n"); return \%h; } # 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 @fg_navset = ($navNDB, $navVOR, $navILS, $navLOC, $navGS, $navOM, $navMM, $navIM, $navVDME, $navNDME); my @fg_navtypes = qw( NDB VOR ILS LOC GS OM NM IM VDME NDME ); sub is_nav_valid($$) { # my ($t,$rtype) = @_; if ($t && length($t)) { my $txt = "$t"; my $cnt = 0; foreach my $n (@fg_navset) { if ($n eq $txt) { ${$rtype} = $fg_navtypes[$cnt]; return 1; } $cnt++; } } return 0; } sub get_fg_nav_item_stg($) { my ($rni) = @_; my $cnt = scalar @{$rni}; my ($ic,$typ,$nlat,$nlon,$nalt,$nfrq,$nrng,$nfrq2,$nid,$name,$off,$dist,$az,$line); my ($atyp,$stg); my $msg = ""; my $nicnt = scalar @{$rni}; $typ = ${$rni}[0]; $nlat = ${$rni}[1]; $nlon = ${$rni}[2]; $nalt = ${$rni}[3]; $nfrq = ${$rni}[4]; $nrng = ${$rni}[5]; $nfrq2 = ${$rni}[6]; $nid = ${$rni}[7]; $name = ${$rni}[8]; $off = ${$rni}[9]; $dist = ${$rni}[10]; $az = ${$rni}[11]; if (!is_nav_valid($typ,\$atyp)) { # set my $actnav pgm_exit(1,"ERROR: INTERNAL: get_fg_nav_item_stg passed INVALID ref. navaid obj.\n"); } if ($use_fg_format) { $msg = format_fg_nav_stg($atyp,$nlat,$nlon,$nalt,$nfrq,$nrng,$nfrq2,$nid,$name); } else { # return "$type $id $freq $lat $lon $name"; # agreed mods of output only my ($dlat,$dlon); $nid = trim_all($nid); # pad_nav_id(\$nid); $nid .= ' ' while (length($nid) < $g_maxidl); $atyp .= ' ' while (length($atyp) < $maxnnlen); if ($use_6_decimal_lat_lon) { $dlat = (int($nlat * 1000000)) / 1000000; $dlon = (int($nlon * 1000000)) / 1000000; $dlat = sprintf("%3.6f",$dlat); $dlon = sprintf("%4.6f",$dlon); } else { $dlat = (int($nlat * 100000000)) / 100000000; $dlon = (int($nlon * 100000000)) / 100000000; $dlat = sprintf("%3.8f",$dlat); $dlon = sprintf("%4.8f",$dlon); } $msg = "$atyp $nid $nfrq $dlat $dlon $name"; } return $msg; } sub get_fg_nav_list_stg($) { my ($rnl) = @_; my $cnt = scalar @{$rnl}; my ($ic,$typ,$nlat,$nlon,$nalt,$nfrq,$nrng,$nfrq2,$nid,$name,$off,$dist,$az,$line); my ($actnav); my $msg = "$g_nav_hdr\n"; for ($ic = 0; $ic < $cnt; $ic++) { $typ = ${$rnl}[$ic][0]; $nlat = ${$rnl}[$ic][1]; $nlon = ${$rnl}[$ic][2]; $nalt = ${$rnl}[$ic][3]; $nfrq = ${$rnl}[$ic][4]; $nrng = ${$rnl}[$ic][5]; $nfrq2 = ${$rnl}[$ic][6]; $nid = ${$rnl}[$ic][7]; $name = ${$rnl}[$ic][8]; $off = ${$rnl}[$ic][9]; $dist = ${$rnl}[$ic][10]; $az = ${$rnl}[$ic][11]; $nalt = ' '.$nalt while (length($nalt) < $g_maxnaltl); $nfrq = ' '.$nfrq while (length($nfrq) < $g_maxnfrql); $nrng = ' '.$nrng while (length($nrng) < $g_maxnrngl); $nfrq2 = ' '.$nfrq2 while (length($nfrq2) < $g_maxnfq2l); $nid = ' '.$nid while (length($nid) < $g_maxnnidl); $nlat = ' '.$nlat while (length($nlat) < $g_maxnlatl); $nlon = ' '.$nlon while (length($nlon) < $g_maxnlonl); #is_valid_nav($typ); # set global $actnav is_nav_valid($typ,\$actnav); # set my $actnav $line = $actnav; $line .= ' ' while (length($line) < $maxnnlen); $line .= ' '; $line .= "$nlat, $nlon, $nalt, $nfrq, $nrng, $nfrq2, $nid, $name"; $msg .= "$line\n"; } return $msg; } sub load_fg_nav_file() { if (!$done_fg_nav) { # my $NAVFILE = "$FGROOT/Navaids/nav.dat.gz"; # the NAV, NDB, etc. data file if (-f $NAVFILE) { my $rnls = load_gzip_file($NAVFILE); my ($line,$lnn,$len,$nc,$vcnt); my ($nlat,$nlon,$nalt,$nfreq,$nid,$name,$i,$ln); my (@arr,$typ,$off,$nfrq,$nfrq2,$nrng,$dist,$az,$fg_type); my $nav_cnt = scalar @{$rnls}; my @navlist = (); for ($ln = 0; $ln < $nav_cnt; $ln++) { $line = ${$rnls}[$ln]; $line = trim_all($line); $len = length($line); $lnn++; next if ($line =~ /\s+Version\s+/i); next if ($line =~ /^I/); next if ($len == 0); @arr = split(/ /,$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"); } # Check for type number in @navset, and set $actnav to name, like VOR, NDB, etc #if ( is_valid_nav($typ) ) { if ( is_nav_valid($typ,\$fg_type) ) { $vcnt++; $nlat = $arr[1]; $nlon = $arr[2]; $nalt = $arr[3]; $nfrq = $arr[4]; $nrng = $arr[5]; $nfrq2 = $arr[6]; $nid = $arr[7]; $name = ''; $nfrq /= 100; $nfrq = sprintf("%3.3f",$nfrq); for ($i = 8; $i < $nc; $i++) { $name .= ' ' if length($name); $name .= $arr[$i]; } push(@navlist, [$typ, $nlat, $nlon, $nalt, $nfrq, $nrng, $nfrq2, $nid, $name, $off, $dist, $az, $fg_type]); } } $g_fg_nav_list = \@navlist; } else { pgm_exit(1,"ERROR: Unable to LOAD [$NAVFILE]! FIX ME!!\n"); } $done_fg_nav = 1; } return $done_fg_nav; } sub not_in_world_range($$) { my ($lt,$ln) = @_; return 1 if ($lt < -90); return 1 if ($lt > 90); return 1 if ($ln < -180); return 1 if ($ln > 180); return 0; } my $g_max_range_km = 5; # range search using KILOMETERS # like sub near_an_airport { sub is_near_my_point($$$$$$$) { my ($lt, $ln, $alat, $alon, $max_rng_km, $rdist, $raz) = @_; return 0 if (!defined $lt || !defined $ln || !defined $alat || !defined $alon); return 0 if (not_in_world_range($lt,$ln)||not_in_world_range($alat,$alon)); my ($az1, $az2, $s, $ret); my ($x,$y,$z) = fg_ll2xyz($ln,$lt); # get cart x,y,z my $d2 = $max_rng_km * 1000; # get meters my $ngp_ret = 0; my ($xb, $yb, $yz) = fg_ll2xyz($alon, $alat); my $dst = sqrt( fg_coord_dist_sq( $x, $y, $z, $xb, $yb, $yz ) ) * $DIST_FACTOR; if ($dst < $d2) { $s = -1; $az1 = -1; $ret = fg_geo_inverse_wgs_84($alat, $alon, $lt, $ln, \$az1, \$az2, \$s); ${$rdist} = $s; ${$raz} = $az1; $ngp_ret = 1; } return $ngp_ret; } # 0=typ, 1=lat, 2=lon, 3=alt, 4=frq, 5-rng, 6-frq2, 7=nid, 8=name, 9=off, 10=dist, 11=az); sub mycmp_decend_dist { return -1 if (${$a}[10] < ${$b}[10]); return 1 if (${$a}[10] > ${$b}[10]); return 0; } sub find_closest_fg_nav($$$$$$$$) { my ($type,$id,$freq,$lat,$lon,$name,$rfnd,$dkm) = @_; load_fg_nav_file(); my $rnl = $g_fg_nav_list; my $max = scalar @{$rnl}; my ($i,$ra,$nlat,$nlon,$dist,$az,$cnt); if (!defined $lat || !defined $lon) { pgm_exit(1,"ERROR: INTERNAL: BOGUS CALL TO find_closest_fg_nav!\n"); } $cnt = 0; my @navsfnd = (); my ($typ,$nalt,$nfrq,$nrng,$nfrq2,$nid,$off); for ($i = 0; $i < $max; $i++) { $ra = ${$rnl}[$i]; $nlat = ${$ra}[1]; $nlon = ${$ra}[2]; if (!defined $nlat || !defined $nlon) { pgm_exit(1,"ERROR: INTERNAL: Failed to extract lat, lon...\n"); } if ( is_near_my_point($nlat,$nlon,$lat,$lon,$dkm,\$dist,\$az) ) { my $sgdd = get_sg_dist_dir($lat,$lon,$nlat,$nlon); prt("$sgdd ") if (VERB9()); $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]; $off = 0; #prt( "[04] $actnav, $typ, $nlat, $nlon, $nalt, $nfrq, $nrng, $nfrq2, $nid, $name ($off)\n") if ($dbg_fa04); # 0=typ, 1=lat, 2=lon, 3=alt, 4=frq, 5-rng, 6-frq2, 7=nid, 8=name, 9=off, 10=dist, 11=az); push(@navsfnd, [$typ, $nlat, $nlon, $nalt, $nfrq, $nrng, $nfrq2, $nid, $name, $off, $dist, $az]); $cnt++; } } if ($cnt) { my ($rni,$sg_dh); prt("\n") if (VERB9()); @navsfnd = sort mycmp_decend_dist @navsfnd; $max = scalar @navsfnd; if ($show_all_found) { for ($i = 0; $i < $max; $i++) { $rni = $navsfnd[$i]; $name = get_fg_nav_item_stg($rni); $sg_dh = get_sg_dist_hdg(${$rni}[10],${$rni}[11]); prt("$name $sg_dh\n"); } prt("\n"); } else { $rni = $navsfnd[0]; $name = get_fg_nav_item_stg($rni); $sg_dh = get_sg_dist_hdg(${$rni}[10],${$rni}[11]); prt("$name $sg_dh\n"); } } ${$rfnd} = \@navsfnd; return 1; } sub list_per_section($$) { my ($section,$within) = @_; my $rsct = $ghr_loaded; # = process_in_file($in_file); # an avio SCT (SectorFiles) my ($sect,$navcnt); my ($rh,$type,$id,$freq,$lat,$lon,$name,$ns,$rca); $navcnt = 0; prt("\nRedisplay of [$section]... plus FG objects within $within km...\n"); foreach $sect (keys %{$rsct}) { if ($sect eq $section) { my $rinfo = ${$rsct}{$sect}; # get array (of arrays) reference my $cnt = scalar @{$rinfo}; # get entries foreach $rh (@{$rinfo}) { $ns = get_nav_stg($rh); prt("$ns (SCT)\n"); if ( set_nav_vars($rh,\$type,\$id,\$freq,\$lat,\$lon,\$name) ) { ##if ( set_nav_ll($rh,\$lat,\$lon) ) { if ( find_closest_fg_nav($type,$id,$freq,$lat,$lon,$name,\$rca,$within)) { $cnt = scalar @{$rca}; #prt("Shown 1 of $cnt within 10 degrees...\n"); } } $navcnt++; } last; } } if ($navcnt) { prt("Shown: $navcnt [$section] navaids.\n"); } else { prt("[$section] is NOT on file..."); } } sub list_all_vors() { list_per_section('VOR',10); } ######################################### ### MAIN ### parse_args(@ARGV); ###prt( "$pgmname: in [$cwd]: Hello, World...\n" ); #process_in_file($in_file); $ghr_loaded = process_in_file($in_file); # some tests # list_all_vors(); prt("A/P $g_ap_count, VOR $g_vor_count, NBD $g_ndb_count, FIX $g_fix_count, SID $g_sid_count, STAR $g_star_count, ATCC $g_atcc_count, AWY $g_awy_count, GEO $g_geo_count\n"); pgm_exit(0,"Normal exit(0)"); ######################################## sub give_help { prt("$pgmname: version 0.0.1 2010-09-11\n"); prt("Usage: $pgmname [options] in-file\n"); prt("Options:\n"); prt(" --help (-h or -?) = This help, and exit 0.\n"); } sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have following argument!\n") if (!@av); } sub parse_args { my (@av) = @_; my ($arg,$sarg); 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 =~ /^l/i) { $load_log = 1; } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_file = $arg; prt("Set input to [$in_file]\n"); } shift @av; } if ((length($in_file) == 0) && $debug_on) { $in_file = $def_file; } if (length($in_file) == 0) { pgm_exit(1,"ERROR: No input files found in command!\n"); } if (! -f $in_file) { pgm_exit(1,"ERROR: Unable to find in file [$in_file]! Check name, location...\n"); } } # eof - template.pl