scripts/tools/freq

   1 #!/usr/bin/perl -w
   2 # $Id$
   3 # Melchior FRANZ <mfranz#aon:at>        Public Domain
   4 #
   5 # Usage:        $ freq [IACO:ksfo [RANGE:15]]
   6 #
   7 # Examples:     $ freq
   8 #               $ freq ksjc
   9 #               $ freq ksjc 30
  10 #
  11 # The RANGE is in km and defines which NDB, VOR, VORTAC, ... to
  12 # display. Default is 15 km.
  13 #
  14 # Note that the directions given for NDB, VOR, VORTAC, ... are
  15 # always the heading from this radio facility to the airport!
  16
  17 use strict;
  18 use POSIX qw(ceil floor);
  19
  20 my $ID = shift || "KSFO";
  21 my $RANGE = shift || 15;                # for NDB/VOR [km]
  22
  23 my $FG_ROOT = $ENV{'FG_ROOT'} || "/usr/local/share/FlightGear";
  24 my $APTFILE = "$FG_ROOT/Airports/apt.dat.gz" || die "airport file not found";
  25 my $NAVFILE = "$FG_ROOT/Navaids/nav.dat.gz" || die "nav file not found";
  26
  27 $ID = uc($ID);
  28 my $PI = 3.1415926535897932384626433832795029;
  29 my $D2R = $PI / 180;
  30 my $R2D = 180 / $PI;
  31 my $ERAD = 6378138.12;
  32 my %COLOR = (
  33         'NONE' => "\033[m",
  34         'DME'  => "\033[34;1",
  35         'ILS'  => "\033[33;1m",
  36         'TWR'  => "\033[31;1m",
  37         'ATIS' => "\033[32;1m",
  38         'NDB'  => "\033[36;1m",
  39         'VOR'  => "\033[35;1m",
  40 );
  41 my $USECOLOR = 1;
  42
  43 my %FREQ;
  44
  45 my $aptdatacnt = 0;
  46 my $aptlat = 0;
  47 my $aptlon = 0;
  48
  49 open(F, "gzip -d -c $APTFILE|") or die "can't open airport file $APTFILE";
  50 while (<F>) {
  51         if (/^1\s+\S+\s+\S+\s+\S+\s+$ID\s+(.+)\s+/) {
  52                 my $title = "$ID - $1";
  53                 print "$title\n";
  54                 print "=" x length($title) . "\n";
  55
  56                 foreach (<F>) {
  57                         chomp;
  58                         last if /^\s*$/;
  59
  60                         if (/^1.\s+(\S+)\s+(\S+)\s+/) {
  61                                 my ($lat, $lon) = ($1, $2);
  62                                 map { s/^(-?)0+/$1/ } ($lat, $lon);
  63                                 $aptlat += $lat;
  64                                 $aptlon += $lon;
  65                                 $aptdatacnt++;
  66                         } elsif (/^(5\d+)\s+(\d+)\s+(.*)\s*/) {
  67                                 my ($id, $freq, $desc) = ($1, $2, $3);
  68                                 $freq =~ s/(..)$/.$1/;
  69                                 &addfreq($freq, $desc);
  70                         }
  71                 }
  72                 last;
  73         }
  74 }
  75 close F or die "can't close airport file $APTFILE";
  76
  77 die "no data for $ID" unless $aptdatacnt;
  78
  79 # calculate mean location from all structures on the airport
  80 $aptlat /= $aptdatacnt;
  81 $aptlon /= $aptdatacnt;
  82 my ($aptx, $apty, $aptz) = &ll2xyz($aptlat, $aptlon);
  83
  84
  85 my @OM;
  86 my @MM;
  87 my @IM;
  88 my @NDB;
  89 my @VOR;
  90 my @DME;
  91 my @OTHERS;
  92
  93 open(F, "gzip -d -c $NAVFILE|") or die "can't open airport file $NAVFILE";
  94 while (<F>) {
  95         chomp;
  96         if (/^2\s/) {                   # NDB
  97                 my @l = split /\s+/, $_, 9;
  98                 map { s/^(-?)0+/$1/ } @l[1,2];
  99                 my $dist = &coord_dist_sq(&ll2xyz($l[1], $l[2]), $aptx, $apty, $aptz);
 100                 push @NDB, [$dist, @l];
 101
 102         } elsif (/^3\s/) {              # VOR/VOR-DME/DME/VORTAC/TACAN
 103                 my @l = split /\s+/, $_, 9;
 104                 map { s/^(-?)0+/$1/ } @l[1,2];
 105                 my $dist = &coord_dist_sq(&ll2xyz($l[1], $l[2]), $aptx, $apty, $aptz);
 106                 if ($l[8] =~ /\b(VOR|VOR-DME)$/) {
 107                         push @VOR, [$dist, @l];
 108                 } elsif ($l[8] =~ /\bDME\b/) {
 109                         push @DME, [$dist, @l];
 110                 } else {
 111                         push @OTHERS, [$dist, @l];
 112                 }
 113
 114         } elsif (/^(4|5)\s/) {          # LLZ
 115                 my @l = split /\s+/, $_, 11;
 116                 next unless $l[8] eq $ID;
 117                 $l[4] =~ s/(..)$/.$1/;
 118                 &addfreq($l[4], "LLZ " . $l[9]);
 119
 120         } elsif (/^6\s/) {              # GS
 121                 my @l = split /\s+/, $_, 11;
 122                 next unless $l[8] eq $ID;
 123                 $l[4] =~ s/(..)$/.$1/;
 124                 &addfreq($l[4], "GS " . $l[9]);
 125
 126         } elsif (/^7\s/) {              # OM
 127                 my @l = split /\s+/, $_, 11;
 128                 next unless $l[8] eq $ID;
 129                 push @OM, $l[9];
 130
 131         } elsif (/^8\s/) {              # MM
 132                 my @l = split /\s+/, $_, 11;
 133                 next unless $l[8] eq $ID;
 134                 push @MM, $l[9];
 135
 136         } elsif (/^9\s/) {              # IM
 137                 my @l = split /\s+/, $_, 11;
 138                 next unless $l[8] eq $ID;
 139                 push @IM, $l[9];
 140
 141         } elsif (/^12\s/) {             # DME (ILS)
 142                 my @l = split /\s+/, $_, 11;
 143                 next unless $l[8] eq $ID;
 144                 $l[4] =~ s/(..)$/.$1/;
 145                 &addfreq($l[4], "DME " . $l[9]);
 146
 147         }
 148 }
 149 close F or die "can't close airport file $NAVFILE";
 150
 151
 152 foreach my $freq (sort { $a <=> $b } keys %FREQ) {
 153         my %h;
 154         map { $h{$_} = 1 } @{$FREQ{$freq}};
 155         my @uniq = keys %h;
 156
 157         my @desc;
 158         my %rwy;
 159         foreach my $d (@uniq) {
 160                 if ($d =~ /(\S*)\s*(\d\d[LRC]?)\s*(\S*)/) {
 161                         push @{$rwy{$2}}, ($1 . $3);
 162                 } else {
 163                         push @desc, $d;
 164                 }
 165         }
 166         foreach my $r (keys %rwy) {
 167                 push @desc, ((join "/", sort @{$rwy{$r}}) . " $r");
 168         }
 169
 170         my $s;
 171         my $k = join ", ", @desc;
 172         if ($k =~ /\bTWR\b/) {
 173                 $s = $COLOR{'TWR'};
 174         } elsif ($k =~ /\bATIS\b/) {
 175                 $s = $COLOR{'ATIS'};
 176         } elsif ($k =~ /\b(GZ|LLZ)\b/) {
 177                 $s = $COLOR{'ILS'};
 178         }
 179         $s .= sprintf "%-7s %s\033[m\n", $freq, join ", ", $k;
 180         print $s;
 181 }
 182
 183
 184 &printfreq(0, $COLOR{'NDB'}, @NDB);
 185 &printfreq(1, $COLOR{'VOR'}, @VOR);
 186 &printfreq(1, $COLOR{'DME'}, @DME);
 187 &printfreq(1, $COLOR{'NONE'}, @OTHERS);
 188
 189 print "        OM " . (join ", ", sort @OM) . "\n" if @OM;
 190 print "        MM " . (join ", ", sort @MM) . "\n" if @MM;
 191 print "        IM " . (join ", ", sort @IM) . "\n" if @IM;
 192
 193 exit 0;
 194
 195
 196
 197 sub printfreq($$$)
 198 {
 199         my $divfreq = shift;            # divide frequency by 100?
 200         my $color = shift;
 201         foreach (sort { @{$a}[0] <=> @{$b}[0] } @_) {
 202                 my @l = @{$_};
 203                 my $dist = &distance($l[0]);
 204                 my $dir = &llll2dir($l[2], $l[3], $aptlat, $aptlon);
 205                 my $freq = $l[5];
 206                 $freq =~ s/(..)$/.$1/ if $divfreq;
 207                 printf "$color%-7s %s (\"%s\")\t-->\t%s km/%s nm  @  %s (%s)$COLOR{'NONE'}\n",
 208                                 $freq, $l[9], $l[8],
 209                                 &round($dist, 0.1),             # km
 210                                 &round($dist / 1.852, 0.1),     # nm
 211                                 int $dir, &symdir($dir);
 212                 next if $l[9] =~ /\b$ID\b/;
 213                 last if $dist > $RANGE;
 214         }
 215 }
 216
 217
 218 sub addfreq($$)
 219 {
 220         my ($freq, $desc) = @_;
 221         push @{$FREQ{$freq}}, $desc;
 222 }
 223
 224
 225 sub distance($)         # km
 226 {
 227         my $t = shift;
 228         return $ERAD * sqrt($t) / 1000;
 229 }
 230
 231
 232 sub round($)
 233 {
 234         my $i = shift;
 235         my $m = (shift or 1);
 236         $i /= $m;
 237         $i = $i - &floor($i) >= 0.5 ? &ceil($i) : &floor($i);
 238         $i *= $m;
 239         return $i;
 240 }
 241
 242
 243 sub llll2dir($$$$)
 244 {
 245         my $latA = (shift) * $D2R;
 246         my $lonA = (shift) * $D2R;
 247         my $latB = (shift) * $D2R;
 248         my $lonB = (shift) * $D2R;
 249         my $xdist = sin($lonB - $lonA) * $ERAD * cos(($latA + $latB) / 2);
 250         my $ydist = sin($latB - $latA) * $ERAD;
 251         my $dir = atan2($xdist, $ydist) * $R2D;
 252         $dir += 360 if $dir < 0;
 253         return $dir;
 254 }
 255
 256
 257 sub ll2xyz($$)
 258 {
 259         my $lat = (shift) * $D2R;
 260         my $lon = (shift) * $D2R;
 261         my $cosphi = cos $lat;
 262         my $di = $cosphi * cos $lon;
 263         my $dj = $cosphi * sin $lon;
 264         my $dk = sin $lat;
 265         return ($di, $dj, $dk);
 266 }
 267
 268
 269 sub xyz2ll($$$)
 270 {
 271         my ($di, $dj, $dk) = @_;
 272         my $aux = $di * $di + $dj * $dj;
 273         my $lat = atan2($dk, sqrt $aux) * $R2D;
 274         my $lon = atan2($dj, $di) * $R2D;
 275         return ($lat, $lon);
 276 }
 277
 278
 279 sub coord_dist_sq($$$$$$)
 280 {
 281         my ($xa, $ya, $za, $xb, $yb, $zb) = @_;
 282         my $x = $xb - $xa;
 283         my $y = $yb - $ya;
 284         my $z = $zb - $za;
 285         return $x * $x + $y * $y + $z * $z;
 286 }
 287
 288
 289 sub symdir($)
 290 {
 291         my $dir = shift;
 292         my @names = ("N", "NNE", "NE", "ENE", "E", "ESE", "SE", "SSE",
 293                         "S", "SSW", "SW", "WSW", "W", "WNW", "NW", "NNW");
 294         my $nnames = scalar @names;
 295         my $idx = int($nnames * (($dir / 360) + (0.5 / $nnames)));
 296         if ($idx >= $nnames) {
 297                 $idx = 0;
 298         }
 299         return $names[$idx];
 300 }
 301
 302