--- /dev/null
+#!/usr/bin/perl -w
+# $Id$
+# Melchior FRANZ <mfranz#aon:at> Public Domain
+#
+# Usage: $ freq [IACO:ksfo [RANGE:15]]
+#
+# Examples: $ freq
+# $ freq ksjc
+# $ freq ksjc 30
+#
+# The RANGE is in km and defines which NDB, VOR, VORTAC, ... to
+# display. Default is 15 km.
+#
+# Note that the directions given for NDB, VOR, VORTAC, ... are
+# always the heading from this radio facility to the airport!
+
+use strict;
+use POSIX qw(ceil floor);
+
+my $ID = shift || "KSFO";
+my $RANGE = shift || 15; # for NDB/VOR [km]
+
+my $FG_ROOT = $ENV{'FG_ROOT'} || "/usr/local/share/FlightGear";
+my $APTFILE = "$FG_ROOT/Airports/apt.dat.gz" || die "airport file not found";
+my $NAVFILE = "$FG_ROOT/Navaids/nav.dat.gz" || die "nav file not found";
+
+$ID = uc($ID);
+my $PI = 3.1415926535897932384626433832795029;
+my $D2R = $PI / 180;
+my $R2D = 180 / $PI;
+my $ERAD = 6378138.12;
+my %COLOR = (
+ 'NONE' => "\033[m",
+ 'DME' => "\033[34;1",
+ 'ILS' => "\033[33;1m",
+ 'TWR' => "\033[31;1m",
+ 'ATIS' => "\033[32;1m",
+ 'NDB' => "\033[36;1m",
+ 'VOR' => "\033[35;1m",
+);
+my $USECOLOR = 1;
+
+my %FREQ;
+
+my $aptdatacnt = 0;
+my $aptlat = 0;
+my $aptlon = 0;
+
+open(F, "gzip -d -c $APTFILE|") or die "can't open airport file $APTFILE";
+while (<F>) {
+ if (/^1\s+\S+\s+\S+\s+\S+\s+$ID\s+(.+)\s+/) {
+ my $title = "$ID - $1";
+ print "$title\n";
+ print "=" x length($title) . "\n";
+
+ foreach (<F>) {
+ chomp;
+ last if /^\s*$/;
+
+ if (/^1.\s+(\S+)\s+(\S+)\s+/) {
+ my ($lat, $lon) = ($1, $2);
+ map { s/^(-?)0+/$1/ } ($lat, $lon);
+ $aptlat += $lat;
+ $aptlon += $lon;
+ $aptdatacnt++;
+ } elsif (/^(5\d+)\s+(\d+)\s+(.*)\s*/) {
+ my ($id, $freq, $desc) = ($1, $2, $3);
+ $freq =~ s/(..)$/.$1/;
+ &addfreq($freq, $desc);
+ }
+ }
+ last;
+ }
+}
+close F or die "can't close airport file $APTFILE";
+
+die "no data for $ID" unless $aptdatacnt;
+
+# calculate mean location from all structures on the airport
+$aptlat /= $aptdatacnt;
+$aptlon /= $aptdatacnt;
+my ($aptx, $apty, $aptz) = &ll2xyz($aptlat, $aptlon);
+
+
+my @OM;
+my @MM;
+my @IM;
+my @NDB;
+my @VOR;
+my @DME;
+my @OTHERS;
+
+open(F, "gzip -d -c $NAVFILE|") or die "can't open airport file $NAVFILE";
+while (<F>) {
+ chomp;
+ if (/^2\s/) { # NDB
+ my @l = split /\s+/, $_, 9;
+ map { s/^(-?)0+/$1/ } @l[1,2];
+ my $dist = &coord_dist_sq(&ll2xyz($l[1], $l[2]), $aptx, $apty, $aptz);
+ push @NDB, [$dist, @l];
+
+ } elsif (/^3\s/) { # VOR/VOR-DME/DME/VORTAC/TACAN
+ my @l = split /\s+/, $_, 9;
+ map { s/^(-?)0+/$1/ } @l[1,2];
+ my $dist = &coord_dist_sq(&ll2xyz($l[1], $l[2]), $aptx, $apty, $aptz);
+ if ($l[8] =~ /\b(VOR|VOR-DME)$/) {
+ push @VOR, [$dist, @l];
+ } elsif ($l[8] =~ /\bDME\b/) {
+ push @DME, [$dist, @l];
+ } else {
+ push @OTHERS, [$dist, @l];
+ }
+
+ } elsif (/^(4|5)\s/) { # LLZ
+ my @l = split /\s+/, $_, 11;
+ next unless $l[8] eq $ID;
+ $l[4] =~ s/(..)$/.$1/;
+ &addfreq($l[4], "LLZ " . $l[9]);
+
+ } elsif (/^6\s/) { # GS
+ my @l = split /\s+/, $_, 11;
+ next unless $l[8] eq $ID;
+ $l[4] =~ s/(..)$/.$1/;
+ &addfreq($l[4], "GS " . $l[9]);
+
+ } elsif (/^7\s/) { # OM
+ my @l = split /\s+/, $_, 11;
+ next unless $l[8] eq $ID;
+ push @OM, $l[9];
+
+ } elsif (/^8\s/) { # MM
+ my @l = split /\s+/, $_, 11;
+ next unless $l[8] eq $ID;
+ push @MM, $l[9];
+
+ } elsif (/^9\s/) { # IM
+ my @l = split /\s+/, $_, 11;
+ next unless $l[8] eq $ID;
+ push @IM, $l[9];
+
+ } elsif (/^12\s/) { # DME (ILS)
+ my @l = split /\s+/, $_, 11;
+ next unless $l[8] eq $ID;
+ $l[4] =~ s/(..)$/.$1/;
+ &addfreq($l[4], "DME " . $l[9]);
+
+ }
+}
+close F or die "can't close airport file $NAVFILE";
+
+
+foreach my $freq (sort { $a <=> $b } keys %FREQ) {
+ my %h;
+ map { $h{$_} = 1 } @{$FREQ{$freq}};
+ my @uniq = keys %h;
+
+ my @desc;
+ my %rwy;
+ foreach my $d (@uniq) {
+ if ($d =~ /(\S*)\s*(\d\d[LRC]?)\s*(\S*)/) {
+ push @{$rwy{$2}}, ($1 . $3);
+ } else {
+ push @desc, $d;
+ }
+ }
+ foreach my $r (keys %rwy) {
+ push @desc, ((join "/", sort @{$rwy{$r}}) . " $r");
+ }
+
+ my $s;
+ my $k = join ", ", @desc;
+ if ($k =~ /\bTWR\b/) {
+ $s = $COLOR{'TWR'};
+ } elsif ($k =~ /\bATIS\b/) {
+ $s = $COLOR{'ATIS'};
+ } elsif ($k =~ /\b(GZ|LLZ)\b/) {
+ $s = $COLOR{'ILS'};
+ }
+ $s .= sprintf "%-7s %s\033[m\n", $freq, join ", ", $k;
+ print $s;
+}
+
+
+&printfreq(0, $COLOR{'NDB'}, @NDB);
+&printfreq(1, $COLOR{'VOR'}, @VOR);
+&printfreq(1, $COLOR{'DME'}, @DME);
+&printfreq(1, $COLOR{'NONE'}, @OTHERS);
+
+print " OM " . (join ", ", sort @OM) . "\n" if @OM;
+print " MM " . (join ", ", sort @MM) . "\n" if @MM;
+print " IM " . (join ", ", sort @IM) . "\n" if @IM;
+
+exit 0;
+
+
+
+sub printfreq($$$)
+{
+ my $divfreq = shift; # divide frequency by 100?
+ my $color = shift;
+ foreach (sort { @{$a}[0] <=> @{$b}[0] } @_) {
+ my @l = @{$_};
+ my $dist = &distance($l[0]);
+ my $dir = &llll2dir($l[2], $l[3], $aptlat, $aptlon);
+ my $freq = $l[5];
+ $freq =~ s/(..)$/.$1/ if $divfreq;
+ printf "$color%-7s %s (\"%s\")\t-->\t%s km/%s nm @ %s (%s)$COLOR{'NONE'}\n",
+ $freq, $l[9], $l[8],
+ &round($dist, 0.1), # km
+ &round($dist / 1.852, 0.1), # nm
+ int $dir, &symdir($dir);
+ next if $l[9] =~ /\b$ID\b/;
+ last if $dist > $RANGE;
+ }
+}
+
+
+sub addfreq($$)
+{
+ my ($freq, $desc) = @_;
+ push @{$FREQ{$freq}}, $desc;
+}
+
+
+sub distance($) # km
+{
+ my $t = shift;
+ return $ERAD * sqrt($t) / 1000;
+}
+
+
+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 llll2dir($$$$)
+{
+ my $latA = (shift) * $D2R;
+ my $lonA = (shift) * $D2R;
+ my $latB = (shift) * $D2R;
+ my $lonB = (shift) * $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;
+}
+
+
+sub ll2xyz($$)
+{
+ my $lat = (shift) * $D2R;
+ my $lon = (shift) * $D2R;
+ my $cosphi = cos $lat;
+ my $di = $cosphi * cos $lon;
+ my $dj = $cosphi * sin $lon;
+ my $dk = sin $lat;
+ return ($di, $dj, $dk);
+}
+
+
+sub xyz2ll($$$)
+{
+ my ($di, $dj, $dk) = @_;
+ my $aux = $di * $di + $dj * $dj;
+ my $lat = atan2($dk, sqrt $aux) * $R2D;
+ my $lon = atan2($dj, $di) * $R2D;
+ return ($lat, $lon);
+}
+
+
+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 symdir($)
+{
+ my $dir = shift;
+ my @names = ("N", "NNE", "NE", "ENE", "E", "ESE", "SE", "SSE",
+ "S", "SSW", "SW", "WSW", "W", "WNW", "NW", "NNW");
+ my $nnames = scalar @names;
+ my $idx = int($nnames * (($dir / 360) + (0.5 / $nnames)));
+ if ($idx >= $nnames) {
+ $idx = 0;
+ }
+ return $names[$idx];
+}
+
+
projects / flightgear.git / commitdiff