first commit
This commit is contained in:
Your Name
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
|
||||
Reference in New Issue
Block a user