diff --git a/scripts/tools/freq b/scripts/tools/freq new file mode 100755 index 000000000..3ca42c988 --- /dev/null +++ b/scripts/tools/freq @@ -0,0 +1,302 @@ +#!/usr/bin/perl -w +# $Id$ +# Melchior FRANZ 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 () { + 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 () { + 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 () { + 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]; +} + +