first commit
This commit is contained in:
Your Name
765
scripts/perl/dafif/build_ils.pl
Executable file
765
scripts/perl/dafif/build_ils.pl
Executable file
@@ -0,0 +1,765 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
########################################################################
|
||||
# Convert DAFIFT ARPT/ILS.TXT to FlightGear format.
|
||||
########################################################################
|
||||
|
||||
use strict;
|
||||
|
||||
my($faa_ils_file) = shift(@ARGV);
|
||||
my($dafift_arpt_file) = shift(@ARGV);
|
||||
my($dafift_ils_file) = shift(@ARGV);
|
||||
my($fgfs_ils_file) = shift(@ARGV);
|
||||
my($fgfs_apt_file) = shift(@ARGV);
|
||||
my($output_file) = shift(@ARGV);
|
||||
|
||||
my($calc_loc)
|
||||
= "/home/curt/projects/FlightGear-0.9/source/src/Airports/calc_loc";
|
||||
|
||||
die "Usage: $0 " .
|
||||
"<faa_ils_file> <dafift_arpt_file> <dafift_ils_file> <xplane_ils_file> <fgfs_apt_file> <output_file>\n"
|
||||
if !defined($faa_ils_file) || !defined($dafift_arpt_file)
|
||||
|| !defined($dafift_ils_file) || !defined($fgfs_ils_file)
|
||||
|| !defined($fgfs_apt_file) || !defined($output_file);
|
||||
|
||||
my( %CODES );
|
||||
my( %CodesByICAO );
|
||||
my( %Elevations );
|
||||
my( %ILS );
|
||||
my( %AIRPORTS );
|
||||
my( %RUNWAYS );
|
||||
|
||||
|
||||
&load_dafift( $dafift_arpt_file, $dafift_ils_file );
|
||||
&load_faa( $faa_ils_file );
|
||||
&load_fgfs( $fgfs_ils_file );
|
||||
&load_fgfs_airports( $fgfs_apt_file );
|
||||
&fix_localizer();
|
||||
&fudge_missing_gs_elev();
|
||||
|
||||
&write_result( $output_file );
|
||||
|
||||
exit;
|
||||
|
||||
|
||||
########################################################################
|
||||
# Process DAFIFT data
|
||||
########################################################################
|
||||
|
||||
sub load_dafift() {
|
||||
my( $arpt_file ) = shift;
|
||||
my( $ils_file ) = shift;
|
||||
|
||||
my( $record );
|
||||
|
||||
my( $id, $rwy, $type );
|
||||
my( $has_dme, $has_gs, $has_loc, $has_im, $has_mm, $has_om );
|
||||
my( $dme_lon, $dme_lat, $dme_elev, $dme_bias );
|
||||
my( $gs_lon, $gs_lat, $gs_elev, $gs_angle );
|
||||
my( $loc_type, $loc_lon, $loc_lat, $loc_elev, $loc_freq, $loc_hdg,
|
||||
$loc_width, $loc_id );
|
||||
my( $im_lon, $im_lat, $mm_lon, $mm_lat, $om_lon, $om_lat );
|
||||
|
||||
# load airport file so we can lookup ICAO from internal ID
|
||||
|
||||
open( ARPT, "<$arpt_file" ) || die "Cannot open DAFIFT: $arpt_file\n";
|
||||
|
||||
<ARPT>; # skip header line
|
||||
|
||||
while ( <ARPT> ) {
|
||||
chomp;
|
||||
my(@F) = split(/\t/);
|
||||
my($icao) = $F[3];
|
||||
if ( length($icao) < 3 ) {
|
||||
if ( length( $F[4] ) >= 3 ) {
|
||||
$icao = $F[4];
|
||||
} else {
|
||||
$icao = "[none]";
|
||||
}
|
||||
}
|
||||
$CODES{$F[0]} = $icao;
|
||||
$CodesByICAO{$icao} = 1;
|
||||
# print "$F[0] - $icao\n";
|
||||
$Elevations{$icao} = $F[11];
|
||||
# print "$icao $F[11]\n";
|
||||
}
|
||||
|
||||
# Load the DAFIFT ils file
|
||||
|
||||
my( $last_id, $last_rwy ) = ("", "");
|
||||
|
||||
open( DAFIFT_ILS, "<$ils_file" ) || die "Cannot open DAFIFT: $ils_file\n";
|
||||
|
||||
<DAFIFT_ILS>; # skip header line
|
||||
|
||||
while ( <DAFIFT_ILS> ) {
|
||||
chomp;
|
||||
my @F = split(/\t/);
|
||||
$id = $F[0];
|
||||
$rwy = $F[1];
|
||||
|
||||
if ( $last_id ne "" && ($last_id ne $id || $last_rwy ne $rwy) ) {
|
||||
# just hist the start of the next record, dump the current data
|
||||
|
||||
if ( ! $has_gs ) {
|
||||
( $gs_elev, $gs_angle, $gs_lat, $gs_lon ) = ( 0, 0, 0, 0 );
|
||||
}
|
||||
if ( ! $has_dme ) {
|
||||
( $dme_lat, $dme_lon ) = ( 0, 0 );
|
||||
}
|
||||
if ( ! $has_om ) {
|
||||
( $om_lat, $om_lon ) = ( 0, 0 );
|
||||
}
|
||||
if ( ! $has_mm ) {
|
||||
( $mm_lat, $mm_lon ) = ( 0, 0 );
|
||||
}
|
||||
if ( ! $has_im ) {
|
||||
( $im_lat, $im_lon ) = ( 0, 0 );
|
||||
}
|
||||
if ( $ILS{$CODES{$last_id} . $last_rwy} eq "" ) {
|
||||
print "DAFIFT adding: $CODES{$last_id} - $last_rwy\n";
|
||||
&safe_add_record( $CODES{$last_id}, $last_rwy, "ILS",
|
||||
$loc_freq, $loc_id, $loc_hdg, $loc_lat,
|
||||
$loc_lon, $gs_elev, $gs_angle, $gs_lat,
|
||||
$gs_lon, $dme_lat, $dme_lon, $om_lat,
|
||||
$om_lon, $mm_lat, $mm_lon, $im_lat,
|
||||
$im_lon );
|
||||
}
|
||||
|
||||
$has_dme = 0;
|
||||
$has_gs = 0;
|
||||
$has_loc = 0;
|
||||
$has_im = 0;
|
||||
$has_mm = 0;
|
||||
$has_om = 0;
|
||||
}
|
||||
|
||||
$type = $F[2];
|
||||
if ( $type eq "D" ) {
|
||||
# DME entry
|
||||
$has_dme = 1;
|
||||
$dme_lon = make_dcoord( $F[16] );
|
||||
$dme_lat = make_dcoord( $F[14] );
|
||||
$dme_elev = $F[10];
|
||||
if ( $dme_elev !~ m/\d/ ) {
|
||||
$dme_elev = "";
|
||||
} else {
|
||||
$dme_elev += 0;
|
||||
}
|
||||
$dme_bias = $F[27];
|
||||
# print "$id DME $dme_lon $dme_lat $dme_elev $dme_bias\n";
|
||||
} elsif ( $type eq "G" ) {
|
||||
# GlideSlope entry
|
||||
$has_gs = 1;
|
||||
$gs_lon = make_dcoord( $F[16] );
|
||||
$gs_lat = make_dcoord( $F[14] );
|
||||
$gs_elev = $F[10];
|
||||
if ( $gs_elev !~ m/\d/ ) {
|
||||
$gs_elev = "";
|
||||
} else {
|
||||
$gs_elev += 0;
|
||||
}
|
||||
$gs_angle = $F[7];
|
||||
# print "$id GS $gs_lon $gs_lat $gs_elev $gs_angle\n";
|
||||
} elsif ( $type eq "Z" ) {
|
||||
# Localizer entry
|
||||
$has_loc = 1;
|
||||
$loc_lon = make_dcoord( $F[16] );
|
||||
$loc_lat = make_dcoord( $F[14] );
|
||||
$loc_elev = $F[10];
|
||||
if ( $loc_elev !~ m/\d/ ) {
|
||||
$loc_elev = "";
|
||||
} else {
|
||||
$loc_elev += 0;
|
||||
}
|
||||
($loc_freq) = $F[5] =~ m/(\d\d\d\d\d\d)/;
|
||||
$loc_freq /= 1000.0;
|
||||
my( $magvar ) = make_dmagvar( $F[22] );
|
||||
# print "mag var = $F[22] (" . $magvar . ")\n";
|
||||
$loc_hdg = $F[24] + make_dmagvar( $F[22] );
|
||||
$loc_width = $F[25];
|
||||
$loc_id = $F[18];
|
||||
if ( length( $loc_id ) >= 4 ) {
|
||||
$loc_id =~ s/^I//;
|
||||
}
|
||||
# print "$id LOC $loc_lon $loc_lat $loc_elev $loc_freq $loc_hdg $loc_width\n";
|
||||
} elsif ( $type eq "I" ) {
|
||||
# Inner marker entry
|
||||
$has_im = 1;
|
||||
$im_lon = make_dcoord( $F[16] );
|
||||
$im_lat = make_dcoord( $F[14] );
|
||||
# print "$id IM $im_lon $im_lat\n";
|
||||
} elsif ( $type eq "M" ) {
|
||||
# Middle marker entry
|
||||
$has_mm = 1;
|
||||
$mm_lon = make_dcoord( $F[16] );
|
||||
$mm_lat = make_dcoord( $F[14] );
|
||||
# print "$id MM $mm_lon $mm_lat\n";
|
||||
} elsif ( $type eq "O" ) {
|
||||
# Outer marker entry
|
||||
$has_om = 1;
|
||||
$om_lon = make_dcoord( $F[16] );
|
||||
$om_lat = make_dcoord( $F[14] );
|
||||
# print "$id OM $om_lon $om_lat\n";
|
||||
}
|
||||
|
||||
$last_id = $id;
|
||||
$last_rwy = $rwy;
|
||||
# printf("%-5s %10.6f %11.6f\n", $F[0], $F[14], $F[16]);
|
||||
}
|
||||
|
||||
if ( ! $has_gs ) {
|
||||
( $gs_elev, $gs_angle, $gs_lat, $gs_lon ) = ( 0, 0, 0, 0 );
|
||||
}
|
||||
if ( ! $has_dme ) {
|
||||
( $dme_lat, $dme_lon ) = ( 0, 0 );
|
||||
}
|
||||
if ( ! $has_om ) {
|
||||
( $om_lat, $om_lon ) = ( 0, 0 );
|
||||
}
|
||||
if ( ! $has_mm ) {
|
||||
( $mm_lat, $mm_lon ) = ( 0, 0 );
|
||||
}
|
||||
if ( ! $has_im ) {
|
||||
( $im_lat, $im_lon ) = ( 0, 0 );
|
||||
}
|
||||
if ( $ILS{$CODES{$last_id} . $last_rwy} eq "" ) {
|
||||
print "DAFIFT adding (last): $CODES{$last_id} - $last_rwy\n";
|
||||
&safe_add_record( $CODES{$last_id}, $last_rwy, "ILS", $loc_freq,
|
||||
$loc_id, $loc_hdg, $loc_lat, $loc_lon,
|
||||
$gs_elev, $gs_angle, $gs_lat, $gs_lon,
|
||||
$dme_lat, $dme_lon, $om_lat, $om_lon, $mm_lat,
|
||||
$mm_lon, $im_lat, $im_lon );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
########################################################################
|
||||
# Process FAA data
|
||||
########################################################################
|
||||
|
||||
sub load_faa() {
|
||||
my( $file ) = shift;
|
||||
|
||||
open( FAA_ILS, "<$file" ) || die "Cannot open FAA data: $file\n";
|
||||
|
||||
<FAA_ILS>; # skip header line
|
||||
|
||||
while ( <FAA_ILS> ) {
|
||||
chomp;
|
||||
|
||||
my ( $rec_type, $faa_id, $rwy, $type, $faa_date,
|
||||
$faa_apt_name, $faa_city, $faa_st, $faa_state,
|
||||
$faa_region, $id, $faa_len, $faa_wid, $faa_cat,
|
||||
$faa_owner, $faa_operator, $faa_bearing, $faa_magvar,
|
||||
$loc_type, $loc_id, $loc_freq, $faa_loc_latd,
|
||||
$faa_loc_lats, $faa_loc_lond, $faa_loc_lons, $loc_width,
|
||||
$faa_stop_dist, $faa_app_dist, $faa_gs_type, $gs_angle,
|
||||
$faa_gs_freq, $faa_gs_latd, $faa_gs_lats, $faa_gs_lond,
|
||||
$faa_gs_lons, $faa_gs_dist, $gs_elev, $faa_im_type,
|
||||
$faa_im_latd, $faa_im_lats, $faa_im_lond, $faa_im_lons,
|
||||
$faa_im_dist, $faa_mm_type, $faa_mm_id, $faa_mm_name,
|
||||
$faa_mm_freq, $faa_mm_latd, $faa_mm_lats, $faa_mm_lond,
|
||||
$faa_mm_lons, $faa_mm_dist, $faa_om_type, $faa_om_id,
|
||||
$faa_om_name, $faa_om_freq, $faa_om_latd, $faa_om_lats,
|
||||
$faa_om_lond, $faa_om_lons, $faa_om_dist,
|
||||
$faa_om_backcourse, $faa_dme_channel, $faa_dme_latd,
|
||||
$faa_dme_lats, $faa_dme_lond, $faa_dme_lons, $faa_dme_app_dist,
|
||||
$faa_dme_stop_dist, $blank)
|
||||
= $_ =~
|
||||
m/^(.{4})(.{11})(.{3})(.{10})(.{10})(.{42})(.{26})(.{2})(.{20})(.{3})(.{4})(.{5})(.{4})(.{9})(.{50})(.{50})(.{3})(.{3})(.{15})(.{5})(.{6})(.{14})(.{11})(.{14})(.{11})(.{5})(.{5})(.{6})(.{15})(.{4})(.{6})(.{14})(.{11})(.{14})(.{11})(.{6})(.{7})(.{15})(.{14})(.{11})(.{14})(.{11})(.{6})(.{15})(.{2})(.{5})(.{3})(.{14})(.{11})(.{14})(.{11})(.{6})(.{15})(.{2})(.{5})(.{3})(.{14})(.{11})(.{14})(.{11})(.{6})(.{9})(.{4})(.{14})(.{11})(.{14})(.{11})(.{6})(.{5})(.{34})/;
|
||||
|
||||
$id = &strip_ws( $id );
|
||||
$rwy = &strip_ws( $rwy );
|
||||
$rwy =~ s/\/$//;
|
||||
$rwy =~ s/\/$//;
|
||||
$loc_id =~ s/^I-//;
|
||||
my( $loc_hdg ) = $faa_bearing + make_dmagvar($faa_magvar);
|
||||
my( $loc_lat ) = make_dcoord($faa_loc_lats) / 3600.0;
|
||||
my( $loc_lon ) = make_dcoord($faa_loc_lons) / 3600.0;
|
||||
# print "$loc_lon $loc_lat $faa_loc_lons $faa_loc_lats\n";
|
||||
my( $gs_lat ) = make_dcoord($faa_gs_lats) / 3600.0;
|
||||
my( $gs_lon ) = make_dcoord($faa_gs_lons) / 3600.0;
|
||||
my( $im_lat ) = make_dcoord($faa_im_lats) / 3600.0;
|
||||
my( $im_lon ) = make_dcoord($faa_im_lons) / 3600.0;
|
||||
my( $mm_lat ) = make_dcoord($faa_mm_lats) / 3600.0;
|
||||
my( $mm_lon ) = make_dcoord($faa_mm_lons) / 3600.0;
|
||||
my( $om_lat ) = make_dcoord($faa_om_lats) / 3600.0;
|
||||
my( $om_lon ) = make_dcoord($faa_om_lons) / 3600.0;
|
||||
my( $dme_lat ) = make_dcoord($faa_dme_lats) / 3600.0;
|
||||
my( $dme_lon ) = make_dcoord($faa_dme_lons) / 3600.0;
|
||||
|
||||
# my( $key );
|
||||
# print "$id - $rwy\n";
|
||||
# $key = $id . $rwy;
|
||||
# print "-> $key -> $ILS{$key}\n";
|
||||
# $key = "K" . $id . $rwy;
|
||||
# print "-> $key -> $ILS{$key}\n";
|
||||
|
||||
if ( $rec_type eq "ILS1" ) {
|
||||
if ( length( $id ) < 4 ) {
|
||||
if ( $CodesByICAO{"K" . $id} ) {
|
||||
$id = "K" . $id;
|
||||
}
|
||||
}
|
||||
if ( $ILS{$id . $rwy} ne "" ) {
|
||||
print "FAA updating: $id - $rwy $type\n";
|
||||
&update_type( $id, $rwy, $type );
|
||||
if ( $gs_elev > 0 ) {
|
||||
&maybe_update_gs_elev( $id . $rwy, $gs_elev );
|
||||
}
|
||||
} else {
|
||||
print "FAA adding: $id - $rwy\n";
|
||||
&safe_add_record( $id, $rwy, $type, $loc_freq, $loc_id,
|
||||
$loc_hdg, $loc_lat, $loc_lon, $gs_elev,
|
||||
$gs_angle, $gs_lat, $gs_lon, $dme_lat,
|
||||
$dme_lon, $om_lat, $om_lon, $mm_lat,
|
||||
$mm_lon, $im_lat, $im_lon );
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
########################################################################
|
||||
# Process FlightGear ILS data
|
||||
########################################################################
|
||||
|
||||
sub load_fgfs() {
|
||||
my( $ils_file ) = shift;
|
||||
|
||||
open( FGILS, "zcat $ils_file|" ) || die "Cannot open FGFS: $ils_file\n";
|
||||
|
||||
<FGILS>; # skip header line
|
||||
|
||||
while ( <FGILS> ) {
|
||||
chomp;
|
||||
if ( ! m/\[End\]/ && length($_) > 1 ) {
|
||||
# print "$_\n";
|
||||
my( $type_code, $type_name, $icao, $rwy, $loc_freq, $loc_id,
|
||||
$loc_hdg, $loc_lat, $loc_lon, $gs_elev, $gs_angle, $gs_lat,
|
||||
$gs_lon, $dme_lat, $dme_lon, $om_lat, $om_lon, $mm_lat, $mm_lon,
|
||||
$im_lat, $im_lon ) = split(/\s+/);
|
||||
my( $code ) = $icao;
|
||||
$code =~ s/^K//;
|
||||
if ( $ILS{$icao . $rwy} ne "" ) {
|
||||
print "FGFS: Skipping $icao - $rwy - already exists\n";
|
||||
# skip approaches already in FAA or DAFIFT data
|
||||
} elsif ( length( $icao ) < 4 || $icao =~ m/^K/ ) {
|
||||
print "FGFS: Skipping $icao - $rwy - USA\n";
|
||||
# skip USA approaches not found in FAA or DAFIFT data
|
||||
} else {
|
||||
print "FGFS adding: $icao $rwy\n";
|
||||
&safe_add_record( $icao, $rwy, $type_name, $loc_freq, $loc_id,
|
||||
$loc_hdg, $loc_lat, $loc_lon, $gs_elev,
|
||||
$gs_angle, $gs_lat, $gs_lon, $dme_lat,
|
||||
$dme_lon, $om_lat, $om_lon, $mm_lat,
|
||||
$mm_lon, $im_lat, $im_lon );
|
||||
}
|
||||
} else {
|
||||
print "FGFS discarding: $_\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
########################################################################
|
||||
# Load the x-plane/flightgear airport/runway information
|
||||
########################################################################
|
||||
|
||||
sub load_fgfs_airports() {
|
||||
my( $infile ) = shift;
|
||||
|
||||
my( $id );
|
||||
|
||||
open( IN, "zcat $infile|" ) || die "Cannot open: $infile\n";
|
||||
|
||||
<IN>; # skip header line
|
||||
|
||||
while ( <IN> ) {
|
||||
chomp;
|
||||
my(@F) = split(/\s+/);
|
||||
if ( $F[0] eq "A" ) {
|
||||
$id = $F[1];
|
||||
} elsif ( $F[0] eq "R" ) {
|
||||
my($recip) = &rwy_recip( $F[1] );
|
||||
$RUNWAYS{ $id . $F[1] } = "FOR $_";
|
||||
$RUNWAYS{ $id . $recip } = "REV $_";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
########################################################################
|
||||
# Run through the final ils list and adjust the heading to match the runway
|
||||
########################################################################
|
||||
|
||||
sub fix_localizer() {
|
||||
my( $key );
|
||||
foreach $key ( sort (keys %ILS) ) {
|
||||
my(@F) = split( /\s+/, $ILS{$key} );
|
||||
print "FIXING: $key $F[2] $F[3] $F[4]\n";
|
||||
if ( $RUNWAYS{$key} ) {
|
||||
my(@G) = split( /\s+/, $RUNWAYS{$key} );
|
||||
print " LocPos = $F[7] $F[8]\n";
|
||||
print " RwyInfo = $G[0] $G[3] $G[4] $G[5] $G[6] $G[7]\n";
|
||||
my($cmd)
|
||||
= "$calc_loc $F[7] $F[8] $G[0] $G[3] $G[4] $G[5] $G[6] $G[7]";
|
||||
open( CALC, "$cmd |" ) || die "Cannot open $calc_loc\n";
|
||||
my( $j, $lat, $lon );
|
||||
while ( <CALC> ) {
|
||||
if ( m/New localizer/ ) {
|
||||
($j, $j, $j, $lat, $lon) = split( /\s+/ );
|
||||
}
|
||||
}
|
||||
if ( $G[0] eq "REV" ) {
|
||||
$G[5] += 180.0;
|
||||
if ( $G[5] >= 360.0 ) {
|
||||
$G[5] -= 360.0;
|
||||
}
|
||||
}
|
||||
&update_loc( $F[2], $F[3], $lat, $lon, $G[5]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
########################################################################
|
||||
# Run through the final ils list and fixup any missing glide slope elevations
|
||||
# to match that of the field elevation.
|
||||
########################################################################
|
||||
|
||||
sub fudge_missing_gs_elev() {
|
||||
my( $key );
|
||||
foreach $key ( sort (keys %ILS) ) {
|
||||
my(@F) = split( /\s+/, $ILS{$key} );
|
||||
if ( $F[9] <= 0 ) {
|
||||
print "FUDGING GS: $key $F[2] $F[3] $F[4] - $F[9]\n";
|
||||
&maybe_update_gs_elev( $key, $Elevations{$F[2]});
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
########################################################################
|
||||
# Write out the accumulated combined result
|
||||
########################################################################
|
||||
|
||||
sub write_result() {
|
||||
my( $outfile ) = shift;
|
||||
|
||||
open( OUT, ">$outfile" ) || die "Cannot write to: $outfile\n";
|
||||
|
||||
# dump out the final results
|
||||
print OUT "// FlightGear ILS data, generated from DAFIFT ARPT/ILS.TXT and FAA data\n";
|
||||
|
||||
my( $key );
|
||||
foreach $key ( sort (keys %ILS) ) {
|
||||
print OUT "$ILS{$key}\n";
|
||||
}
|
||||
print OUT "[End]\n";
|
||||
}
|
||||
|
||||
|
||||
########################################################################
|
||||
# Utility functions
|
||||
########################################################################
|
||||
|
||||
|
||||
# add a record to the master list if it doesn't already exist
|
||||
|
||||
sub safe_add_record() {
|
||||
my( $apt_id ) = shift;
|
||||
my( $rwy ) = shift;
|
||||
my( $type ) = shift;
|
||||
my( $loc_freq ) = shift;
|
||||
my( $loc_id ) = shift;
|
||||
my( $loc_hdg ) = shift;
|
||||
my( $loc_lat ) = shift;
|
||||
my( $loc_lon ) = shift;
|
||||
my( $gs_elev ) = shift;
|
||||
my( $gs_angle ) = shift;
|
||||
my( $gs_lat ) = shift;
|
||||
my( $gs_lon ) = shift;
|
||||
my( $dme_lat ) = shift;
|
||||
my( $dme_lon ) = shift;
|
||||
my( $om_lat ) = shift;
|
||||
my( $om_lon ) = shift;
|
||||
my( $mm_lat ) = shift;
|
||||
my( $mm_lon ) = shift;
|
||||
my( $im_lat ) = shift;
|
||||
my( $im_lon ) = shift;
|
||||
|
||||
if ( $ILS{$apt_id . $rwy} eq "" ) {
|
||||
# print "Safe adding (common): $apt_id - $rwy\n";
|
||||
&update_record( $apt_id, $rwy, $type, $loc_freq, $loc_id,
|
||||
$loc_hdg, $loc_lat, $loc_lon, $gs_elev,
|
||||
$gs_angle, $gs_lat, $gs_lon, $dme_lat,
|
||||
$dme_lon, $om_lat, $om_lon, $mm_lat,
|
||||
$mm_lon, $im_lat, $im_lon );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# replace a record in the master list (or add it if it doesn't exist)
|
||||
|
||||
sub update_record() {
|
||||
my( $apt_id ) = shift;
|
||||
my( $rwy ) = shift;
|
||||
my( $type ) = shift;
|
||||
my( $loc_freq ) = shift;
|
||||
my( $loc_id ) = shift;
|
||||
my( $loc_hdg ) = shift;
|
||||
my( $loc_lat ) = shift;
|
||||
my( $loc_lon ) = shift;
|
||||
my( $gs_elev ) = shift;
|
||||
my( $gs_angle ) = shift;
|
||||
my( $gs_lat ) = shift;
|
||||
my( $gs_lon ) = shift;
|
||||
my( $dme_lat ) = shift;
|
||||
my( $dme_lon ) = shift;
|
||||
my( $om_lat ) = shift;
|
||||
my( $om_lon ) = shift;
|
||||
my( $mm_lat ) = shift;
|
||||
my( $mm_lon ) = shift;
|
||||
my( $im_lat ) = shift;
|
||||
my( $im_lon ) = shift;
|
||||
|
||||
my( $record );
|
||||
|
||||
# remap $type as needed
|
||||
$type = &strip_ws( $type );
|
||||
if ( $type eq "LOCALIZER" ) {
|
||||
$type = "LOC";
|
||||
} elsif ( $type eq "ILS/DME" ) {
|
||||
$type = "ILS";
|
||||
} elsif ( $type eq "SDF/DME" ) {
|
||||
$type = "SDF";
|
||||
} elsif ( $type eq "LOC/DME" ) {
|
||||
$type = "ILS";
|
||||
} elsif ( $type eq "LOC/GS" ) {
|
||||
$type = "LOC";
|
||||
} elsif ( $type eq "LDA/DME" ) {
|
||||
$type = "LDA";
|
||||
}
|
||||
|
||||
$record = sprintf( "%1s %-5s %-4s %-3s %06.2f %-4s %06.2f %10.6f %11.6f ",
|
||||
substr( $type, 0, 1 ), $type, $apt_id, $rwy,
|
||||
$loc_freq, $loc_id, $loc_hdg, $loc_lat, $loc_lon );
|
||||
$record .= sprintf( "%5d %5.2f %10.6f %11.6f ",
|
||||
$gs_elev, $gs_angle, $gs_lat, $gs_lon );
|
||||
$record .= sprintf( "%10.6f %11.6f ", $dme_lat, $dme_lon );
|
||||
$record .= sprintf( "%10.6f %11.6f ", $om_lat, $om_lon );
|
||||
$record .= sprintf( "%10.6f %11.6f ", $mm_lat, $mm_lon );
|
||||
$record .= sprintf( "%10.6f %11.6f ", $im_lat, $im_lon );
|
||||
|
||||
# print "Updating (common): $apt_id - $rwy\n";
|
||||
$ILS{$apt_id . $rwy} = $record;
|
||||
$AIRPORTS{$apt_id} = 1;
|
||||
}
|
||||
|
||||
|
||||
# update the $type of the record
|
||||
sub update_type() {
|
||||
my( $apt_id ) = shift;
|
||||
my( $rwy ) = shift;
|
||||
my( $new_type ) = shift;
|
||||
|
||||
my( $record );
|
||||
|
||||
if ( $ILS{$apt_id . $rwy} ne "" ) {
|
||||
my( $type_code, $type_name, $apt_id, $rwy, $loc_freq, $loc_id,
|
||||
$loc_hdg, $loc_lat, $loc_lon, $gs_elev, $gs_angle, $gs_lat,
|
||||
$gs_lon, $dme_lat, $dme_lon, $om_lat, $om_lon, $mm_lat, $mm_lon,
|
||||
$im_lat, $im_lon ) = split( /\s+/, $ILS{$apt_id . $rwy} );
|
||||
# print "Updating type: $apt_id $rwy: $type_name -> $new_type\n";
|
||||
$type_name = $new_type;
|
||||
&update_record( $apt_id, $rwy, $type_name, $loc_freq, $loc_id,
|
||||
$loc_hdg, $loc_lat, $loc_lon, $gs_elev,
|
||||
$gs_angle, $gs_lat, $gs_lon, $dme_lat,
|
||||
$dme_lon, $om_lat, $om_lon, $mm_lat,
|
||||
$mm_lon, $im_lat, $im_lon );
|
||||
} else {
|
||||
die "Error, trying to update $apt_id - $rwy which doesn't exist\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# update the glide slope elevation of the record (but only if it is 0)
|
||||
sub maybe_update_gs_elev() {
|
||||
my( $key ) = shift;
|
||||
my( $new_gs_elev ) = shift;
|
||||
|
||||
my( $record );
|
||||
|
||||
if ( $ILS{$key} ne "" ) {
|
||||
my( $type_code, $type_name, $apt_id, $rwy, $loc_freq, $loc_id,
|
||||
$loc_hdg, $loc_lat, $loc_lon, $gs_elev, $gs_angle, $gs_lat,
|
||||
$gs_lon, $dme_lat, $dme_lon, $om_lat, $om_lon, $mm_lat, $mm_lon,
|
||||
$im_lat, $im_lon ) = split( /\s+/, $ILS{$key} );
|
||||
if ( $gs_elev == 0 ) {
|
||||
print "Updating gs elev: $apt_id $rwy: $gs_elev -> $new_gs_elev\n";
|
||||
$gs_elev = $new_gs_elev;
|
||||
&update_record( $apt_id, $rwy, $type_name, $loc_freq, $loc_id,
|
||||
$loc_hdg, $loc_lat, $loc_lon, $gs_elev,
|
||||
$gs_angle, $gs_lat, $gs_lon, $dme_lat,
|
||||
$dme_lon, $om_lat, $om_lon, $mm_lat,
|
||||
$mm_lon, $im_lat, $im_lon );
|
||||
}
|
||||
} else {
|
||||
die "Error, trying to update $key which doesn't exist\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# update the localizer position of the record
|
||||
sub update_loc() {
|
||||
my( $apt_id ) = shift;
|
||||
my( $rwy ) = shift;
|
||||
my( $nloc_lat ) = shift;
|
||||
my( $nloc_lon ) = shift;
|
||||
my( $nloc_hdg ) = shift;
|
||||
|
||||
my( $record );
|
||||
|
||||
if ( $ILS{$apt_id . $rwy} ne "" ) {
|
||||
my( $type_code, $type_name, $apt_id, $rwy, $loc_freq, $loc_id,
|
||||
$loc_hdg, $loc_lat, $loc_lon, $gs_elev, $gs_angle, $gs_lat,
|
||||
$gs_lon, $dme_lat, $dme_lon, $om_lat, $om_lon, $mm_lat, $mm_lon,
|
||||
$im_lat, $im_lon ) = split( /\s+/, $ILS{$apt_id . $rwy} );
|
||||
print " Old pos = " . $loc_lat . "," . $loc_lon . " " . $loc_hdg . "\n";
|
||||
print " New pos = " . $nloc_lat . "," . $nloc_lon . " " . $nloc_hdg . "\n";
|
||||
$loc_lat = $nloc_lat;
|
||||
$loc_lon = $nloc_lon;
|
||||
$loc_hdg = $nloc_hdg;
|
||||
&update_record( $apt_id, $rwy, $type_name, $loc_freq, $loc_id,
|
||||
$loc_hdg, $loc_lat, $loc_lon, $gs_elev,
|
||||
$gs_angle, $gs_lat, $gs_lon, $dme_lat,
|
||||
$dme_lon, $om_lat, $om_lon, $mm_lat,
|
||||
$mm_lon, $im_lat, $im_lon );
|
||||
} else {
|
||||
die "Error, trying to update $apt_id - $rwy which doesn't exist\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# convert a lon/lat coordinate in various formats to signed decimal
|
||||
|
||||
sub make_dcoord() {
|
||||
my($coord) = shift;
|
||||
my( $dir, $deg, $min, $sec );
|
||||
my( $value ) = 0.0;
|
||||
|
||||
$coord = &strip_ws( $coord );
|
||||
|
||||
if ( $coord =~ m/^[WE]/ ) {
|
||||
( $dir, $deg, $min, $sec )
|
||||
= $coord =~ m/^([EW])(\d\d\d)(\d\d)(\d\d\d\d)/;
|
||||
$value = $deg + $min/60.0 + ($sec/100)/3600.0;
|
||||
if ( $dir eq "W" ) {
|
||||
$value = -$value;
|
||||
}
|
||||
} elsif ( $coord =~ m/^[NS]/ ) {
|
||||
( $dir, $deg, $min, $sec )
|
||||
= $coord =~ m/^([NS])(\d\d)(\d\d)(\d\d\d\d)/;
|
||||
$value = $deg + $min/60.0 + ($sec/100)/3600.0;
|
||||
if ( $dir eq "S" ) {
|
||||
$value = -$value;
|
||||
}
|
||||
} elsif ( $coord =~ m/[EW]$/ ) {
|
||||
($value, $dir) = $coord =~ m/([\d\s\.]+)([EW])/;
|
||||
if ( $dir eq "W" ) {
|
||||
$value = -$value;
|
||||
}
|
||||
} elsif ( $coord =~ m/[NS]$/ ) {
|
||||
($value, $dir) = $coord =~ m/([\d\s\.]+)([NS])/;
|
||||
if ( $dir eq "S" ) {
|
||||
$value = -$value;
|
||||
}
|
||||
}
|
||||
# print "$dir $deg:$min:$sec = $value\n";
|
||||
return $value;
|
||||
}
|
||||
|
||||
# convert a magnetic variation in various formats to signed decimal
|
||||
|
||||
sub make_dmagvar() {
|
||||
my( $coord ) = shift;
|
||||
my( $value );
|
||||
|
||||
if ( $coord =~ m/^[EW]/ ) {
|
||||
my( $dir, $deg, $min, $date )
|
||||
= $coord =~ m/^([EW])(\d\d\d)(\d\d\d) (\d\d\d\d)/;
|
||||
$value = $deg + ($min/10)/60.0;
|
||||
if ( $dir eq "W" ) {
|
||||
$value = -$value;
|
||||
}
|
||||
} elsif ( $coord =~ m/[EW]$/ ) {
|
||||
my( $deg, $dir )
|
||||
= $coord =~ m/^(\d\d)([EW])/;
|
||||
$value = $deg;
|
||||
if ( $dir eq "W" ) {
|
||||
$value = -$value;
|
||||
}
|
||||
}
|
||||
# print "$dir $deg:$min = $value\n";
|
||||
|
||||
return $value;
|
||||
}
|
||||
|
||||
# strip white space off front and back of string
|
||||
|
||||
sub strip_ws() {
|
||||
my( $string ) = shift;
|
||||
$string =~ s/^\s+//;
|
||||
$string =~ s/\s+$//;
|
||||
return $string;
|
||||
}
|
||||
|
||||
|
||||
# return the reciprical runway number
|
||||
sub rwy_recip() {
|
||||
my( $input ) = shift;
|
||||
|
||||
my($num, $letter);
|
||||
|
||||
if ( length($input) == 3 ) {
|
||||
($num, $letter) = $input =~ m/(\d\d)(.)/;
|
||||
} elsif ( length($input) == 2 ) {
|
||||
$num = $input;
|
||||
$letter = "";
|
||||
} else {
|
||||
$num = "";
|
||||
$letter = $input;
|
||||
}
|
||||
# print "RWY: $num - $letter <==> ";
|
||||
|
||||
if ( $num ne "" ) {
|
||||
$num += 18;
|
||||
if ( $num > 35 ) {
|
||||
$num -= 36;
|
||||
}
|
||||
if ( $num < 10 ) {
|
||||
$num = "0$num";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $letter eq "R" ) {
|
||||
$letter = "L";
|
||||
} elsif ( $letter eq "L" ) {
|
||||
$letter = "R";
|
||||
} elsif ( $letter eq "C" ) {
|
||||
$letter = "C";
|
||||
} elsif ( $letter eq "N" ) {
|
||||
$letter = "S";
|
||||
} elsif ( $letter eq "S" ) {
|
||||
$letter = "N";
|
||||
} elsif ( $letter eq "E" ) {
|
||||
$letter = "W";
|
||||
} elsif ( $letter eq "W" ) {
|
||||
$letter = "E";
|
||||
}
|
||||
# print "$num - $letter\n";
|
||||
|
||||
return "$num$letter";
|
||||
}
|
||||
21
scripts/perl/dafif/dafift2fix.pl
Executable file
21
scripts/perl/dafif/dafift2fix.pl
Executable file
@@ -0,0 +1,21 @@
|
||||
#!/usr/bin/perl
|
||||
########################################################################
|
||||
# Convert DAFIFT WPT.TXT to FlightGear format.
|
||||
########################################################################
|
||||
|
||||
use strict;
|
||||
|
||||
<>; # skip header line
|
||||
|
||||
print "// FlightGear intersection data, generated from DAFIFT WPT.TXT\n";
|
||||
|
||||
while (<>)
|
||||
{
|
||||
chop;
|
||||
my @F = split(/\t/);
|
||||
printf("%-5s %10.6f %11.6f\n", $F[0], $F[14], $F[16]);
|
||||
}
|
||||
|
||||
print "[End]\n";
|
||||
|
||||
# end of dafif2fix.pl
|
||||
566
scripts/perl/dafif/dafift2ils.pl
Executable file
566
scripts/perl/dafif/dafift2ils.pl
Executable file
@@ -0,0 +1,566 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
########################################################################
|
||||
# Convert DAFIFT ARPT/ILS.TXT to FlightGear format.
|
||||
########################################################################
|
||||
|
||||
use strict;
|
||||
|
||||
my($faa_ils_file) = shift(@ARGV);
|
||||
my($dafift_arpt_file) = shift(@ARGV);
|
||||
my($dafift_ils_file) = shift(@ARGV);
|
||||
my($fgfs_ils_file) = shift(@ARGV);
|
||||
my($output_file) = shift(@ARGV);
|
||||
|
||||
die "Usage: $0 " .
|
||||
"<faa_ils_file> <dafift_arpt_file> <dafift_ils_file> <fgfs_ils_file> <output_file>\n"
|
||||
if !defined($faa_ils_file) || !defined($dafift_arpt_file)
|
||||
|| !defined($dafift_ils_file) || !defined($fgfs_ils_file)
|
||||
|| !defined($output_file);
|
||||
|
||||
my( %CODES );
|
||||
my( %CodesByICAO );
|
||||
my( %ILS );
|
||||
my( %AIRPORTS );
|
||||
|
||||
|
||||
&load_dafift( $dafift_arpt_file, $dafift_ils_file );
|
||||
&load_faa( $faa_ils_file );
|
||||
&load_fgfs( $fgfs_ils_file );
|
||||
&write_result( $output_file );
|
||||
|
||||
exit;
|
||||
|
||||
|
||||
########################################################################
|
||||
# Process DAFIFT data
|
||||
########################################################################
|
||||
|
||||
sub load_dafift() {
|
||||
my( $arpt_file ) = shift;
|
||||
my( $ils_file ) = shift;
|
||||
|
||||
my( $record );
|
||||
|
||||
my( $id, $rwy, $type );
|
||||
my( $has_dme, $has_gs, $has_loc, $has_im, $has_mm, $has_om );
|
||||
my( $dme_lon, $dme_lat, $dme_elev, $dme_bias );
|
||||
my( $gs_lon, $gs_lat, $gs_elev, $gs_angle );
|
||||
my( $loc_type, $loc_lon, $loc_lat, $loc_elev, $loc_freq, $loc_hdg,
|
||||
$loc_width, $loc_id );
|
||||
my( $im_lon, $im_lat, $mm_lon, $mm_lat, $om_lon, $om_lat );
|
||||
|
||||
# load airport file so we can lookup ICAO from internal ID
|
||||
|
||||
open( ARPT, "<$arpt_file" ) || die "Cannot open DAFIFT: $arpt_file\n";
|
||||
|
||||
<ARPT>; # skip header line
|
||||
|
||||
while ( <ARPT> ) {
|
||||
chomp;
|
||||
my(@F) = split(/\t/);
|
||||
my($icao) = $F[3];
|
||||
if ( length($icao) < 3 ) {
|
||||
if ( length( $F[4] ) >= 3 ) {
|
||||
$icao = $F[4];
|
||||
} else {
|
||||
$icao = "[none]";
|
||||
}
|
||||
}
|
||||
$CODES{$F[0]} = $icao;
|
||||
$CodesByICAO{$icao} = 1;
|
||||
# print "$F[0] - $icao\n";
|
||||
}
|
||||
|
||||
# Load the DAFIFT ils file
|
||||
|
||||
my( $last_id, $last_rwy ) = ("", "");
|
||||
|
||||
open( DAFIFT_ILS, "<$ils_file" ) || die "Cannot open DAFIFT: $ils_file\n";
|
||||
|
||||
<DAFIFT_ILS>; # skip header line
|
||||
|
||||
while ( <DAFIFT_ILS> ) {
|
||||
chomp;
|
||||
my @F = split(/\t/);
|
||||
$id = $F[0];
|
||||
$rwy = $F[1];
|
||||
|
||||
if ( $last_id ne "" && ($last_id ne $id || $last_rwy ne $rwy) ) {
|
||||
# just hist the start of the next record, dump the current data
|
||||
|
||||
if ( ! $has_gs ) {
|
||||
( $gs_elev, $gs_angle, $gs_lat, $gs_lon ) = ( 0, 0, 0, 0 );
|
||||
}
|
||||
if ( ! $has_dme ) {
|
||||
( $dme_lat, $dme_lon ) = ( 0, 0 );
|
||||
}
|
||||
if ( ! $has_om ) {
|
||||
( $om_lat, $om_lon ) = ( 0, 0 );
|
||||
}
|
||||
if ( ! $has_mm ) {
|
||||
( $mm_lat, $mm_lon ) = ( 0, 0 );
|
||||
}
|
||||
if ( ! $has_im ) {
|
||||
( $im_lat, $im_lon ) = ( 0, 0 );
|
||||
}
|
||||
if ( $ILS{$CODES{$last_id} . $last_rwy} eq "" ) {
|
||||
print "DAFIFT adding: $CODES{$last_id} - $last_rwy\n";
|
||||
&safe_add_record( $CODES{$last_id}, $last_rwy, "ILS",
|
||||
$loc_freq, $loc_id, $loc_hdg, $loc_lat,
|
||||
$loc_lon, $gs_elev, $gs_angle, $gs_lat,
|
||||
$gs_lon, $dme_lat, $dme_lon, $om_lat,
|
||||
$om_lon, $mm_lat, $mm_lon, $im_lat,
|
||||
$im_lon );
|
||||
}
|
||||
|
||||
$has_dme = 0;
|
||||
$has_gs = 0;
|
||||
$has_loc = 0;
|
||||
$has_im = 0;
|
||||
$has_mm = 0;
|
||||
$has_om = 0;
|
||||
}
|
||||
|
||||
$type = $F[2];
|
||||
if ( $type eq "D" ) {
|
||||
# DME entry
|
||||
$has_dme = 1;
|
||||
$dme_lon = make_dcoord( $F[16] );
|
||||
$dme_lat = make_dcoord( $F[14] );
|
||||
$dme_elev = $F[10];
|
||||
if ( $dme_elev !~ m/\d/ ) {
|
||||
$dme_elev = "";
|
||||
} else {
|
||||
$dme_elev += 0;
|
||||
}
|
||||
$dme_bias = $F[27];
|
||||
# print "$id DME $dme_lon $dme_lat $dme_elev $dme_bias\n";
|
||||
} elsif ( $type eq "G" ) {
|
||||
# GlideSlope entry
|
||||
$has_gs = 1;
|
||||
$gs_lon = make_dcoord( $F[16] );
|
||||
$gs_lat = make_dcoord( $F[14] );
|
||||
$gs_elev = $F[10];
|
||||
if ( $gs_elev !~ m/\d/ ) {
|
||||
$gs_elev = "";
|
||||
} else {
|
||||
$gs_elev += 0;
|
||||
}
|
||||
$gs_angle = $F[7];
|
||||
# print "$id GS $gs_lon $gs_lat $gs_elev $gs_angle\n";
|
||||
} elsif ( $type eq "Z" ) {
|
||||
# Localizer entry
|
||||
$has_loc = 1;
|
||||
$loc_lon = make_dcoord( $F[16] );
|
||||
$loc_lat = make_dcoord( $F[14] );
|
||||
$loc_elev = $F[10];
|
||||
if ( $loc_elev !~ m/\d/ ) {
|
||||
$loc_elev = "";
|
||||
} else {
|
||||
$loc_elev += 0;
|
||||
}
|
||||
($loc_freq) = $F[5] =~ m/(\d\d\d\d\d\d)/;
|
||||
$loc_freq /= 1000.0;
|
||||
my( $magvar ) = make_dmagvar( $F[22] );
|
||||
# print "mag var = $F[22] (" . $magvar . ")\n";
|
||||
$loc_hdg = $F[24] + make_dmagvar( $F[22] );
|
||||
$loc_width = $F[25];
|
||||
$loc_id = $F[18];
|
||||
if ( length( $loc_id ) >= 4 ) {
|
||||
$loc_id =~ s/^I//;
|
||||
}
|
||||
# print "$id LOC $loc_lon $loc_lat $loc_elev $loc_freq $loc_hdg $loc_width\n";
|
||||
} elsif ( $type eq "I" ) {
|
||||
# Inner marker entry
|
||||
$has_im = 1;
|
||||
$im_lon = make_dcoord( $F[16] );
|
||||
$im_lat = make_dcoord( $F[14] );
|
||||
# print "$id IM $im_lon $im_lat\n";
|
||||
} elsif ( $type eq "M" ) {
|
||||
# Middle marker entry
|
||||
$has_mm = 1;
|
||||
$mm_lon = make_dcoord( $F[16] );
|
||||
$mm_lat = make_dcoord( $F[14] );
|
||||
# print "$id MM $mm_lon $mm_lat\n";
|
||||
} elsif ( $type eq "O" ) {
|
||||
# Outer marker entry
|
||||
$has_om = 1;
|
||||
$om_lon = make_dcoord( $F[16] );
|
||||
$om_lat = make_dcoord( $F[14] );
|
||||
# print "$id OM $om_lon $om_lat\n";
|
||||
}
|
||||
|
||||
$last_id = $id;
|
||||
$last_rwy = $rwy;
|
||||
# printf("%-5s %10.6f %11.6f\n", $F[0], $F[14], $F[16]);
|
||||
}
|
||||
|
||||
if ( ! $has_gs ) {
|
||||
( $gs_elev, $gs_angle, $gs_lat, $gs_lon ) = ( 0, 0, 0, 0 );
|
||||
}
|
||||
if ( ! $has_dme ) {
|
||||
( $dme_lat, $dme_lon ) = ( 0, 0 );
|
||||
}
|
||||
if ( ! $has_om ) {
|
||||
( $om_lat, $om_lon ) = ( 0, 0 );
|
||||
}
|
||||
if ( ! $has_mm ) {
|
||||
( $mm_lat, $mm_lon ) = ( 0, 0 );
|
||||
}
|
||||
if ( ! $has_im ) {
|
||||
( $im_lat, $im_lon ) = ( 0, 0 );
|
||||
}
|
||||
if ( $ILS{$CODES{$last_id} . $last_rwy} eq "" ) {
|
||||
print "DAFIFT adding (last): $CODES{$last_id} - $last_rwy\n";
|
||||
&safe_add_record( $CODES{$last_id}, $last_rwy, "ILS", $loc_freq,
|
||||
$loc_id, $loc_hdg, $loc_lat, $loc_lon,
|
||||
$gs_elev, $gs_angle, $gs_lat, $gs_lon,
|
||||
$dme_lat, $dme_lon, $om_lat, $om_lon, $mm_lat,
|
||||
$mm_lon, $im_lat, $im_lon );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
########################################################################
|
||||
# Process FAA data
|
||||
########################################################################
|
||||
|
||||
sub load_faa() {
|
||||
my( $file ) = shift;
|
||||
|
||||
open( FAA_ILS, "<$file" ) || die "Cannot open FAA data: $file\n";
|
||||
|
||||
<FAA_ILS>; # skip header line
|
||||
|
||||
while ( <FAA_ILS> ) {
|
||||
chomp;
|
||||
|
||||
my ( $rec_type, $faa_id, $rwy, $type, $faa_date,
|
||||
$faa_apt_name, $faa_city, $faa_st, $faa_state,
|
||||
$faa_region, $id, $faa_len, $faa_wid, $faa_cat,
|
||||
$faa_owner, $faa_operator, $faa_bearing, $faa_magvar,
|
||||
$loc_type, $loc_id, $loc_freq, $faa_loc_latd,
|
||||
$faa_loc_lats, $faa_loc_lond, $faa_loc_lons, $loc_width,
|
||||
$faa_stop_dist, $faa_app_dist, $faa_gs_type, $gs_angle,
|
||||
$faa_gs_freq, $faa_gs_latd, $faa_gs_lats, $faa_gs_lond,
|
||||
$faa_gs_lons, $faa_gs_dist, $gs_elev, $faa_im_type,
|
||||
$faa_im_latd, $faa_im_lats, $faa_im_lond, $faa_im_lons,
|
||||
$faa_im_dist, $faa_mm_type, $faa_mm_id, $faa_mm_name,
|
||||
$faa_mm_freq, $faa_mm_latd, $faa_mm_lats, $faa_mm_lond,
|
||||
$faa_mm_lons, $faa_mm_dist, $faa_om_type, $faa_om_id,
|
||||
$faa_om_name, $faa_om_freq, $faa_om_latd, $faa_om_lats,
|
||||
$faa_om_lond, $faa_om_lons, $faa_om_dist,
|
||||
$faa_om_backcourse, $faa_dme_channel, $faa_dme_latd,
|
||||
$faa_dme_lats, $faa_dme_lond, $faa_dme_lons, $faa_dme_app_dist,
|
||||
$faa_dme_stop_dist, $blank)
|
||||
= $_ =~
|
||||
m/^(.{4})(.{11})(.{3})(.{10})(.{10})(.{42})(.{26})(.{2})(.{20})(.{3})(.{4})(.{5})(.{4})(.{9})(.{50})(.{50})(.{3})(.{3})(.{15})(.{5})(.{6})(.{14})(.{11})(.{14})(.{11})(.{5})(.{5})(.{6})(.{15})(.{4})(.{6})(.{14})(.{11})(.{14})(.{11})(.{6})(.{7})(.{15})(.{14})(.{11})(.{14})(.{11})(.{6})(.{15})(.{2})(.{5})(.{3})(.{14})(.{11})(.{14})(.{11})(.{6})(.{15})(.{2})(.{5})(.{3})(.{14})(.{11})(.{14})(.{11})(.{6})(.{9})(.{4})(.{14})(.{11})(.{14})(.{11})(.{6})(.{5})(.{34})/;
|
||||
|
||||
$id = &strip_ws( $id );
|
||||
$rwy = &strip_ws( $rwy );
|
||||
$rwy =~ s/\/$//;
|
||||
$rwy =~ s/\/$//;
|
||||
$loc_id =~ s/^I-//;
|
||||
my( $loc_hdg ) = $faa_bearing + make_dmagvar($faa_magvar);
|
||||
my( $loc_lat ) = make_dcoord($faa_loc_lats) / 3600.0;
|
||||
my( $loc_lon ) = make_dcoord($faa_loc_lons) / 3600.0;
|
||||
# print "$loc_lon $loc_lat $faa_loc_lons $faa_loc_lats\n";
|
||||
my( $gs_lat ) = make_dcoord($faa_gs_lats) / 3600.0;
|
||||
my( $gs_lon ) = make_dcoord($faa_gs_lons) / 3600.0;
|
||||
my( $im_lat ) = make_dcoord($faa_im_lats) / 3600.0;
|
||||
my( $im_lon ) = make_dcoord($faa_im_lons) / 3600.0;
|
||||
my( $mm_lat ) = make_dcoord($faa_mm_lats) / 3600.0;
|
||||
my( $mm_lon ) = make_dcoord($faa_mm_lons) / 3600.0;
|
||||
my( $om_lat ) = make_dcoord($faa_om_lats) / 3600.0;
|
||||
my( $om_lon ) = make_dcoord($faa_om_lons) / 3600.0;
|
||||
my( $dme_lat ) = make_dcoord($faa_dme_lats) / 3600.0;
|
||||
my( $dme_lon ) = make_dcoord($faa_dme_lons) / 3600.0;
|
||||
|
||||
# my( $key );
|
||||
# print "$id - $rwy\n";
|
||||
# $key = $id . $rwy;
|
||||
# print "-> $key -> $ILS{$key}\n";
|
||||
# $key = "K" . $id . $rwy;
|
||||
# print "-> $key -> $ILS{$key}\n";
|
||||
|
||||
if ( $rec_type eq "ILS1" ) {
|
||||
if ( length( $id ) < 4 ) {
|
||||
if ( $CodesByICAO{"K" . $id} ) {
|
||||
$id = "K" . $id;
|
||||
}
|
||||
}
|
||||
if ( $ILS{$id . $rwy} ne "" ) {
|
||||
print "FAA updating: $id - $rwy $type\n";
|
||||
&update_type( $id, $rwy, $type );
|
||||
} else {
|
||||
print "FAA adding: $id - $rwy\n";
|
||||
&safe_add_record( $id, $rwy, $type, $loc_freq, $loc_id,
|
||||
$loc_hdg, $loc_lat, $loc_lon, $gs_elev,
|
||||
$gs_angle, $gs_lat, $gs_lon, $dme_lat,
|
||||
$dme_lon, $om_lat, $om_lon, $mm_lat,
|
||||
$mm_lon, $im_lat, $im_lon );
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
########################################################################
|
||||
# Process FlightGear ILS data
|
||||
########################################################################
|
||||
|
||||
sub load_fgfs() {
|
||||
my( $ils_file ) = shift;
|
||||
|
||||
open( FGILS, "zcat $ils_file|" ) || die "Cannot open FGFS: $ils_file\n";
|
||||
|
||||
<FGILS>; # skip header line
|
||||
|
||||
while ( <FGILS> ) {
|
||||
chomp;
|
||||
if ( ! m/\[End\]/ && length($_) > 1 ) {
|
||||
# print "$_\n";
|
||||
my( $type_code, $type_name, $icao, $rwy, $loc_freq, $loc_id,
|
||||
$loc_hdg, $loc_lat, $loc_lon, $gs_elev, $gs_angle, $gs_lat,
|
||||
$gs_lon, $dme_lat, $dme_lon, $om_lat, $om_lon, $mm_lat, $mm_lon,
|
||||
$im_lat, $im_lon ) = split(/\s+/);
|
||||
my( $code ) = $icao;
|
||||
$code =~ s/^K//;
|
||||
if ( $ILS{$icao . $rwy} ne "" ) {
|
||||
print "FGFS: Skipping $icao - $rwy - already exists\n";
|
||||
# skip approaches already in FAA or DAFIFT data
|
||||
} elsif ( length( $icao ) < 4 || $icao =~ m/^K/ ) {
|
||||
print "FGFS: Skipping $icao - $rwy - USA\n";
|
||||
# skip USA approaches not found in FAA or DAFIFT data
|
||||
} else {
|
||||
print "FGFS adding: $icao $rwy\n";
|
||||
&safe_add_record( $icao, $rwy, $type_name, $loc_freq, $loc_id,
|
||||
$loc_hdg, $loc_lat, $loc_lon, $gs_elev,
|
||||
$gs_angle, $gs_lat, $gs_lon, $dme_lat,
|
||||
$dme_lon, $om_lat, $om_lon, $mm_lat,
|
||||
$mm_lon, $im_lat, $im_lon );
|
||||
}
|
||||
} else {
|
||||
print "FGFS discarding: $_\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
########################################################################
|
||||
# Write out the accumulated combined result
|
||||
########################################################################
|
||||
|
||||
sub write_result() {
|
||||
my( $outfile ) = shift;
|
||||
|
||||
open( OUT, ">$outfile" ) || die "Cannot write to: $outfile\n";
|
||||
|
||||
# dump out the final results
|
||||
print OUT "// FlightGear ILS data, generated from DAFIFT ARPT/ILS.TXT and FAA data\n";
|
||||
|
||||
my( $key );
|
||||
foreach $key ( sort (keys %ILS) ) {
|
||||
print OUT "$ILS{$key}\n";
|
||||
}
|
||||
print OUT "[End]\n";
|
||||
}
|
||||
|
||||
|
||||
########################################################################
|
||||
# Utility functions
|
||||
########################################################################
|
||||
|
||||
|
||||
# add a record to the master list if it doesn't already exist
|
||||
|
||||
sub safe_add_record() {
|
||||
my( $apt_id ) = shift;
|
||||
my( $rwy ) = shift;
|
||||
my( $type ) = shift;
|
||||
my( $loc_freq ) = shift;
|
||||
my( $loc_id ) = shift;
|
||||
my( $loc_hdg ) = shift;
|
||||
my( $loc_lat ) = shift;
|
||||
my( $loc_lon ) = shift;
|
||||
my( $gs_elev ) = shift;
|
||||
my( $gs_angle ) = shift;
|
||||
my( $gs_lat ) = shift;
|
||||
my( $gs_lon ) = shift;
|
||||
my( $dme_lat ) = shift;
|
||||
my( $dme_lon ) = shift;
|
||||
my( $om_lat ) = shift;
|
||||
my( $om_lon ) = shift;
|
||||
my( $mm_lat ) = shift;
|
||||
my( $mm_lon ) = shift;
|
||||
my( $im_lat ) = shift;
|
||||
my( $im_lon ) = shift;
|
||||
|
||||
if ( $ILS{$apt_id . $rwy} eq "" ) {
|
||||
# print "Safe adding (common): $apt_id - $rwy\n";
|
||||
&update_record( $apt_id, $rwy, $type, $loc_freq, $loc_id,
|
||||
$loc_hdg, $loc_lat, $loc_lon, $gs_elev,
|
||||
$gs_angle, $gs_lat, $gs_lon, $dme_lat,
|
||||
$dme_lon, $om_lat, $om_lon, $mm_lat,
|
||||
$mm_lon, $im_lat, $im_lon );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# replace a record in the master list (or add it if it doesn't exist)
|
||||
|
||||
sub update_record() {
|
||||
my( $apt_id ) = shift;
|
||||
my( $rwy ) = shift;
|
||||
my( $type ) = shift;
|
||||
my( $loc_freq ) = shift;
|
||||
my( $loc_id ) = shift;
|
||||
my( $loc_hdg ) = shift;
|
||||
my( $loc_lat ) = shift;
|
||||
my( $loc_lon ) = shift;
|
||||
my( $gs_elev ) = shift;
|
||||
my( $gs_angle ) = shift;
|
||||
my( $gs_lat ) = shift;
|
||||
my( $gs_lon ) = shift;
|
||||
my( $dme_lat ) = shift;
|
||||
my( $dme_lon ) = shift;
|
||||
my( $om_lat ) = shift;
|
||||
my( $om_lon ) = shift;
|
||||
my( $mm_lat ) = shift;
|
||||
my( $mm_lon ) = shift;
|
||||
my( $im_lat ) = shift;
|
||||
my( $im_lon ) = shift;
|
||||
|
||||
my( $record );
|
||||
|
||||
# remap $type as needed
|
||||
$type = &strip_ws( $type );
|
||||
if ( $type eq "LOCALIZER" ) {
|
||||
$type = "LOC";
|
||||
} elsif ( $type eq "ILS/DME" ) {
|
||||
$type = "ILS";
|
||||
} elsif ( $type eq "SDF/DME" ) {
|
||||
$type = "SDF";
|
||||
} elsif ( $type eq "LOC/DME" ) {
|
||||
$type = "ILS";
|
||||
} elsif ( $type eq "LOC/GS" ) {
|
||||
$type = "LOC";
|
||||
} elsif ( $type eq "LDA/DME" ) {
|
||||
$type = "LDA";
|
||||
}
|
||||
|
||||
$record = sprintf( "%1s %-5s %-4s %-3s %06.2f %-4s %06.2f %10.6f %11.6f ",
|
||||
substr( $type, 0, 1 ), $type, $apt_id, $rwy,
|
||||
$loc_freq, $loc_id, $loc_hdg, $loc_lat, $loc_lon );
|
||||
$record .= sprintf( "%5d %5.2f %10.6f %11.6f ",
|
||||
$gs_elev, $gs_angle, $gs_lat, $gs_lon );
|
||||
$record .= sprintf( "%10.6f %11.6f ", $dme_lat, $dme_lon );
|
||||
$record .= sprintf( "%10.6f %11.6f ", $om_lat, $om_lon );
|
||||
$record .= sprintf( "%10.6f %11.6f ", $mm_lat, $mm_lon );
|
||||
$record .= sprintf( "%10.6f %11.6f ", $im_lat, $im_lon );
|
||||
|
||||
# print "Updating (common): $apt_id - $rwy\n";
|
||||
$ILS{$apt_id . $rwy} = $record;
|
||||
$AIRPORTS{$apt_id} = 1;
|
||||
}
|
||||
|
||||
|
||||
# update the $type of the record
|
||||
sub update_type() {
|
||||
my( $apt_id ) = shift;
|
||||
my( $rwy ) = shift;
|
||||
my( $new_type ) = shift;
|
||||
|
||||
my( $record );
|
||||
|
||||
if ( $ILS{$apt_id . $rwy} ne "" ) {
|
||||
my( $type_code, $type_name, $apt_id, $rwy, $loc_freq, $loc_id,
|
||||
$loc_hdg, $loc_lat, $loc_lon, $gs_elev, $gs_angle, $gs_lat,
|
||||
$gs_lon, $dme_lat, $dme_lon, $om_lat, $om_lon, $mm_lat, $mm_lon,
|
||||
$im_lat, $im_lon ) = split( /\s+/, $ILS{$apt_id . $rwy} );
|
||||
# print "Updating type: $apt_id $rwy: $type_name -> $new_type\n";
|
||||
$type_name = $new_type;
|
||||
&update_record( $apt_id, $rwy, $type_name, $loc_freq, $loc_id,
|
||||
$loc_hdg, $loc_lat, $loc_lon, $gs_elev,
|
||||
$gs_angle, $gs_lat, $gs_lon, $dme_lat,
|
||||
$dme_lon, $om_lat, $om_lon, $mm_lat,
|
||||
$mm_lon, $im_lat, $im_lon );
|
||||
} else {
|
||||
die "Error, trying to update $apt_id - $rwy which doesn't exist\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# convert a lon/lat coordinate in various formats to signed decimal
|
||||
|
||||
sub make_dcoord() {
|
||||
my($coord) = shift;
|
||||
my( $dir, $deg, $min, $sec );
|
||||
my( $value ) = 0.0;
|
||||
|
||||
$coord = &strip_ws( $coord );
|
||||
|
||||
if ( $coord =~ m/^[WE]/ ) {
|
||||
( $dir, $deg, $min, $sec )
|
||||
= $coord =~ m/^([EW])(\d\d\d)(\d\d)(\d\d\d\d)/;
|
||||
$value = $deg + $min/60.0 + ($sec/100)/3600.0;
|
||||
if ( $dir eq "W" ) {
|
||||
$value = -$value;
|
||||
}
|
||||
} elsif ( $coord =~ m/^[NS]/ ) {
|
||||
( $dir, $deg, $min, $sec )
|
||||
= $coord =~ m/^([NS])(\d\d)(\d\d)(\d\d\d\d)/;
|
||||
$value = $deg + $min/60.0 + ($sec/100)/3600.0;
|
||||
if ( $dir eq "S" ) {
|
||||
$value = -$value;
|
||||
}
|
||||
} elsif ( $coord =~ m/[EW]$/ ) {
|
||||
($value, $dir) = $coord =~ m/([\d\s\.]+)([EW])/;
|
||||
if ( $dir eq "W" ) {
|
||||
$value = -$value;
|
||||
}
|
||||
} elsif ( $coord =~ m/[NS]$/ ) {
|
||||
($value, $dir) = $coord =~ m/([\d\s\.]+)([NS])/;
|
||||
if ( $dir eq "S" ) {
|
||||
$value = -$value;
|
||||
}
|
||||
}
|
||||
# print "$dir $deg:$min:$sec = $value\n";
|
||||
return $value;
|
||||
}
|
||||
|
||||
# convert a magnetic variation in various formats to signed decimal
|
||||
|
||||
sub make_dmagvar() {
|
||||
my( $coord ) = shift;
|
||||
my( $value );
|
||||
|
||||
if ( $coord =~ m/^[EW]/ ) {
|
||||
my( $dir, $deg, $min, $date )
|
||||
= $coord =~ m/^([EW])(\d\d\d)(\d\d\d) (\d\d\d\d)/;
|
||||
$value = $deg + ($min/10)/60.0;
|
||||
if ( $dir eq "W" ) {
|
||||
$value = -$value;
|
||||
}
|
||||
} elsif ( $coord =~ m/[EW]$/ ) {
|
||||
my( $deg, $dir )
|
||||
= $coord =~ m/^(\d\d)([EW])/;
|
||||
$value = $deg;
|
||||
if ( $dir eq "W" ) {
|
||||
$value = -$value;
|
||||
}
|
||||
}
|
||||
# print "$dir $deg:$min = $value\n";
|
||||
|
||||
return $value;
|
||||
}
|
||||
|
||||
# strip white space off front and back of string
|
||||
|
||||
sub strip_ws() {
|
||||
my( $string ) = shift;
|
||||
$string =~ s/^\s+//;
|
||||
$string =~ s/\s+$//;
|
||||
return $string;
|
||||
}
|
||||
160
scripts/perl/dafif/dafift2nav.pl
Executable file
160
scripts/perl/dafif/dafift2nav.pl
Executable file
@@ -0,0 +1,160 @@
|
||||
#!/usr/bin/perl
|
||||
########################################################################
|
||||
# Convert DAFIFT NAV.TXT to FlightGear format.
|
||||
########################################################################
|
||||
|
||||
use strict;
|
||||
|
||||
my @TYPES = (
|
||||
'', # Unknown
|
||||
'V', # VOR
|
||||
'V', # VORTAC
|
||||
'D', # TACAN
|
||||
'V', # VOR/DME
|
||||
'N', # NDB
|
||||
'',
|
||||
'N', # NDB/DME
|
||||
'',
|
||||
'D' # DME
|
||||
);
|
||||
|
||||
my @TYPE_NAMES = (
|
||||
'',
|
||||
'VOR',
|
||||
'VORTAC',
|
||||
'TACAN',
|
||||
'VOR/DME',
|
||||
'NDB',
|
||||
'',
|
||||
'NDB/DME',
|
||||
'',
|
||||
'DME'
|
||||
);
|
||||
|
||||
my @HAS_DME = (
|
||||
'N', # Unknown
|
||||
'N', # VOR
|
||||
'Y', # VORTAC
|
||||
'Y', # TACAN
|
||||
'Y', # VOR/DME
|
||||
'N', # NDB
|
||||
'N',
|
||||
'Y', # NDB/DME (not used, though)
|
||||
'N',
|
||||
'Y' # DME
|
||||
);
|
||||
|
||||
# Make a frequency from a DME channel
|
||||
sub make_freq {
|
||||
my ($type, $channel) = (@_);
|
||||
my $offset = 0;
|
||||
$offset = 0.05 if ($channel =~ /Y$/);
|
||||
if ($channel < 67) {
|
||||
return 108 + (($channel - 17)/10.0) + $offset;
|
||||
} else {
|
||||
return 112 + (($channel - 67)/10.0) + $offset;
|
||||
}
|
||||
}
|
||||
|
||||
# Make a range based on navaid type and purpose
|
||||
sub make_range {
|
||||
my ($type, $usage) = (@_);
|
||||
if ($type == 1 || $type == 2 || $type ==4) { # VOR
|
||||
if ($usage == 'H' || $usage == 'B') {
|
||||
return 200;
|
||||
} elsif ($usage == 'T') {
|
||||
return 20;
|
||||
} else {
|
||||
return 50;
|
||||
}
|
||||
} elsif ($type == 3 || $type == 7) { # DME
|
||||
if ($usage == 'T') {
|
||||
return 50;
|
||||
} else {
|
||||
return 200;
|
||||
}
|
||||
} else { # NDB
|
||||
if ($usage == 'T') {
|
||||
return 50;
|
||||
} else {
|
||||
return 200;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub write_navaid {
|
||||
my ($type, $lat, $lon, $elev, $freq, $range, $dme, $id, $magvar, $name)
|
||||
= (@_);
|
||||
|
||||
printf("%s %10.6f %11.6f %6d %7.2f %4d %s %-4s %s %s %s\n",
|
||||
$TYPES[$type], $lat, $lon, $elev, $freq, $range, $dme, $id,
|
||||
$magvar, $name, $TYPE_NAMES[$type]);
|
||||
}
|
||||
|
||||
sub make_dmagvar {
|
||||
my($coord) = shift;
|
||||
my( $value );
|
||||
my( $dir, $deg, $date ) = $coord =~ m/^([EW])(\d\d\d\d)(\d\d\d\d)/;
|
||||
$value = $deg / 10.0;
|
||||
if ( $dir eq "W" ) {
|
||||
$value = -$value;
|
||||
}
|
||||
|
||||
return $value;
|
||||
}
|
||||
|
||||
|
||||
<>; # skip header line
|
||||
|
||||
print "// FlightGear navaid data, generated from DAFIFT NAV.TXT\n";
|
||||
|
||||
while (<>)
|
||||
{
|
||||
chop;
|
||||
my @F = split(/\t/);
|
||||
|
||||
my $type = $F[1];
|
||||
if ($TYPES[$type] eq '') {
|
||||
warn("Bad type for " . $F[0] . "(" . $F[5] . ")\n");
|
||||
next;
|
||||
}
|
||||
my $lat = $F[18];
|
||||
my $lon = $F[20];
|
||||
my $elev = $F[23];
|
||||
my $freq = $F[8]/1000;
|
||||
if ($type == 3 || $type == 9) {
|
||||
$freq = make_freq($type, $F[10]);
|
||||
}
|
||||
my $range = 0 + $F[14];
|
||||
if ($range == 0) {
|
||||
$range = make_range($type, $F[9]);
|
||||
}
|
||||
my $id = $F[0];
|
||||
my $magvar = $F[21];
|
||||
if ($magvar eq '') {
|
||||
$magvar = 'XXX';
|
||||
} else {
|
||||
my $tmp = make_dmagvar( $magvar );
|
||||
# print "$magvar $tmp\n";
|
||||
if ( $tmp <= 0 ) {
|
||||
$magvar = sprintf("%02.0fW", -$tmp );
|
||||
} else {
|
||||
$magvar = sprintf("%02.0fE", $tmp );
|
||||
}
|
||||
}
|
||||
my $name = $F[5];
|
||||
|
||||
if ($type == 7) { # NDB/DME
|
||||
write_navaid(9, $lat, $lon, $elev, make_freq(9, $F[10]), $range,
|
||||
'Y', $id, $magvar, $name);
|
||||
$type = 5;
|
||||
}
|
||||
write_navaid($type, $lat, $lon, $elev, $freq, $range,
|
||||
$HAS_DME[$F[1]], $id, $magvar, $name);
|
||||
|
||||
|
||||
}
|
||||
|
||||
print "[End]\n";
|
||||
|
||||
# end of dafif2fix.pl
|
||||
109
scripts/perl/examples/aircraft.pl
Executable file
109
scripts/perl/examples/aircraft.pl
Executable file
@@ -0,0 +1,109 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# aircraft.pl - Handle aircraft functions
|
||||
#
|
||||
# Written by Curtis L. Olson, started January 2004
|
||||
#
|
||||
# Copyright (C) 2004 Curtis L. Olson - http://www.flightgear.org/~curt
|
||||
#
|
||||
# This code is placed in the public domain by Curtis L. Olson.
|
||||
# There is no warranty, etc. etc. etc.
|
||||
#
|
||||
# $Id$
|
||||
# ----------------------------------------------------------------------------
|
||||
|
||||
require "telnet.pl";
|
||||
|
||||
use strict;
|
||||
|
||||
sub start_engine {
|
||||
my( $fgfs ) = shift;
|
||||
my( $engine_num ) = shift;
|
||||
|
||||
my( $prop, $value );
|
||||
my( %HASH ) = ();
|
||||
|
||||
&set_prop( $fgfs, "/controls/engines/engine[$engine_num]/magnetos", "3" );
|
||||
&set_prop( $fgfs, "/controls/engines/engine[$engine_num]/starter", "true" );
|
||||
sleep(3);
|
||||
&set_prop( $fgfs, "/controls/engines/engine[$engine_num]/starter",
|
||||
"false" );
|
||||
}
|
||||
|
||||
|
||||
sub set_throttle {
|
||||
my( $fgfs ) = shift;
|
||||
my( $engine ) = shift;
|
||||
my( $throttle_norm ) = shift;
|
||||
|
||||
&set_prop( $fgfs, "/controls/engines/engine[$engine]/throttle",
|
||||
$throttle_norm );
|
||||
}
|
||||
|
||||
|
||||
sub set_mixture {
|
||||
my( $fgfs ) = shift;
|
||||
my( $engine ) = shift;
|
||||
my( $mix_norm ) = shift;
|
||||
|
||||
&set_prop( $fgfs, "/controls/engines/engine[$engine]/mixture", $mix_norm );
|
||||
}
|
||||
|
||||
|
||||
sub set_weight {
|
||||
my( $fgfs ) = shift;
|
||||
my( $lbs ) = shift;
|
||||
|
||||
&set_prop( $fgfs, "/sim/aircraft-weight-lbs", $lbs );
|
||||
}
|
||||
|
||||
|
||||
sub set_cg {
|
||||
my( $fgfs ) = shift;
|
||||
my( $inches ) = shift;
|
||||
|
||||
&set_prop( $fgfs, "/sim/aircraft-cg-offset-inches", $inches );
|
||||
}
|
||||
|
||||
|
||||
sub set_parking_brake {
|
||||
my( $fgfs ) = shift;
|
||||
my( $pos_norm ) = shift;
|
||||
|
||||
&set_prop( $fgfs, "/controls/gear/brake-parking", $pos_norm );
|
||||
}
|
||||
|
||||
sub set_flaps {
|
||||
my( $fgfs ) = shift;
|
||||
my( $pos_norm ) = shift;
|
||||
|
||||
&set_prop( $fgfs, "/controls/flight/flaps", $pos_norm );
|
||||
}
|
||||
|
||||
sub set_aileron {
|
||||
my( $fgfs ) = shift;
|
||||
my( $pos_norm ) = shift;
|
||||
|
||||
&set_prop( $fgfs, "/controls/flight/aileron", $pos_norm );
|
||||
}
|
||||
|
||||
sub set_elevator {
|
||||
my( $fgfs ) = shift;
|
||||
my( $pos_norm ) = shift;
|
||||
|
||||
&set_prop( $fgfs, "/controls/flight/elevator", $pos_norm );
|
||||
}
|
||||
|
||||
sub set_elevator_trim {
|
||||
my( $fgfs ) = shift;
|
||||
my( $pos_norm ) = shift;
|
||||
|
||||
&set_prop( $fgfs, "/controls/flight/elevator-trim", $pos_norm );
|
||||
}
|
||||
|
||||
sub set_rudder {
|
||||
my( $fgfs ) = shift;
|
||||
my( $pos_norm ) = shift;
|
||||
|
||||
&set_prop( $fgfs, "/controls/flight/rudder", $pos_norm );
|
||||
}
|
||||
154
scripts/perl/examples/autopilot.pl
Executable file
154
scripts/perl/examples/autopilot.pl
Executable file
@@ -0,0 +1,154 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# autopilot.pl - Handle autopilot functions
|
||||
#
|
||||
# Written by Curtis L. Olson, started January 2004
|
||||
#
|
||||
# Copyright (C) 2004 Curtis L. Olson - http://www.flightgear.org/~curt
|
||||
#
|
||||
# This code is placed in the public domain by Curtis L. Olson.
|
||||
# There is no warranty, etc. etc. etc.
|
||||
#
|
||||
# $Id$
|
||||
# ----------------------------------------------------------------------------
|
||||
|
||||
|
||||
require "telnet.pl";
|
||||
|
||||
use strict;
|
||||
|
||||
|
||||
sub autopilot_off {
|
||||
my( $fgfs ) = shift;
|
||||
|
||||
&set_prop( $fgfs, "/autopilot/locks/heading", "" );
|
||||
&set_prop( $fgfs, "/autopilot/locks/altitude", "" );
|
||||
&set_prop( $fgfs, "/autopilot/locks/speed", "" );
|
||||
}
|
||||
|
||||
|
||||
sub wing_leveler {
|
||||
my( $fgfs ) = shift;
|
||||
my( $state ) = shift;
|
||||
|
||||
if ( $state ) {
|
||||
&set_prop( $fgfs, "/autopilot/locks/heading", "wing-leveler" );
|
||||
} else {
|
||||
&set_prop( $fgfs, "/autopilot/locks/heading", "" );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub bank_hold {
|
||||
my( $fgfs ) = shift;
|
||||
my( $state ) = shift;
|
||||
my( $bank_deg ) = shift;
|
||||
|
||||
if ( $state ) {
|
||||
&set_prop( $fgfs, "/autopilot/locks/heading", "bank-hold" );
|
||||
&set_prop( $fgfs, "/autopilot/settings/target-bank-deg", $bank_deg );
|
||||
} else {
|
||||
&set_prop( $fgfs, "/autopilot/locks/heading", "" );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub heading_hold {
|
||||
my( $fgfs ) = shift;
|
||||
my( $state ) = shift;
|
||||
my( $hdg_deg ) = shift;
|
||||
|
||||
if ( $state ) {
|
||||
&set_prop( $fgfs, "/autopilot/locks/heading", "dg-heading-hold" );
|
||||
&set_prop( $fgfs, "/autopilot/settings/heading-bug-deg", $hdg_deg );
|
||||
} else {
|
||||
&set_prop( $fgfs, "/autopilot/locks/heading", "" );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub pitch_hold_trim {
|
||||
my( $fgfs ) = shift;
|
||||
my( $state ) = shift;
|
||||
my( $pitch_deg ) = shift;
|
||||
|
||||
if ( $state ) {
|
||||
&set_prop( $fgfs, "/autopilot/locks/altitude", "pitch-hold" );
|
||||
&set_prop( $fgfs, "/autopilot/settings/target-pitch-deg", $pitch_deg );
|
||||
} else {
|
||||
&set_prop( $fgfs, "/autopilot/locks/altitude", "" );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub pitch_hold_yoke {
|
||||
my( $fgfs ) = shift;
|
||||
my( $state ) = shift;
|
||||
my( $pitch_deg ) = shift;
|
||||
|
||||
if ( $state ) {
|
||||
&set_prop( $fgfs, "/autopilot/locks/altitude", "pitch-hold-yoke" );
|
||||
&set_prop( $fgfs, "/autopilot/settings/target-pitch-deg", $pitch_deg );
|
||||
} else {
|
||||
&set_prop( $fgfs, "/autopilot/locks/altitude", "" );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub altitude_hold {
|
||||
my( $fgfs ) = shift;
|
||||
my( $state ) = shift;
|
||||
my( $alt_ft ) = shift;
|
||||
|
||||
if ( $state ) {
|
||||
&set_prop( $fgfs, "/autopilot/locks/altitude", "altitude-hold" );
|
||||
&set_prop( $fgfs, "/autopilot/settings/target-altitude-ft", $alt_ft );
|
||||
} else {
|
||||
&set_prop( $fgfs, "/autopilot/locks/altitude", "" );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub auto_speed_throttle {
|
||||
my( $fgfs ) = shift;
|
||||
my( $state ) = shift;
|
||||
my( $kts ) = shift;
|
||||
|
||||
if ( $state ) {
|
||||
&set_prop( $fgfs, "/autopilot/locks/speed", "speed-with-throttle" );
|
||||
&set_prop( $fgfs, "/autopilot/settings/target-speed-kt", $kts );
|
||||
} else {
|
||||
&set_prop( $fgfs, "/autopilot/locks/speed", "" );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub auto_speed_pitch_trim {
|
||||
my( $fgfs ) = shift;
|
||||
my( $state ) = shift;
|
||||
my( $kts ) = shift;
|
||||
|
||||
if ( $state ) {
|
||||
&set_prop( $fgfs, "/autopilot/locks/speed", "speed-with-pitch-trim" );
|
||||
&set_prop( $fgfs, "/autopilot/settings/target-speed-kt", $kts );
|
||||
} else {
|
||||
&set_prop( $fgfs, "/autopilot/locks/speed", "" );
|
||||
}
|
||||
}
|
||||
|
||||
sub auto_speed_pitch_yoke {
|
||||
my( $fgfs ) = shift;
|
||||
my( $state ) = shift;
|
||||
my( $kts ) = shift;
|
||||
|
||||
if ( $state ) {
|
||||
&set_prop( $fgfs, "/autopilot/locks/speed", "speed-with-pitch-yoke" );
|
||||
&set_prop( $fgfs, "/autopilot/settings/target-speed-kt", $kts );
|
||||
} else {
|
||||
&set_prop( $fgfs, "/autopilot/locks/speed", "" );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
138
scripts/perl/examples/environment.pl
Executable file
138
scripts/perl/examples/environment.pl
Executable file
@@ -0,0 +1,138 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# environment.pl - Handle environment setup
|
||||
#
|
||||
# Written by Curtis L. Olson, started January 2004
|
||||
#
|
||||
# Copyright (C) 2004 Curtis L. Olson - http://www.flightgear.org/~curt
|
||||
#
|
||||
# This code is placed in the public domain by Curtis L. Olson.
|
||||
# There is no warranty, etc. etc. etc.
|
||||
#
|
||||
# $Id$
|
||||
# ----------------------------------------------------------------------------
|
||||
|
||||
|
||||
require "telnet.pl";
|
||||
|
||||
use strict;
|
||||
|
||||
|
||||
sub set_timeofday {
|
||||
my( $fgfs ) = shift;
|
||||
my( $timeofday ) = shift;
|
||||
|
||||
&send( $fgfs, "run timeofday $timeofday" );
|
||||
}
|
||||
|
||||
|
||||
sub set_env_layer {
|
||||
my( $fgfs ) = shift;
|
||||
my( $layer_type ) = shift; # boundary or aloft
|
||||
my( $layer_num ) = shift;
|
||||
my( $wind_hdg_deg ) = shift;
|
||||
my( $wind_spd_kt ) = shift;
|
||||
my( $turb_norm ) = shift;
|
||||
my( $temp_degc ) = shift;
|
||||
my( $press_inhg ) = shift;
|
||||
my( $dew_degc ) = shift;
|
||||
my( $vis ) = shift;
|
||||
my( $elevation ) = shift;
|
||||
|
||||
my( $prop, $value );
|
||||
my( %HASH ) = ();
|
||||
|
||||
my( $prefix ) = "/environment/config/$layer_type/entry[$layer_num]";
|
||||
$HASH{ "$prefix/wind-from-heading-deg" } = $wind_hdg_deg;
|
||||
$HASH{ "$prefix/wind-speed-kt" } = $wind_spd_kt;
|
||||
$HASH{ "$prefix/turbulence/magnitude-norm" } = $turb_norm;
|
||||
$HASH{ "$prefix/temperature-degc" } = $temp_degc;
|
||||
$HASH{ "$prefix/pressure-sea-level-inhg" } = $press_inhg;
|
||||
$HASH{ "$prefix/dewpoint-degc" } = $dew_degc;
|
||||
$HASH{ "$prefix/visibility-m" } = $vis;
|
||||
$HASH{ "$prefix/elevation-ft" } = $elevation;
|
||||
|
||||
foreach $prop ( keys(%HASH) ) {
|
||||
$value = $HASH{$prop};
|
||||
# print "setting $prop = $value\n";
|
||||
&set_prop( $fgfs, $prop, $value );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub set_oat {
|
||||
my( $fgfs ) = shift;
|
||||
my( $oat ) = shift;
|
||||
|
||||
# set the outside air temperature (simply)
|
||||
&send( $fgfs, "run set-outside-air-temp-degc $oat" );
|
||||
}
|
||||
|
||||
|
||||
sub set_pressure {
|
||||
my( $fgfs ) = shift;
|
||||
my( $pressure_inhg ) = shift;
|
||||
|
||||
my( $layer_type ) = shift; # boundary or aloft
|
||||
my( $layer_num ) = shift;
|
||||
my( $wind_hdg_deg ) = shift;
|
||||
my( $wind_spd_kt ) = shift;
|
||||
my( $turb_norm ) = shift;
|
||||
my( $temp_degc ) = shift;
|
||||
my( $press_inhg ) = shift;
|
||||
my( $dew_degc ) = shift;
|
||||
my( $vis ) = shift;
|
||||
my( $elevation ) = shift;
|
||||
|
||||
my( $prop, $value );
|
||||
my( %HASH ) = ();
|
||||
|
||||
my( $i );
|
||||
|
||||
for ( $i = 0; $i < 3; ++$i ) {
|
||||
my( $prefix ) = "/environment/config/boundary/entry[$i]";
|
||||
$HASH{ "$prefix/pressure-sea-level-inhg" } = $pressure_inhg;
|
||||
}
|
||||
|
||||
for ( $i = 0; $i < 5; ++$i ) {
|
||||
my( $prefix ) = "/environment/config/aloft/entry[$i]";
|
||||
$HASH{ "$prefix/pressure-sea-level-inhg" } = $pressure_inhg;
|
||||
}
|
||||
|
||||
foreach $prop ( keys(%HASH) ) {
|
||||
$value = $HASH{$prop};
|
||||
# print "setting $prop = $value\n";
|
||||
&set_prop( $fgfs, $prop, $value );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub set_cloud_layer {
|
||||
my( $fgfs ) = shift;
|
||||
my( $layer ) = shift;
|
||||
my( $coverage ) = shift;
|
||||
my( $elevation_ft ) = shift;
|
||||
my( $thickness_ft ) = shift;
|
||||
my( $transition_ft ) = shift;
|
||||
|
||||
my( $prop, $value );
|
||||
my( %HASH ) = ();
|
||||
|
||||
$HASH{ "/environment/clouds/layer[$layer]/coverage" } = $coverage;
|
||||
$HASH{ "/environment/clouds/layer[$layer]/elevation-ft" } = $elevation_ft;
|
||||
$HASH{ "/environment/clouds/layer[$layer]/thickness-ft" } = $thickness_ft;
|
||||
$HASH{ "/environment/clouds/layer[$layer]/transition-ft" } = $transition_ft;
|
||||
|
||||
foreach $prop ( keys(%HASH) ) {
|
||||
$value = $HASH{$prop};
|
||||
# print "setting $prop = $value\n";
|
||||
&set_prop( $fgfs, $prop, $value );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub reinit_environment() {
|
||||
my( $fgfs ) = shift;
|
||||
|
||||
&send( $fgfs, "run reinit environment" );
|
||||
}
|
||||
88
scripts/perl/examples/find_elevations.pl
Executable file
88
scripts/perl/examples/find_elevations.pl
Executable file
@@ -0,0 +1,88 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# Written by Curtis L. Olson, started January 2003
|
||||
#
|
||||
# This file is in the Public Domain and comes with no warranty.
|
||||
#
|
||||
# $Id$
|
||||
# ----------------------------------------------------------------------------
|
||||
|
||||
|
||||
# This script will calculate the flightgear ground elevation for a
|
||||
# serious of lon/lat pairs, given one per line via stdin. Result it
|
||||
# written to stdout. Lon/lat must be specified in decimal degrees,
|
||||
# i.e. "-110.2324 39.872"
|
||||
#
|
||||
# This requires a copy of flightgear running with "--fdm=null" on the
|
||||
# specified "$server" host name, at the specified "$port".
|
||||
#
|
||||
# I highly recommend that you if you plan to feed a large number of
|
||||
# coordinates through this script that you presort your list by tile id #
|
||||
# That will minimize the load on the FG tile pager since you will process
|
||||
# all coordinates for a particular tile before moving on to the next.
|
||||
# Also, there is a chance the next tile will already be loaded if it is near
|
||||
# the previous (which it will tend to be if you sort by tile id.)
|
||||
|
||||
use strict;
|
||||
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
require "telnet.pl";
|
||||
|
||||
my( $server ) = "localhost";
|
||||
my( $port ) = 5401;
|
||||
my( $timeout ) = 10;
|
||||
|
||||
|
||||
# open the connection to the running copy of flightgear
|
||||
my( $fgfs );
|
||||
if ( !( $fgfs = &connect($server, $port, $timeout) ) ) {
|
||||
die "Error: can't open socket\n";
|
||||
}
|
||||
&send( $fgfs, "data" ); # switch to raw data mode
|
||||
|
||||
|
||||
# elevate ourselves only to make the view more interesting, this
|
||||
# doesn't affect the results
|
||||
set_prop( $fgfs, "/position/altitude-ft", "5000" );
|
||||
|
||||
my( $last_lon ) = -1000.0;
|
||||
my( $last_lat ) = -1000.0;
|
||||
my( $last_elev ) = -1000.0;
|
||||
|
||||
# iterate through the requested coordinates
|
||||
while ( <> ) {
|
||||
my( $lon, $lat ) = split;
|
||||
set_prop( $fgfs, "/position/longitude-deg", $lon );
|
||||
set_prop( $fgfs, "/position/latitude-deg", $lat );
|
||||
|
||||
# wait 1 second for scenery to load
|
||||
usleep(500000);
|
||||
|
||||
# then fetch ground elevation
|
||||
my( $elev ) = get_prop( $fgfs, "/position/ground-elev-m" );
|
||||
|
||||
if ( $lon != $last_lon || $lat != $last_lat ) {
|
||||
my($waitcount) = 0;
|
||||
while ( $elev == $last_elev && $waitcount < 5 ) {
|
||||
print "(WARNING: waiting an addition 1 second and requerying.)\n";
|
||||
# same answer as last time, scenery is probably still loading,
|
||||
# let's wait 1 more seconds and hope we get it right the next
|
||||
# time, we bail after 5 seconds.
|
||||
usleep(1000000);
|
||||
$elev = get_prop( $fgfs, "/position/ground-elev-m" );
|
||||
$waitcount++;
|
||||
}
|
||||
}
|
||||
|
||||
print "$lon $lat $elev\n";
|
||||
|
||||
$last_elev = $elev;
|
||||
$last_lon = $lon;
|
||||
$last_lat = $lat;
|
||||
}
|
||||
|
||||
|
||||
# shutdown our connection (this leaves FG running)
|
||||
&send( $fgfs, "quit");
|
||||
close $fgfs;
|
||||
91
scripts/perl/examples/flyplan.pl
Executable file
91
scripts/perl/examples/flyplan.pl
Executable file
@@ -0,0 +1,91 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# Written by Curtis L. Olson, started January 2003
|
||||
#
|
||||
# This file is in the Public Domain and comes with no warranty.
|
||||
#
|
||||
# $Id$
|
||||
# ----------------------------------------------------------------------------
|
||||
|
||||
|
||||
use strict;
|
||||
|
||||
require "telnet.pl";
|
||||
|
||||
my( $server ) = "localhost";
|
||||
my( $port ) = 5401;
|
||||
my( $timeout ) = 10;
|
||||
|
||||
my( %Route );
|
||||
$Route{0} = "OAK:116.80:020";
|
||||
$Route{1} = "OAK:116.80:019:27";
|
||||
$Route{2} = "SAC:115.20:020";
|
||||
$Route{3} = "SAC:115.20:080:43";
|
||||
$Route{4} = "ECA:116.0:209";
|
||||
|
||||
my( $i );
|
||||
|
||||
foreach $i ( keys(%Route) ) {
|
||||
&fly_to( $Route{$i} );
|
||||
}
|
||||
|
||||
|
||||
sub fly_to() {
|
||||
my( $waypoint ) = shift;
|
||||
|
||||
# decode waypoint
|
||||
my( $id, $freq, $radial, $dist ) = split( /:/, $waypoint );
|
||||
|
||||
print "Next way point is $id - $freq\n";
|
||||
print " Target radial is $radial\n";
|
||||
if ( $dist ne "" ) {
|
||||
print " Flying outbound for $dist nm\n";
|
||||
} else {
|
||||
print " Flying inbound to station\n";
|
||||
}
|
||||
|
||||
# tune radio and set autopilot
|
||||
my( $fgfs );
|
||||
if ( !( $fgfs = &connect($server, $port, $timeout) ) ) {
|
||||
print "Error: can't open socket\n";
|
||||
return;
|
||||
}
|
||||
&send( $fgfs, "data" ); # switch to raw data mode
|
||||
set_prop( $fgfs, "/radios/nav[0]/frequencies/selected-mhz", $freq );
|
||||
set_prop( $fgfs, "/radios/nav[0]/radials/selected-deg", $radial );
|
||||
set_prop( $fgfs, "/radios/dme/switch-position", "1" );
|
||||
set_prop( $fgfs, "/autopilot/locks/nav", "true" );
|
||||
|
||||
# monitor progress until goal is achieved
|
||||
my( $done ) = 0;
|
||||
my( $last_range ) = 9999.0;
|
||||
while ( !$done ) {
|
||||
my( $inrange ) = get_prop( $fgfs, "/radios/nav[0]/in-range" );
|
||||
if ( $inrange eq "false" ) {
|
||||
print "Warning, VOR not in range, we are lost!\n";
|
||||
}
|
||||
my( $cur_range ) = get_prop( $fgfs, "/radios/dme/distance-nm" );
|
||||
print " range = $cur_range\n";
|
||||
if ( $dist ne "" ) {
|
||||
# a target dist is specified so assume we are flying outbound
|
||||
if ( $cur_range > $dist ) {
|
||||
$done = 1;
|
||||
}
|
||||
} else {
|
||||
# no target dist is specified, assume we are flying
|
||||
# inbound to the station
|
||||
if ( $cur_range < 0.25 && $cur_range > 0.0 ) {
|
||||
$done = 1;
|
||||
} elsif ( $last_range < $cur_range ) {
|
||||
$done = 1;
|
||||
}
|
||||
}
|
||||
$last_range = $cur_range;
|
||||
|
||||
# loop once per second
|
||||
sleep(1);
|
||||
}
|
||||
|
||||
&send( $fgfs, "quit");
|
||||
close $fgfs;
|
||||
}
|
||||
209
scripts/perl/examples/logging.pl
Executable file
209
scripts/perl/examples/logging.pl
Executable file
@@ -0,0 +1,209 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# logging.pl - Handle logging
|
||||
#
|
||||
# Written by Curtis L. Olson, started February 2004
|
||||
#
|
||||
# Copyright (C) 2004 Curtis L. Olson - http://www.flightgear.org/~curt
|
||||
#
|
||||
# This code is placed in the public domain by Curtis L. Olson.
|
||||
# There is no warranty, etc. etc. etc.
|
||||
#
|
||||
# $Id$
|
||||
# ----------------------------------------------------------------------------
|
||||
|
||||
|
||||
use strict;
|
||||
|
||||
require "telnet.pl";
|
||||
|
||||
my( $lognum ) = 1;
|
||||
|
||||
my( @FIELDS, @FIELDS_E );
|
||||
my( $tmp_dir ) = "/tmp";
|
||||
|
||||
my( $field_index ) = 0;
|
||||
|
||||
|
||||
sub clear_logging {
|
||||
my( $fgfs ) = shift;
|
||||
|
||||
my( $done ) = 0;
|
||||
my( $i ) = 0;
|
||||
my( $prop );
|
||||
while ( !$done ) {
|
||||
$prop = &get_prop( $fgfs, "/logging/log[$lognum]/entry[$i]/property" );
|
||||
if ( $prop ne "" ) {
|
||||
&set_prop( $fgfs,
|
||||
"/logging/log[$lognum]/entry[$i]/enabled",
|
||||
"false" );
|
||||
} else {
|
||||
$done = 1;
|
||||
}
|
||||
$i++;
|
||||
}
|
||||
|
||||
$field_index = 0;
|
||||
}
|
||||
|
||||
|
||||
sub add_field {
|
||||
my( $fgfs ) = shift;
|
||||
my( $title ) = shift;
|
||||
my( $prop ) = shift;
|
||||
|
||||
# spaces seem to not work well.
|
||||
$title =~ s/ /\_/g;
|
||||
|
||||
# print "$title - $prop\n";
|
||||
&set_prop( $fgfs,
|
||||
"/logging/log[$lognum]/entry[$field_index]/title", $title );
|
||||
&set_prop( $fgfs,
|
||||
"/logging/log[$lognum]/entry[$field_index]/property", $prop );
|
||||
&set_prop( $fgfs,
|
||||
"/logging/log[$lognum]/entry[$field_index]/enabled", "true" );
|
||||
|
||||
$field_index++;
|
||||
}
|
||||
|
||||
|
||||
sub add_default_fields() {
|
||||
my( $fgfs ) = shift;
|
||||
|
||||
push( @FIELDS, ( "Longitude (deg)", "/position/longitude-deg" ) );
|
||||
push( @FIELDS, ( "Latitude (deg)", "/position/latitude-deg" ) );
|
||||
push( @FIELDS, ( "Altitude (ft MSL)", "/position/altitude-ft" ) );
|
||||
push( @FIELDS, ( "Altitude (ft AGL)", "/position/altitude-agl-ft" ) );
|
||||
push( @FIELDS, ( "Roll (deg)", "/orientation/roll-deg" ) );
|
||||
push( @FIELDS, ( "Pitch (deg)", "/orientation/pitch-deg" ) );
|
||||
push( @FIELDS, ( "Heading (deg)", "/orientation/heading-deg" ) );
|
||||
push( @FIELDS, ( "Calibrated Air Speed (kt)", "/velocities/airspeed-kt" ) );
|
||||
push( @FIELDS, ( "Vertical Speed (fps)",
|
||||
"/velocities/vertical-speed-fps" ) );
|
||||
push( @FIELDS, ( "Roll Rate (degps)", "/orientation/roll-rate-degps" ) );
|
||||
push( @FIELDS, ( "Pitch Rate (degps)", "/orientation/pitch-rate-degps" ) );
|
||||
push( @FIELDS, ( "Yaw Rate (degps)", "/orientation/yaw-rate-degps" ) );
|
||||
push( @FIELDS, ( "Alpha (deg)", "/orientation/alpha-deg" ) );
|
||||
push( @FIELDS, ( "Beta (deg)", "/orientation/side-slip-deg" ) );
|
||||
push( @FIELDS, ( "Prop (RPM)", "/engines/engine[0]/rpm" ) );
|
||||
push( @FIELDS, ( "Left Aileron Pos (norm)",
|
||||
"/surface-positions/left-aileron-pos-norm" ) );
|
||||
push( @FIELDS, ( "Right Aileron Pos (norm)",
|
||||
"/surface-positions/right-aileron-pos-norm" ) );
|
||||
push( @FIELDS, ( "Elevator Pos (norm)",
|
||||
"/surface-positions/elevator-pos-norm" ) );
|
||||
push( @FIELDS, ( "Elevator Trim Tab Pos (norm)",
|
||||
"/surface-positions/elevator-trim-tab-pos-norm" ) );
|
||||
push( @FIELDS, ( "Rudder Pos (norm)",
|
||||
"/surface-positions/rudder-pos-norm" ) );
|
||||
push( @FIELDS, ( "Flap Pos (norm)",
|
||||
"/surface-positions/flap-pos-norm" ) );
|
||||
push( @FIELDS, ( "Nose Wheel Pos (norm)",
|
||||
"/surface-positions/nose-wheel-pos-norm" ) );
|
||||
push( @FIELDS, ( "Wheel Pos (norm)", "/controls/flight/aileron" ) );
|
||||
push( @FIELDS, ( "Column Pos (norm)", "/controls/flight/elevator" ) );
|
||||
push( @FIELDS, ( "Trim Wheel Pos (norm)",
|
||||
"/controls/flight/elevator-trim" ) );
|
||||
push( @FIELDS, ( "Pedal Pos (norm)", "/controls/flight/rudder" ) );
|
||||
push( @FIELDS, ( "Throttle Pos (norm)",
|
||||
"/controls/engines/engine[0]/throttle" ) );
|
||||
|
||||
# initially enable all fields
|
||||
for ( my($i) = 0; $i <= ($#FIELDS / 2); ++$i ) {
|
||||
&add_field( $fgfs, $FIELDS[2*$i], $FIELDS[2*$i+1] );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub start_logging {
|
||||
my( $fgfs ) = shift;
|
||||
my( $log_file ) = shift;
|
||||
|
||||
&set_prop( $fgfs, "/logging/log[$lognum]/filename", $log_file );
|
||||
&set_prop( $fgfs, "/logging/log[$lognum]/interval-ms", "100" );
|
||||
&set_prop( $fgfs, "/logging/log[$lognum]/enabled", "true" );
|
||||
&send( $fgfs, "run data-logging-commit" );
|
||||
}
|
||||
|
||||
|
||||
sub stop_logging {
|
||||
my( $fgfs ) = shift;
|
||||
|
||||
&set_prop( $fgfs, "/logging/log[$lognum]/enabled", "false" );
|
||||
&send( $fgfs, "run data-logging-commit" );
|
||||
}
|
||||
|
||||
|
||||
sub quick_plot_vs_time {
|
||||
my( $data_file ) = shift;
|
||||
my( $plot_file ) = shift;
|
||||
my( $title ) = shift;
|
||||
my( $column ) = shift;
|
||||
|
||||
print "quick plot -> $plot_file\n";
|
||||
|
||||
my( $tmpcmd ) = "$tmp_dir/plot_cmd_tmp.$$";
|
||||
my( $tmpdata ) = "$tmp_dir/plot_data_tmp.$$";
|
||||
my( $png_image ) = "$plot_file.png";
|
||||
|
||||
# strip the leading header off the file so gnuplot doesn't squawk
|
||||
system( "tail -n +2 $data_file | sed -e \"s/,/ /g\" > $tmpdata" );
|
||||
|
||||
# create the gnuplot command file
|
||||
open( CMD, ">$tmpcmd" );
|
||||
print CMD "set terminal png\n";
|
||||
print "png_image = $png_image\n";
|
||||
print CMD "set output \"$png_image\"\n";
|
||||
print CMD "set xlabel \"Time (sec)\"\n";
|
||||
print CMD "set ylabel \"$title\"\n";
|
||||
print CMD "plot \"$tmpdata\" using 1:$column title \"$title\" with lines\n";
|
||||
print CMD "quit\n";
|
||||
close( CMD );
|
||||
|
||||
# plot the graph
|
||||
system( "gnuplot $tmpcmd" );
|
||||
|
||||
# clean up all our droppings
|
||||
unlink( $tmpcmd );
|
||||
unlink( $tmpdata );
|
||||
}
|
||||
|
||||
|
||||
sub quick_plot {
|
||||
my( $data_file ) = shift;
|
||||
my( $plot_file ) = shift;
|
||||
my( $xtitle ) = shift;
|
||||
my( $ytitle ) = shift;
|
||||
my( $xcolumn ) = shift;
|
||||
my( $ycolumn ) = shift;
|
||||
|
||||
print "quick plot -> $plot_file\n";
|
||||
|
||||
my( $tmpcmd ) = "$tmp_dir/plot_cmd_tmp.$$";
|
||||
my( $tmpdata ) = "$tmp_dir/plot_data_tmp.$$";
|
||||
my( $png_image ) = "$plot_file.png";
|
||||
|
||||
# strip the leading header off the file so gnuplot doesn't squawk
|
||||
system( "tail -n +2 $data_file | sed -e \"s/,/ /g\" > $tmpdata" );
|
||||
|
||||
# create the gnuplot command file
|
||||
open( CMD, ">$tmpcmd" );
|
||||
print CMD "set terminal png\n";
|
||||
print "png_image = $png_image\n";
|
||||
print CMD "set output \"$png_image\"\n";
|
||||
print CMD "set xlabel \"$xtitle\"\n";
|
||||
print CMD "set ylabel \"$ytitle\"\n";
|
||||
print CMD "plot \"$tmpdata\" using $xcolumn:$ycolumn title \"$xtitle vs. $ytitle\" with lines\n";
|
||||
print CMD "quit\n";
|
||||
close( CMD );
|
||||
|
||||
# plot the graph
|
||||
system( "gnuplot $tmpcmd" );
|
||||
|
||||
# clean up all our droppings
|
||||
unlink( $tmpcmd );
|
||||
unlink( $tmpdata );
|
||||
}
|
||||
|
||||
|
||||
return 1; # make perl happy
|
||||
107
scripts/perl/examples/position.pl
Executable file
107
scripts/perl/examples/position.pl
Executable file
@@ -0,0 +1,107 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# position.pl - Handle repositioning aircraft (in air/on ground)
|
||||
#
|
||||
# Written by Curtis L. Olson, started January 2004
|
||||
#
|
||||
# Copyright (C) 2004 Curtis L. Olson - http://www.flightgear.org/~curt
|
||||
#
|
||||
# This code is placed in the public domain by Curtis L. Olson.
|
||||
# There is no warranty, etc. etc. etc.
|
||||
#
|
||||
# $Id$
|
||||
# ----------------------------------------------------------------------------
|
||||
|
||||
|
||||
require "telnet.pl";
|
||||
|
||||
use strict;
|
||||
|
||||
my( $airport_id ) = "KSNA";
|
||||
my( $rwy_no ) = "19R";
|
||||
my( $reset_sec ) = 300;
|
||||
|
||||
my( $server ) = "localhost";
|
||||
my( $port ) = 5401;
|
||||
my( $timeout ) = 5;
|
||||
|
||||
|
||||
sub reset_in_air {
|
||||
my( $fgfs ) = shift;
|
||||
my( $aptid ) = shift;
|
||||
my( $rwy ) = shift;
|
||||
my( $offset_dist ) = shift;
|
||||
my( $glideslope_deg ) = shift;
|
||||
my( $altitude_ft ) = shift;
|
||||
my( $airspeed_kt ) = shift;
|
||||
|
||||
my( $prop, $value );
|
||||
my( %HASH ) = ();
|
||||
|
||||
$HASH{ "/sim/presets/airport-id" } = $aptid;
|
||||
$HASH{ "/sim/presets/runway" } = $rwy;
|
||||
$HASH{ "/sim/presets/offset-distance" } = $offset_dist;
|
||||
if ( $glideslope_deg > 0 ) {
|
||||
$HASH{ "/sim/presets/glideslope-deg" } = $glideslope_deg;
|
||||
$HASH{ "/sim/presets/altitude-ft" } = "";
|
||||
} else {
|
||||
$HASH{ "/sim/presets/glideslope-deg" } = "";
|
||||
$HASH{ "/sim/presets/altitude-ft" } = $altitude_ft;
|
||||
}
|
||||
|
||||
$HASH{ "/sim/presets/airspeed-kt" } = $airspeed_kt;
|
||||
$HASH{ "/sim/presets/vor-id" } = "";
|
||||
$HASH{ "/sim/presets/vor-freq" } = "";
|
||||
$HASH{ "/sim/presets/ndb-id" } = "";
|
||||
$HASH{ "/sim/presets/ndb-freq" } = "";
|
||||
$HASH{ "/sim/presets/fix" } = "";
|
||||
$HASH{ "/sim/presets/longitude-deg" } = "-9999.0";
|
||||
$HASH{ "/sim/presets/latitude-deg" } = "-9999.0";
|
||||
$HASH{ "/sim/presets/offset-azimuth" } = "";
|
||||
$HASH{ "/sim/presets/heading-deg" } = "-9999.0";
|
||||
|
||||
foreach $prop ( keys(%HASH) ) {
|
||||
$value = $HASH{$prop};
|
||||
print "setting $prop = $value\n";
|
||||
&set_prop( $fgfs, $prop, $value );
|
||||
}
|
||||
|
||||
&send( $fgfs, "run presets-commit" );
|
||||
}
|
||||
|
||||
|
||||
sub reset_on_ground {
|
||||
my( $fgfs ) = shift;
|
||||
my( $aptid ) = shift;
|
||||
my( $rwy ) = shift;
|
||||
|
||||
my( $prop, $value );
|
||||
my( %HASH ) = ();
|
||||
|
||||
$HASH{ "/sim/presets/airport-id" } = $aptid;
|
||||
$HASH{ "/sim/presets/runway" } = $rwy;
|
||||
$HASH{ "/sim/presets/offset-distance" } = "";
|
||||
$HASH{ "/sim/presets/glideslope-deg" } = "";
|
||||
$HASH{ "/sim/presets/altitude-ft" } = "";
|
||||
$HASH{ "/sim/presets/airspeed-kt" } = "";
|
||||
$HASH{ "/sim/presets/vor-id" } = "";
|
||||
$HASH{ "/sim/presets/vor-freq" } = "";
|
||||
$HASH{ "/sim/presets/ndb-id" } = "";
|
||||
$HASH{ "/sim/presets/ndb-freq" } = "";
|
||||
$HASH{ "/sim/presets/fix" } = "";
|
||||
$HASH{ "/sim/presets/longitude-deg" } = "-9999.0";
|
||||
$HASH{ "/sim/presets/latitude-deg" } = "-9999.0";
|
||||
$HASH{ "/sim/presets/offset-azimuth" } = "";
|
||||
$HASH{ "/sim/presets/heading-deg" } = "-9999.0";
|
||||
|
||||
foreach $prop ( keys(%HASH) ) {
|
||||
$value = $HASH{$prop};
|
||||
print "setting $prop = $value\n";
|
||||
&set_prop( $fgfs, $prop, $value );
|
||||
}
|
||||
|
||||
&send( $fgfs, "run presets-commit" );
|
||||
}
|
||||
|
||||
|
||||
|
||||
79
scripts/perl/examples/reset.pl
Executable file
79
scripts/perl/examples/reset.pl
Executable file
@@ -0,0 +1,79 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
require "telnet.pl";
|
||||
|
||||
use strict;
|
||||
|
||||
my( $airport_id ) = "KSNA";
|
||||
my( $rwy_no ) = "19R";
|
||||
my( $reset_sec ) = 300;
|
||||
|
||||
my( $server ) = "localhost";
|
||||
my( $port ) = 5401;
|
||||
my( $timeout ) = 5;
|
||||
|
||||
while ( 1 ) {
|
||||
print "Reseting to $airport_id $rwy_no\n";
|
||||
reset_position( $airport_id, $rwy_no );
|
||||
sleep( $reset_sec );
|
||||
}
|
||||
|
||||
|
||||
sub reset_position {
|
||||
my( $aptid ) = shift;
|
||||
my( $rwy ) = shift;
|
||||
|
||||
my( $prop, $value );
|
||||
my( %HASH ) = ();
|
||||
|
||||
$HASH{ "/sim/presets/airport-id" } = $aptid;
|
||||
$HASH{ "/sim/presets/runway" } = $rwy;
|
||||
$HASH{ "/sim/presets/vor-id" } = "";
|
||||
$HASH{ "/sim/presets/vor-freq" } = "";
|
||||
$HASH{ "/sim/presets/ndb-id" } = "";
|
||||
$HASH{ "/sim/presets/ndb-freq" } = "";
|
||||
$HASH{ "/sim/presets/fix" } = "";
|
||||
$HASH{ "/sim/presets/longitude-deg" } = "-9999.0";
|
||||
$HASH{ "/sim/presets/latitude-deg" } = "-9999.0";
|
||||
$HASH{ "/sim/presets/offset-distance" } = "";
|
||||
$HASH{ "/sim/presets/offset-azimuth" } = "";
|
||||
$HASH{ "/sim/presets/heading-deg" } = "-9999.0";
|
||||
$HASH{ "/sim/presets/altitude-ft" } = "";
|
||||
$HASH{ "/sim/presets/glideslope-deg" } = "";
|
||||
$HASH{ "/sim/presets/airspeed-kt" } = "";
|
||||
|
||||
my( $fgfs );
|
||||
|
||||
if ( !( $fgfs = &connect($server, $port, $timeout) ) ) {
|
||||
print "Error: can't open socket\n";
|
||||
return;
|
||||
}
|
||||
|
||||
&send( $fgfs, "data" ); # switch to raw data mode
|
||||
|
||||
foreach $prop ( keys(%HASH) ) {
|
||||
$value = $HASH{$prop};
|
||||
# if ( $value eq "" ) {
|
||||
# $value = 0;
|
||||
# }
|
||||
print "setting $prop = $value\n";
|
||||
&set_prop( $fgfs, $prop, $value );
|
||||
}
|
||||
|
||||
&send( $fgfs, "run presets-commit" );
|
||||
|
||||
# set time of day to noon
|
||||
&send( $fgfs, "run timeofday noon" );
|
||||
|
||||
# start the engine
|
||||
&set_prop( $fgfs, "/controls/engines/engine[0]/magnetos", "3" );
|
||||
&set_prop( $fgfs, "/controls/engines/engine[0]/starter", "true" );
|
||||
sleep(2);
|
||||
&set_prop( $fgfs, "/controls/engines/engine[0]/starter", "false" );
|
||||
|
||||
&send( $fgfs, "quit" );
|
||||
close $fgfs;
|
||||
}
|
||||
|
||||
|
||||
|
||||
84
scripts/perl/examples/telnet.pl
Normal file
84
scripts/perl/examples/telnet.pl
Normal file
@@ -0,0 +1,84 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# Written by Curtis L. Olson, started December 2002
|
||||
# Some code portions courtesy of Melchior FRANZ
|
||||
#
|
||||
# This file is in the Public Domain and comes with no warranty.
|
||||
#
|
||||
# $Id$
|
||||
# ----------------------------------------------------------------------------
|
||||
|
||||
|
||||
use IO::Socket;
|
||||
|
||||
use strict;
|
||||
|
||||
|
||||
sub my_not() {
|
||||
my( $val ) = shift;
|
||||
|
||||
if ( $val eq "true" ) {
|
||||
return 0;
|
||||
} elsif ( $val eq "false" ) {
|
||||
return 1;
|
||||
} elsif ( $val eq "" ) {
|
||||
return 1;
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub get_prop() {
|
||||
my( $handle ) = shift;
|
||||
|
||||
&send( $handle, "get " . shift );
|
||||
eof $handle and die "\nconnection closed by host";
|
||||
$_ = <$handle>;
|
||||
s/\015?\012$//;
|
||||
/^-ERR (.*)/ and die "\nfgfs error: $1\n";
|
||||
|
||||
return $_;
|
||||
}
|
||||
|
||||
|
||||
sub set_prop() {
|
||||
my( $handle ) = shift;
|
||||
my( $prop ) = shift;
|
||||
my( $value ) = shift;
|
||||
|
||||
&send( $handle, "set $prop $value");
|
||||
|
||||
# eof $handle and die "\nconnection closed by host";
|
||||
}
|
||||
|
||||
|
||||
sub send() {
|
||||
my( $handle ) = shift;
|
||||
|
||||
print $handle shift, "\015\012";
|
||||
}
|
||||
|
||||
|
||||
sub connect() {
|
||||
my( $host ) = shift;
|
||||
my( $port ) = shift;
|
||||
my( $timeout ) = (shift || 120);
|
||||
my( $socket );
|
||||
STDOUT->autoflush(1);
|
||||
while ($timeout--) {
|
||||
if ($socket = IO::Socket::INET->new( Proto => 'tcp',
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port) )
|
||||
{
|
||||
$socket->autoflush(1);
|
||||
return $socket;
|
||||
}
|
||||
print "Attempting to connect to $host ... " . $timeout . "\n";
|
||||
sleep(1);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
return 1; # make perl happy
|
||||
159
scripts/perl/scenery/calc-tile.pl
Normal file
159
scripts/perl/scenery/calc-tile.pl
Normal file
@@ -0,0 +1,159 @@
|
||||
#!/usr/bin/perl -w
|
||||
########################################################################
|
||||
# calc-tile.pl
|
||||
#
|
||||
# Synopsis: Calculate a FlightGear tile base on longitude and latitude.
|
||||
# Usage: perl calc-tile.pl <lon> <lat>
|
||||
########################################################################
|
||||
|
||||
use strict;
|
||||
use POSIX;
|
||||
|
||||
|
||||
|
||||
########################################################################
|
||||
# Constants.
|
||||
########################################################################
|
||||
|
||||
my $EPSILON = 0.0000001;
|
||||
my $DIRSEP = '/';
|
||||
|
||||
|
||||
|
||||
########################################################################
|
||||
# Functions.
|
||||
########################################################################
|
||||
|
||||
#
|
||||
# Calculate the number of columns of tiles in a degree of longitude.
|
||||
#
|
||||
sub bucket_span {
|
||||
my ($lat) = (@_);
|
||||
if ($lat>= 89.0 ) {
|
||||
return 360.0;
|
||||
} elsif ($lat>= 88.0 ) {
|
||||
return 8.0;
|
||||
} elsif ($lat>= 86.0 ) {
|
||||
return 4.0;
|
||||
} elsif ($lat>= 83.0 ) {
|
||||
return 2.0;
|
||||
} elsif ($lat>= 76.0 ) {
|
||||
return 1.0;
|
||||
} elsif ($lat>= 62.0 ) {
|
||||
return 0.5;
|
||||
} elsif ($lat>= 22.0 ) {
|
||||
return 0.25;
|
||||
} elsif ($lat>= -22.0 ) {
|
||||
return 0.125;
|
||||
} elsif ($lat>= -62.0 ) {
|
||||
return 0.25;
|
||||
} elsif ($lat>= -76.0 ) {
|
||||
return 0.5;
|
||||
} elsif ($lat>= -83.0 ) {
|
||||
return 1.0;
|
||||
} elsif ($lat>= -86.0 ) {
|
||||
return 2.0;
|
||||
} elsif ($lat>= -88.0 ) {
|
||||
return 4.0;
|
||||
} elsif ($lat>= -89.0 ) {
|
||||
return 8.0;
|
||||
} else {
|
||||
return 360.0;
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# Format longitude as e/w.
|
||||
#
|
||||
sub format_lon {
|
||||
my ($lon) = (@_);
|
||||
if ($lon < 0) {
|
||||
return sprintf("w%03d", int(0-$lon));
|
||||
} else {
|
||||
return sprintf("e%03d", int($lon));
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# Format latitude as n/s.
|
||||
#
|
||||
sub format_lat {
|
||||
my ($lat) = (@_);
|
||||
if ($lat < 0) {
|
||||
return sprintf("s%02d", int(0-$lat));
|
||||
} else {
|
||||
return sprintf("n%02d", int($lat));
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# Generate the directory name for a location.
|
||||
#
|
||||
sub directory_name {
|
||||
my ($lon, $lat) = (@_);
|
||||
my $lon_floor = POSIX::floor($lon);
|
||||
my $lat_floor = POSIX::floor($lat);
|
||||
my $lon_chunk = POSIX::floor($lon/10.0) * 10;
|
||||
my $lat_chunk = POSIX::floor($lat/10.0) * 10;
|
||||
return format_lon($lon_chunk) . format_lat($lat_chunk) . $DIRSEP
|
||||
. format_lon($lon_floor) . format_lat($lat_floor);
|
||||
}
|
||||
|
||||
#
|
||||
# Generate the tile index for a location.
|
||||
#
|
||||
sub tile_index {
|
||||
my ($lon, $lat) = (@_);
|
||||
my $lon_floor = POSIX::floor($lon);
|
||||
my $lat_floor = POSIX::floor($lat);
|
||||
my $span = bucket_span($lat);
|
||||
|
||||
my $x;
|
||||
if ($span < $EPSILON) {
|
||||
$lon = 0;
|
||||
$x = 0;
|
||||
} elsif ($span <= 1.0) {
|
||||
$x = int(($lon - $lon_floor) / $span);
|
||||
} else {
|
||||
if ($lon >= 0) {
|
||||
$lon = int(int($lon/$span) * $span);
|
||||
} else {
|
||||
$lon = int(int(($lon+1)/$span) * $span - $span);
|
||||
if ($lon < -180) {
|
||||
$lon = -180;
|
||||
}
|
||||
}
|
||||
$x = 0;
|
||||
}
|
||||
|
||||
my $y;
|
||||
$y = int(($lat - $lat_floor) * 8);
|
||||
|
||||
|
||||
my $index = 0;
|
||||
$index += ($lon_floor + 180) << 14;
|
||||
$index += ($lat_floor + 90) << 6;
|
||||
$index += $y << 3;
|
||||
$index += $x;
|
||||
|
||||
return $index;
|
||||
}
|
||||
|
||||
|
||||
|
||||
########################################################################
|
||||
# Main program.
|
||||
########################################################################
|
||||
|
||||
my ($lon, $lat) = (@ARGV);
|
||||
|
||||
my $dir = directory_name($lon, $lat);
|
||||
my $index = tile_index($lon, $lat);
|
||||
my $path = "$dir$DIRSEP$index.stg";
|
||||
|
||||
print "Longitude: $lon\n";
|
||||
print "Latitude: $lat\n";
|
||||
print "Tile: $index\n";
|
||||
print "Path: \"$path\"\n";
|
||||
|
||||
1;
|
||||
117
scripts/perl/traffic/conf2xml.pl
Executable file
117
scripts/perl/traffic/conf2xml.pl
Executable file
@@ -0,0 +1,117 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
sub parseTime {
|
||||
# print "Parsing time @_\n";
|
||||
#die;
|
||||
my $timeStr = $_[0];
|
||||
@timeArray = split(":", $timeStr);
|
||||
# print STDERR "TimeArray: @timeArray\n";
|
||||
return ($timeArray[0] + $timeArray[1]/60.0);
|
||||
}
|
||||
|
||||
sub writeFlight {
|
||||
print XMLFILE " <flight>\n";
|
||||
print XMLFILE " <callsign>$_[0]</callsign>\n";
|
||||
print XMLFILE " <required-aircraft>$_[1]</required-aircraft>\n";
|
||||
print XMLFILE " <fltrules>$_[2]</fltrules>\n";
|
||||
print XMLFILE " <departure>\n";
|
||||
print XMLFILE " <port>$_[3]</port>\n";
|
||||
if ($_[4] =~ /[0-6]/) { print XMLFILE " <time>$_[4]/$_[5]:00</time>\n" }
|
||||
else { print XMLFILE " <time>$_[5]:00</time>\n" };
|
||||
print XMLFILE " </departure>\n";
|
||||
print XMLFILE " <cruise-alt>$_[6]</cruise-alt>\n";
|
||||
print XMLFILE " <arrival>\n";
|
||||
print XMLFILE " <port>$_[7]</port>\n";
|
||||
if ($_[8] =~ /[0-6]/) { print XMLFILE " <time>$_[8]/$_[9]:00</time>\n" }
|
||||
else { print XMLFILE " <time>$_[9]:00</time>\n" };
|
||||
print XMLFILE " </arrival>\n";
|
||||
if (($_[4] =~ /[0-6]/) && ($_[8] =~ /[0-6]/)) { print XMLFILE " <repeat>WEEK</repeat>\n" }
|
||||
else { print XMLFILE " <repeat>24Hr</repeat>\n" };
|
||||
print XMLFILE " </flight>\n";
|
||||
return;
|
||||
}
|
||||
|
||||
@inputfiles = glob("???.conf");
|
||||
while ($infile = shift(@inputfiles)) {
|
||||
open (CONF, $infile) or die "Unable to open input configuration file";
|
||||
($outname = $infile) =~ s/conf/xml/;
|
||||
print "Opening $outname\n";
|
||||
open XMLFILE, ">$outname";
|
||||
while ($buf = readline(CONF)) {
|
||||
push @DataList, $buf;
|
||||
}
|
||||
close (CONF);
|
||||
print XMLFILE "<?xml version=\"1.0\"?>\n";
|
||||
print XMLFILE "<trafficlist>\n";
|
||||
while ($dataline = shift(@DataList)) {
|
||||
# print STDERR "Dataline: $dataline\n";
|
||||
@token = split(" ", $dataline);
|
||||
if (scalar(@token) > 0) {
|
||||
# print STDERR "Token: @token\n";
|
||||
if ($token[0] eq "AC")
|
||||
{
|
||||
print XMLFILE " <aircraft>\n";
|
||||
print XMLFILE " <model>$token[12]</model>\n";
|
||||
print XMLFILE " <livery>$token[6]</livery>\n";
|
||||
print XMLFILE " <airline>$token[5]</airline>\n";
|
||||
print XMLFILE " <home-port>$token[1]</home-port>\n";
|
||||
print XMLFILE " <required-aircraft>$token[3]$token[5]</required-aircraft>\n";
|
||||
print XMLFILE " <actype>$token[4]</actype>\n";
|
||||
print XMLFILE " <offset>$token[7]</offset>\n";
|
||||
print XMLFILE " <radius>$token[8]</radius>\n";
|
||||
print XMLFILE " <flighttype>$token[9]</flighttype>\n";
|
||||
print XMLFILE " <performance-class>$token[10]</performance-class>\n";
|
||||
print XMLFILE " <registration>$token[2]</registration>\n";
|
||||
print XMLFILE " <heavy>$token[11]</heavy>\n";
|
||||
print XMLFILE " </aircraft>\n";
|
||||
}
|
||||
if ($token[0] eq "FLIGHT") {
|
||||
$weekdays = $token[3];
|
||||
if (!(($weekdays =~ /^(0|\.)?(1|\.)?(2|\.)?(3|\.)?(4|\.)?(5|\.)?(6|\.)?$/) || ($weekdays eq "DAILY"))) {
|
||||
die "Syntax Error! Check days $weekdays for flight no. $token[1]!\n";
|
||||
}
|
||||
if ($token[4] !~ /^(([0-1]?[0-9])|([2][0-3])):([0-5]?[0-9])$/) {
|
||||
die "Syntax Error! Check departure time $token[4] for flight no. $token[1]!\n"
|
||||
}
|
||||
if ($token[6] !~ /^(([0-1]?[0-9])|([2][0-3])):([0-5]?[0-9])$/) {
|
||||
die "Syntax Error! Check arrival time $token[6] for flight no. $token[1]!\n"
|
||||
}
|
||||
# print STDERR "Weekdays: $weekdays\n";
|
||||
if ($weekdays =~ /^(0|\.)?(1|\.)?(2|\.)?(3|\.)?(4|\.)?(5|\.)?(6|\.)?$/) {
|
||||
# print STDERR "Weekly for flight no. $token[1]\n";
|
||||
# print STDERR "Day: $_\n";
|
||||
@day = split(//, $weekdays);
|
||||
foreach (@day) {
|
||||
if ($_ eq "\.") {
|
||||
next;
|
||||
} else {
|
||||
$depTime = parseTime($token[4]);
|
||||
# print STDERR "depTime: $depTime\n";
|
||||
$arrTime = parseTime($token[6]);
|
||||
# print STDERR "arrTime: $arrTime\n";
|
||||
$depDay = $_ + 1;
|
||||
if ($depDay > 6) { $depDay = 0 };
|
||||
$arrDay = $depDay;
|
||||
if ($depTime > $arrTime) { $arrDay++ };
|
||||
if ($arrDay > 6) { $arrDay = 0 };
|
||||
# print STDERR "depDay: $depDay, arrDay: $arrDay\n";
|
||||
writeFlight ($token[1], $token[9], $token[2], $token[5], $depDay, $token[4], $token[8], $token[7], $arrDay, $token[6]);
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif ($weekdays eq "DAILY") {
|
||||
# print STDERR "Daily flights for flight no. $token[1]\n";
|
||||
$depTime = parseTime($token[4]);
|
||||
$arrTime = parseTime($token[6]);
|
||||
writeFlight ($token[1], $token[9], $token[2], $token[5], 7, $token[4], $token[8], $token[7], 7, $token[6]);
|
||||
}
|
||||
else {
|
||||
die "System Error! Can't find days to place a flight!\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
print XMLFILE "</trafficlist>\n";
|
||||
close XMLFILE;
|
||||
# print "Closing $outname\n";
|
||||
}
|
||||
99
scripts/perl/traffic/xml2conf.pl
Executable file
99
scripts/perl/traffic/xml2conf.pl
Executable file
@@ -0,0 +1,99 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
#use strict;
|
||||
#use warnings;
|
||||
|
||||
# DEBUG
|
||||
# use Data::Dumper;
|
||||
# print Dumper($data) . "\n";
|
||||
# END
|
||||
|
||||
if (scalar (@ARGV) == 1) {
|
||||
@files = glob("$ARGV[0]");
|
||||
print "Processing : ", @files, "\n";
|
||||
} else {
|
||||
die "Usage : conf2xml.pl <inputfile> [ > outputfile ]\n";
|
||||
}
|
||||
$file = shift(@files);
|
||||
|
||||
use Switch;
|
||||
use XML::LibXML;
|
||||
my $parser = XML::LibXML->new();
|
||||
my $doc = $parser->load_xml(location => $file);
|
||||
my $data;
|
||||
|
||||
# reformatting days
|
||||
# According to http://wiki.flightgear.org/index.php/Interactive_Traffic
|
||||
# 0 = Sunday and 6 = saturday
|
||||
# For convenience we switch here to "classical" numbering
|
||||
# where 0 = Monday and 6 = sunday
|
||||
sub parseDay {
|
||||
my $day;
|
||||
$day = substr($_[0],0,1);
|
||||
switch ($day) {
|
||||
case 0 {$day="......6"} # Sunday
|
||||
case 1 {$day="0......"} # Monday
|
||||
case 2 {$day=".1....."} # Tuesday
|
||||
case 3 {$day="..2...."} # Wednesday
|
||||
case 4 {$day="...3..."} # Thrusday
|
||||
case 5 {$day="....4.."} # Friday
|
||||
case 6 {$day=".....5."} # Saturday
|
||||
else {$day="0123456"} # Daily
|
||||
};
|
||||
return $day;
|
||||
}
|
||||
|
||||
# reformatting times
|
||||
sub parseTime {
|
||||
return substr($_[0],2,5);
|
||||
}
|
||||
|
||||
print "# AC Homeport Registration RequiredAC AcTyp Airline Livery Offset Radius Flighttype PerfClass Heavy Model\n";
|
||||
# get aircraft data
|
||||
foreach $data ($doc->findnodes('/trafficlist/aircraft')) {
|
||||
my $AcMdl = $data->findnodes('./model');
|
||||
my $AcLvy = $data->findnodes('./livery');
|
||||
my $AcAln = $data->findnodes('./airline');
|
||||
my $AcHp = $data->findnodes('./home-port');
|
||||
my $AcReq = $data->findnodes('./required-aircraft');
|
||||
my $AcTyp = $data->findnodes('./actype');
|
||||
my $AcO = $data->findnodes('./offset');
|
||||
my $AcRad = $data->findnodes('./radius');
|
||||
my $AcFt = $data->findnodes('./flighttype');
|
||||
my $AcPrf = $data->findnodes('./performance-class');
|
||||
my $AcReg = $data->findnodes('./registration');
|
||||
my $AcHvy = $data->findnodes('./heavy');
|
||||
print "AC $AcHp $AcReg $AcReq $AcTyp $AcAln $AcLvy $AcO $AcRad $AcFt $AcPrf $AcHvy $AcMdl\n";
|
||||
}
|
||||
print "\n# FLIGHT Callsign Flightrule Days DeparTime DepartPort ArrivalTime ArrivalPort Altitude RequiredAc\n# 0 = Monday, 6 = Sunday\n";
|
||||
# get flight data
|
||||
foreach $data ($doc->findnodes('/trafficlist/flight')) {
|
||||
my $FlRep = $data->findnodes('repeat');
|
||||
my $FlDepPrt = $data->findnodes('departure/port');
|
||||
my $FlArrPrt = $data->findnodes('arrival/port');
|
||||
my $FlCs = $data->findnodes('callsign');
|
||||
my $FlFr = $data->findnodes('fltrules');
|
||||
my $FlCa = $data->findnodes('cruise-alt');
|
||||
my $FlReq = $data->findnodes('required-aircraft');
|
||||
my $FlDepDay = $data->findnodes('departure/time');
|
||||
my $FlDepTime = $data->findnodes('departure/time');
|
||||
my $FlArrDay = $data->findnodes('arrival/time');
|
||||
my $FlArrTime = $data->findnodes('arrival/time');
|
||||
my $FlDays = ".......";
|
||||
# handle flights depending on weekly or daily schedule
|
||||
if (lc($FlRep) eq "week") {
|
||||
$FlDays = parseDay($FlDepTime);
|
||||
$FlDepTime = parseTime($FlDepTime);
|
||||
$FlArrTime = parseTime($FlArrTime);
|
||||
} elsif (lc($FlRep) eq "24hr") {
|
||||
$FlDepDay = $data->findnodes('departure/time');
|
||||
$FlDepTime = substr($data->findnodes('departure/time'),0,5);
|
||||
$FlArrDay = $data->findnodes('arrival/time');
|
||||
$FlArrTime = substr($data->findnodes('arrival/time'),0,5);
|
||||
$FlDays = "0123456";
|
||||
} else {
|
||||
die "Error! No proper repetition found in XML!\n";
|
||||
}
|
||||
# output data
|
||||
print "FLIGHT $FlCs $FlFr $FlDays $FlDepTime $FlDepPrt $FlArrTime $FlArrPrt $FlCa $FlReq\n";
|
||||
}
|
||||
509
scripts/perl/web/mkindex.pl
Executable file
509
scripts/perl/web/mkindex.pl
Executable file
@@ -0,0 +1,509 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
#
|
||||
# adapted from a script by Bob Hain, 11/30/99
|
||||
#
|
||||
|
||||
#
|
||||
# default values
|
||||
#
|
||||
|
||||
$outfile = "new.index.html";
|
||||
|
||||
|
||||
#
|
||||
# process arguments
|
||||
#
|
||||
|
||||
$use_large = 1;
|
||||
while ( $arg = shift @ARGV ) {
|
||||
if ( $arg eq "--large" ) {
|
||||
$use_large = 1;
|
||||
}
|
||||
if ( $arg eq "--outfile" ) {
|
||||
$outfile = shift @ARGV;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Generate all images
|
||||
#
|
||||
|
||||
$src = "Source";
|
||||
$ldir = "Large";
|
||||
$sdir = "Small";
|
||||
$mdir = "Movies";
|
||||
|
||||
$columns = 2;
|
||||
|
||||
$swidth = 320;
|
||||
$sheight = 233;
|
||||
|
||||
$lwidth = 1024;
|
||||
$lheight = 768;
|
||||
|
||||
|
||||
#
|
||||
# Make sure directories exist
|
||||
#
|
||||
|
||||
if ( ! -e $ldir ) {
|
||||
mkdir $ldir, 0755;
|
||||
}
|
||||
|
||||
if ( ! -e $sdir ) {
|
||||
mkdir $sdir, 0755;
|
||||
}
|
||||
|
||||
# return 1 if file1 is newer than rile2
|
||||
sub is_newer {
|
||||
my($file1, $file2) = @_;
|
||||
# print " - $file1 - $file2 - \n";
|
||||
|
||||
($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime1,
|
||||
$ctime, $blksize, $blocks) = stat($file1);
|
||||
($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime2,
|
||||
$ctime, $blksize, $blocks) = stat($file2);
|
||||
|
||||
if ( $mtime1 > $mtime2 ) {
|
||||
return 1;
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Make images (both large and small)
|
||||
#
|
||||
|
||||
@FILES = `ls $src/*.jpg $src/*.JPG $src/*.png`;
|
||||
|
||||
foreach $file ( @FILES ) {
|
||||
chop $file;
|
||||
$file =~ s/$src\///;
|
||||
|
||||
if ( is_newer( "$src/$file", "$ldir/$file" ) || ! -e "$ldir/$file" ) {
|
||||
print "Updating $ldir/$file\n";
|
||||
system("cp -f $src/$file $ldir");
|
||||
system("mogrify -geometry \'$lwidth" . "X" .
|
||||
"$lheight>\' -interlace LINE -quality 80 $ldir/$file");
|
||||
}
|
||||
|
||||
if ( is_newer( "$ldir/$file", "$sdir/$file" ) || ! -e "$sdir/$file" ) {
|
||||
print "Updating $sdir/$file\n";
|
||||
system("cp -f $ldir/$file $sdir");
|
||||
system("mogrify -geometry \'$swidth" . "X" .
|
||||
"$sheight>\' -interlace LINE -quality 80 $sdir/$file");
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Check for large and small images to remove
|
||||
#
|
||||
|
||||
@FILES = `ls $ldir`;
|
||||
foreach $file ( @FILES ) {
|
||||
chop($file);
|
||||
# print "$file\n";
|
||||
if ( ! -f "$src/$file" ) {
|
||||
print "No matching src file - deleting large image $file ...\n";
|
||||
unlink( "$ldir/$file" );
|
||||
}
|
||||
}
|
||||
|
||||
@FILES = `ls $sdir`;
|
||||
foreach $file ( @FILES ) {
|
||||
chop($file);
|
||||
if ( ! -f "$src/$file" ) {
|
||||
print "No matching src file - deleting small image $file ...\n";
|
||||
unlink( "$sdir/$file" );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Build image list (for next/previous/first/last links)
|
||||
#
|
||||
|
||||
open( MASTER, "<master.idx" );
|
||||
|
||||
@imagelist = ();
|
||||
|
||||
while ( <MASTER> ) {
|
||||
chop;
|
||||
if ( m/\.jpg$/ || m/\.JPG$/ || m/\.png$/ ) {
|
||||
push @imagelist, $_;
|
||||
} else {
|
||||
# just ignore everything else
|
||||
}
|
||||
}
|
||||
|
||||
close( MASTER );
|
||||
|
||||
|
||||
#
|
||||
# Prepair $link subdirectory
|
||||
#
|
||||
|
||||
$link = "Link";
|
||||
system("rm -rf $link");
|
||||
mkdir $link, 0755;
|
||||
|
||||
|
||||
#
|
||||
# Assemble index.html
|
||||
#
|
||||
|
||||
$dir = `pwd`;
|
||||
chop($dir);
|
||||
$title = `basename $dir`;
|
||||
chop($title);
|
||||
|
||||
open( MASTER, "<master.idx" );
|
||||
open( OUT, ">$outfile" );
|
||||
|
||||
$j = 1;
|
||||
$in_table = 0;
|
||||
|
||||
while ( <MASTER> ) {
|
||||
chop;
|
||||
if ( m/^#/ ) {
|
||||
# ignore comments
|
||||
} elsif ( m/\.txt$/ ) {
|
||||
# insert text
|
||||
|
||||
if ( $in_table ) {
|
||||
$in_table = 0;
|
||||
print OUT "</TR>\n";
|
||||
print OUT "</TABLE>\n";
|
||||
}
|
||||
|
||||
$file = $_;
|
||||
open( IN, "<$src/$file" );
|
||||
while ( <IN> ) {
|
||||
print OUT $_;
|
||||
}
|
||||
close( IN );
|
||||
print OUT "<P>\n";
|
||||
$j = 1;
|
||||
$in_table = 0;
|
||||
} elsif ( m/\.jpg$/ || m/\.JPG$/ || m/\.png$/ ) {
|
||||
# insert image in 3 wide tables
|
||||
|
||||
$in_table = 1;
|
||||
$file = $_;
|
||||
|
||||
$i = `basename $file`;
|
||||
chop($i);
|
||||
|
||||
if ( $j == 1 ) {
|
||||
print OUT "<!-- Begin Row -->\n";
|
||||
print OUT "<TABLE ALIGN=CENTER>\n";
|
||||
print OUT "<TR VALIGN=TOP>\n";
|
||||
}
|
||||
|
||||
if ( $i =~ m/\.jpg$/ ) {
|
||||
$linkname = `basename $i .jpg`;
|
||||
} elsif ( $i =~ m/\.JPG$/ ) {
|
||||
$linkname = `basename $i .JPG`;
|
||||
} elsif ($i =~ m/\.png$/ ) {
|
||||
$linkname = `basename $i .png`;
|
||||
}
|
||||
chop($linkname);
|
||||
|
||||
$thumbinfo = `identify $sdir/$i`;
|
||||
($name, $type, $geom, $junk) = split(/\s+/, $thumbinfo, 4);
|
||||
($twidth, $theight) = split(/x/, $geom);
|
||||
$theight =~ s/\+.*$//;
|
||||
|
||||
# print OUT "<TD WIDTH=220 HEIGHT=160>\n";
|
||||
print OUT "<TD WIDTH=$twidth HEIGHT=$sheight>\n";
|
||||
|
||||
print OUT "<A HREF=\"$link/$linkname.html\">";
|
||||
print OUT "<IMG WIDTH=$twidth HEIGHT=$theight SRC=\"$sdir/$i\" ALT=\"$linkname\">";
|
||||
print OUT "</A><BR>\n";
|
||||
|
||||
if ( -f "$src/$linkname.txt" ) {
|
||||
print OUT "<FONT SIZE=-1 id=\"fgfs\">\n";
|
||||
open( IN, "<$src/$linkname.txt" );
|
||||
while ( <IN> ) {
|
||||
print OUT $_;
|
||||
}
|
||||
close( IN );
|
||||
print OUT "</FONT>\n";
|
||||
} else {
|
||||
print OUT "<FONT SIZE=-1 id=\"fgfs\">\n";
|
||||
print OUT "$linkname\n";
|
||||
print OUT "</FONT>\n";
|
||||
}
|
||||
|
||||
print OUT "</TD>\n";
|
||||
|
||||
if ( $j == $columns ) {
|
||||
$in_table = 0;
|
||||
print OUT "</TR>\n";
|
||||
print OUT "</TABLE>\n";
|
||||
}
|
||||
|
||||
if ( ++$j > $columns ) {
|
||||
$j = 1;
|
||||
}
|
||||
} elsif ( m/\.AVI$/ || m/\.mpg$/ || m/\.mov$/ ) {
|
||||
# insert image in 3 wide tables
|
||||
|
||||
$in_table = 1;
|
||||
$file = $_;
|
||||
|
||||
$i = `basename $file`;
|
||||
chop($i);
|
||||
|
||||
if ( $j == 1 ) {
|
||||
print OUT "<!-- Begin Row -->\n";
|
||||
print OUT "<TABLE ALIGN=CENTER>\n";
|
||||
print OUT "<TR VALIGN=TOP>\n";
|
||||
}
|
||||
|
||||
if ( $i =~ m/\.AVI$/ ) {
|
||||
$linkname = `basename $i .AVI`;
|
||||
} elsif ( $i =~ m/\.mpg$/ ) {
|
||||
$linkname = `basename $i .mpg`;
|
||||
} elsif ( $i =~ m/\.mov$/ ) {
|
||||
$linkname = `basename $i .mov`;
|
||||
} else {
|
||||
die "unknown movie type\n";
|
||||
}
|
||||
chop($linkname);
|
||||
# print OUT "<TD WIDTH=220 HEIGHT=160>\n";
|
||||
print OUT "<TD WIDTH=$swidth HEIGHT=$sheight>\n";
|
||||
|
||||
$thumbinfo = `identify $mdir/$linkname.jpg`;
|
||||
($name, $type, $geom, $junk) = split(/\s+/, $thumbinfo, 4);
|
||||
$geom =~ s/\+.*//;
|
||||
($twidth, $theight) = split(/x/, $geom);
|
||||
print "movie thumb geom = $geom $twidth $theight\n";
|
||||
|
||||
print OUT "<A HREF=\"$mdir/$i\">";
|
||||
if ( -f "$mdir/$linkname.jpg" ) {
|
||||
print OUT "<IMG WIDTH=$twidth HEIGHT=$theight SRC=\"$mdir/$linkname.jpg\" ALT=\"$linkname\">";
|
||||
} else {
|
||||
print OUT "$linkname";
|
||||
}
|
||||
print OUT "</A>\n";
|
||||
|
||||
if ( -f "$mdir/$linkname.txt" ) {
|
||||
print OUT "<BR>\n";
|
||||
print OUT "<FONT SIZE=-1 id=\"fgfs\">\n";
|
||||
open( IN, "<$mdir/$linkname.txt" );
|
||||
while ( <IN> ) {
|
||||
print OUT $_;
|
||||
}
|
||||
close( IN );
|
||||
print OUT "</FONT>\n";
|
||||
} else {
|
||||
print OUT "<BR>\n";
|
||||
print OUT "<FONT SIZE=-1 id=\"fgfs\">\n";
|
||||
print OUT "$linkname\n";
|
||||
print OUT "</FONT>\n";
|
||||
}
|
||||
|
||||
print OUT "</TD>\n";
|
||||
|
||||
if ( $j == $columns ) {
|
||||
$in_table = 0;
|
||||
print OUT "</TR>\n";
|
||||
print OUT "</TABLE>\n";
|
||||
}
|
||||
|
||||
if ( ++$j > $columns ) {
|
||||
$j = 1;
|
||||
}
|
||||
} else {
|
||||
# just pass along the rest as is
|
||||
|
||||
$j = 1;
|
||||
|
||||
if ( $in_table ) {
|
||||
$in_table = 0;
|
||||
print OUT "</TR>\n";
|
||||
print OUT "</TABLE>\n";
|
||||
}
|
||||
print OUT "$_\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Generate Links
|
||||
#
|
||||
|
||||
# @FILES = `ls $src/*.jpg $src/*.JPG $src/*.png`;
|
||||
|
||||
$first = $imagelist[0];
|
||||
if ( $first =~ m/\.jpg$/ ) {
|
||||
# print " ext = jpg\n";
|
||||
$firstname = `basename $first .jpg`;
|
||||
} elsif ( $first =~ m/\.JPG$/ ) {
|
||||
# print " ext = JPG\n";
|
||||
$firstname = `basename $first .JPG`;
|
||||
} else {
|
||||
# print " ext = png\n";
|
||||
$firstname = `basename $first .png`;
|
||||
}
|
||||
chop($firstname);
|
||||
|
||||
$last = $imagelist[$#imagelist];
|
||||
if ( $last =~ m/\.jpg$/ ) {
|
||||
# print " ext = jpg\n";
|
||||
$lastname = `basename $last .jpg`;
|
||||
} elsif ( $last =~ m/\.JPG$/ ) {
|
||||
# print " ext = JPG\n";
|
||||
$lastname = `basename $last .JPG`;
|
||||
} else {
|
||||
# print " ext = png\n";
|
||||
$lastname = `basename $last .png`;
|
||||
}
|
||||
chop($lastname);
|
||||
|
||||
for ($i = 0; $i <= $#imagelist; $i++) {
|
||||
$file = $imagelist[$i];
|
||||
# print "'$file'\n";
|
||||
|
||||
if ( $i > 0 ) {
|
||||
$prev = $imagelist[$i - 1];
|
||||
} else {
|
||||
$prev = "null";
|
||||
}
|
||||
|
||||
if ( $i < $#imagelist ) {
|
||||
$next = $imagelist[$i + 1];
|
||||
} else {
|
||||
$next = "null";
|
||||
}
|
||||
|
||||
if ( $file =~ m/\.jpg$/ ) {
|
||||
$linkname = `basename $file .jpg`;
|
||||
$ext = "jpg";
|
||||
} elsif ( $file =~ m/\.JPG$/ ) {
|
||||
$linkname = `basename $file .JPG`;
|
||||
$ext = "JPG";
|
||||
} else {
|
||||
$linkname = `basename $file .png`;
|
||||
$ext = "png";
|
||||
}
|
||||
chop($linkname);
|
||||
$nice_name = $linkname;
|
||||
$nice_name =~ s/\_/ /g;
|
||||
|
||||
if ( $prev =~ m/\.jpg$/ ) {
|
||||
# print " ext = jpg\n";
|
||||
$prevname = `basename $prev .jpg`;
|
||||
} elsif ( $prev =~ m/\.JPG$/ ) {
|
||||
# print " ext = JPG\n";
|
||||
$prevname = `basename $prev .JPG`;
|
||||
} else {
|
||||
# print " ext = png\n";
|
||||
$prevname = `basename $prev .png`;
|
||||
}
|
||||
chop($prevname);
|
||||
|
||||
if ( $next =~ m/\.jpg$/ ) {
|
||||
$nextname = `basename $next .jpg`;
|
||||
} elsif ( $next =~ m/\.JPG$/ ) {
|
||||
$nextname = `basename $next .JPG`;
|
||||
} else {
|
||||
$nextname = `basename $next .png`;
|
||||
}
|
||||
chop($nextname);
|
||||
|
||||
$outfile = "$link/$linkname.html";
|
||||
|
||||
open( OUT, ">$outfile" );
|
||||
print OUT <<EOF;
|
||||
|
||||
<HTML>
|
||||
|
||||
<HEAD>
|
||||
<TITLE>$linkname.$ext</TITLE>
|
||||
</HEAD>
|
||||
|
||||
<!-- <BODY BGCOLOR="#000000" ALINK="#000000" VLINK="#000000" LINK="#000000" TEXT="#FFFFFF"> -->
|
||||
<BODY>
|
||||
|
||||
<A HREF="$firstname.html">[First]</A>
|
||||
EOF
|
||||
|
||||
if ( $prevname ne "null" ) {
|
||||
print OUT "<A HREF=\"$prevname.html\">[Previous]</A>\n";
|
||||
} else {
|
||||
print OUT "[Previous]\n";
|
||||
}
|
||||
|
||||
if ( $nextname ne "null" ) {
|
||||
print OUT "<A HREF=\"$nextname.html\">[Next]</A>\n";
|
||||
} else {
|
||||
print OUT "[Next]\n";
|
||||
}
|
||||
|
||||
print OUT <<EOF;
|
||||
<A HREF="$lastname.html">[Last]</A>
|
||||
|
||||
<TABLE ALIGN=CENTER>
|
||||
<TR>
|
||||
<TD ALIGN=CENTER>
|
||||
<FONT SIZE=+1>
|
||||
$nice_name
|
||||
</FONT>
|
||||
</TD>
|
||||
</TR>
|
||||
|
||||
<TR>
|
||||
<TD ALIGN=CENTER>
|
||||
<FONT SIZE=-1>
|
||||
EOF
|
||||
|
||||
if ( -f "$src/$linkname.txt" ) {
|
||||
# print OUT "<BR>\n";
|
||||
open( IN, "<$src/$linkname.txt" );
|
||||
while ( <IN> ) {
|
||||
print OUT $_;
|
||||
}
|
||||
close( IN );
|
||||
}
|
||||
|
||||
print OUT <<EOF;
|
||||
</FONT>
|
||||
</TD>
|
||||
</TR>
|
||||
|
||||
</TABLE>
|
||||
|
||||
Click on the image for the full size version.
|
||||
|
||||
<TABLE ALIGN=CENTER>
|
||||
<TR>
|
||||
<TD ALIGN=CENTER>
|
||||
<A HREF="../$src/$linkname.$ext">
|
||||
EOF
|
||||
|
||||
if ( $use_large ) {
|
||||
print OUT " <IMG SRC=\"../$ldir/$linkname.$ext\">\n";
|
||||
} else {
|
||||
print OUT " <IMG SRC=\"../$src/$linkname.$ext\">\n";
|
||||
}
|
||||
|
||||
print OUT <<EOF;
|
||||
</TD>
|
||||
</A>
|
||||
</TR>
|
||||
</TABLE>
|
||||
|
||||
</BODY>
|
||||
</HTML>
|
||||
EOF
|
||||
|
||||
close( OUT );
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user