shwplay.pl to HTML.

index -|- end

Generated: Sat Oct 24 16:35:29 2020 from shwplay.pl 2020/02/04 25.5 KB. text copy

    #!/usr/bin/perl -w
# NAME: shwplay.sh
# AIM: *** SPECIAL *** read a FG 'playback' recording, and show details...
# 2020-01-31 - review...
# 19/11/2010 geoff mclane http://geoffair.net/mperl
use strict;
use warnings;
use File::Basename;  # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] )
use Cwd;
use File::stat;
my $perl_dir = 'C:\GTools\perl';
unshift(@INC, $perl_dir);
require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl'! Check location and \@INC content.\n";
require 'fg_wsg84.pl' or die "Unable to load fg_wsg84.pl ...\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /(\\|\/)/) {
    my @tmpsp = split(/(\\|\/)/,$pgmname);
    $pgmname = $tmpsp[-1];
}
my $outfile = $perl_dir."\\temp.$pgmname.txt";
open_log($outfile);

# user variables
my $load_log = 1;
my $in_file = '';
my $CP_EPSILON = 0.0000001; # EQUALS SG_EPSILON 20101121
#my $CP_EPSILON  = 0.00001; # 4 zeros - less than meter

my $debug_on = 1;
my $def_rec_file = 'C:\Users\user\Documents\FG\BIKF\circuit11.csv';
#my $def_rec_file = 'C:\FG\27\bin\records\temp_c172.txt';
#my $def_rec_file = 'C:\FG\27\bin\records\temp_record.txt';
#my $def_rec_file = 'C:\FG\27\bin\records\first_record.txt';
#my $def_file = 'C:\FG\27\data\Protocol\playback.xml';
my $def_file = 'G:\X\fgdata\Protocol\playback.xml';
# my $def_file = 'C:\FG\27\bin\records\first_record.txt';
# my $def_edit_file = 'C:\FG\27\bin\records\temp_edit.txt';
# my $def_edit_file = 'C:\FG\27\bin\records\flight_gil_02.txt';
my $def_edit_file = 'C:\Users\user\Documents\FG\BIKF\circuit11.txt';

# 0048: name latitude-deg 
my $OFF_LAT = 48;
# 0049: name longitude-deg 
my $OFF_LON = 49;
# 0050: name altitude-ft 
my $OFF_ALT = 50;
# 0051: name roll-deg 
my $OFF_ROLL = 51;
# 0052: name pitch-deg 
my $OFF_PITCH = 52;
# 0053: name heading-deg 
my $OFF_HEADING = 53;
# 0054: name side-slip-rad 
# 0055: name airspeed-kt 
my $OFF_SPEED = 55;

my $g_header_line = "";

my @list_order = qw( latitude-deg longitude-deg altitude-ft heading-deg airspeed-kt roll-deg pitch-deg );
# for each entry we are using from the stream - here just 7 - lat,lon,alt,hdg,spd,roll,pitch

my %name_2_short = (
    'latitude-deg' => 'lat',    # $OFF_LAT = 48;
    'longitude-deg' => 'lon',   # $OFF_LON = 49;
    'altitude-ft'   => 'alt',   # $OFF_ALT = 50;
    'roll-deg'      => 'roll'# $OFF_ROLL = 51;
    'pitch-deg'     => 'pitch', # $OFF_PITCH = 52;
    'heading-deg'   => 'hdg',   # $OFF_HEADING = 53;
    'airspeed-kt'   => 'ias'    # $OFF_SPEED = 55;
    );

# my $head = " latitude    longitude    altitude  hdg        ias  pitch     roll";
my %name_2_desc = (
    'latitude-deg' => 'latitude',    # $OFF_LAT = 48;
    'longitude-deg' => 'longitude',   # $OFF_LON = 49;
    'altitude-ft'   => 'altitude',   # $OFF_ALT = 50;
    'roll-deg'      => 'roll'# $OFF_ROLL = 51;
    'pitch-deg'     => 'pitch', # $OFF_PITCH = 52;
    'heading-deg'   => 'hdg',   # $OFF_HEADING = 53;
    'airspeed-kt'   => 'ias'    # $OFF_SPEED = 55;
    );

# latitude-deg longitude-deg altitude-ft heading-deg airspeed-kt roll-deg pitch-deg
# 48.812668, 2.072042, 364.2, 294.1, 0.0, 0.000000, 0.307090
my %min_wids = (
    'latitude-deg'  => 16,
    'longitude-deg' => 16,
    'altitude-ft' => 10,
    'heading-deg'  => 7,
    'airspeed-kt'  => 7,
    'roll-deg'     => 7,
    'pitch-deg'    => 7
    );

sub gen_header_line() {
    $g_header_line = "";
    my ($txt,$hdr,$len,$msg,$key,$min);
    $min = 1;
    foreach $key (keys %min_wids) {
        $len = $min_wids{$key};
        $min = $len if ($len > $min);
    }
    foreach $key (@list_order) {
        $hdr = "UNKNOWN";
        $len = $min; # 16;
        if (defined $name_2_desc{$key}) {
            $hdr = $name_2_desc{$key};
        }
        if (defined $min_wids{$key}) {
            $len = $min_wids{$key};
        }
        $msg = $hdr;
        $msg .= " " while (length($msg) < $len);
        $g_header_line .= ", " if (length($g_header_line));
        $g_header_line .= $msg;
    }
}

# =============================================
my $ground_level = 364;
my $on_grd_diff = 3;

my $curr_hetz = 5;
my @set_of_offsets = ( $OFF_LAT, $OFF_LON, $OFF_ALT, $OFF_HEADING, $OFF_SPEED, $OFF_ROLL, $OFF_PITCH );
my $run_time = 20 * 60; # seconds of runtime in file
# debug
my $dbg_sp01 = 0;
my $dbg_sp02 = 0;
my $dbg_sp03 = 0;
my $dbg_sp04 = 0;

### program variables
my @warnings = ();
my $cwd = cwd();
my $os = $^O;
my $g_discarded = 0;

sub show_warnings($) {
    my ($val) = @_;
    if (@warnings) {
        prt( "\nGot ".scalar @warnings." WARNINGS...\n" );
        foreach my $itm (@warnings) {
           prt("$itm\n");
        }
        prt("\n");
    } else {
        prt( "\nNo warnings issued.\n\n" );
    }
}

sub pgm_exit($$) {
    my ($val,$msg) = @_;
    if (length($msg)) {
        $msg .= "\n" if (!($msg =~ /\n$/));
        prt($msg);
    }
    show_warnings($val);
    close_log($outfile,$load_log);
    exit($val);
}


sub prtw($) {
   my ($tx) = shift;
   $tx =~ s/\n$//;
   prt("$tx\n");
   push(@warnings,$tx);
}

sub on_gound($) {
    my $ft = shift;
    return 1 if ($ft == $ground_level);
    return 1 if (abs($ft - $ground_level) <= $on_grd_diff);
    return 0;
}

sub process_in_file($) {
    my ($inf) = @_;
    if (! open INF, "<$inf") {
        pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); 
    }
    my @lines = <INF>;
    close INF;
    my $lncnt = scalar @lines;
    prt("Processing $lncnt lines, from [$inf]...\n");
    my ($line,$inc,$lnn,@arr,$len,$intag,$tag,$i,$ch,$txt);
    my (@carr,$cnt,$k,$key,$val,$coff);
    my $tag_list = '';
    my $inoutput = 0;
    my $ininput = 0;
    my $inchunk = 0;
    my $incomm = 0;
    my $chunkcnt = 0;
    my $ckey = '';
    my $actsect = '';
    my $chk_off = 0;
    $lnn = 0;
    $intag = 0;
    $tag = '';
    $txt = '';
    my %chunks = ();
    my @chunk_stack = ();
    @carr = ();
    foreach $line (@lines) {
        chomp $line;
        $lnn++;
        # prt("$lnn: $inc\n");
        @arr = split(/,/,$line);
        $len = length($line);
        for ($i = 0; $i < $len; $i++) {
            $ch = substr($line,$i,1);
            if ($intag) {
                if ($ch eq '>') {
                    if ($tag eq 'output') {
                        prt("Begin output section...\n");
                        $inoutput = 1;
                        $actsect = 'output';
                        $chk_off = 0;
                    } elsif ($tag eq '/output') {
                        prt("End output section...\n");
                        $inoutput = 0;
                        $actsect = '';
                    } elsif ($tag eq 'input') {
                        prt("Begin input section...\n");
                        $ininput = 1;
                        $actsect = 'input';
                        $chk_off = 0;
                    } elsif ($tag eq '/input') {
                        prt("End input section...\n");
                        $ininput = 0;
                        $actsect = '';
                    } elsif ($tag eq 'chunk') {
                        prt("Start chunk section...\n") if ($dbg_sp02);
                        $txt = '';
                        $inchunk = 1;
                        @chunk_stack = ();
                        $tag_list = '';
                    } elsif ($tag eq '/chunk') {
                        @carr = split(/,/,$txt);
                        $cnt = scalar @carr;
                        # chunk: 8  name, aileron, type, float, format, %f, node, /controls/flight/aileron[0]
                        # pgm_exit(1,"chunk: $cnt $txt\n");
                        my %h = ();
                        for ($k = 0; $k < $cnt; $k += 2) {
                            $key = trim_all($carr[$k]);
                            $val = trim_all($carr[$k+1]);
                            if ($key eq 'name') {
                                if ($ininput) {
                                    $key = "aaa__$key.i";
                                } elsif ($inoutput) {
                                    $key = "aaa__$key.o";
                                }
                                ### $val = sprintf("%s (%d)", $val, $chk_off);
                                $chk_off++;
                            }
                            $h{$key} = $val;
                        }
                        $key = 'aaa__offset';
                        $h{$key} = $chk_off;
                        $chunkcnt++;
                        $ckey = sprintf("%06d",$chunkcnt);
                        $chunks{$ckey} = \%h;
                        prt("$lnn: $cnt [$txt] $actsect\n") if ($dbg_sp03);
                        $inchunk = 0;
                        $txt = '';
                    } elsif ($tag eq 'comment') {
                        prt("Start comment section...\n") if ($dbg_sp01);
                        $incomm = 1;
                    } elsif ($tag eq '/comment') {
                        prt("End comment section..\n") if ($dbg_sp01);
                        $incomm = 0;
                    } else {
                        if ($inchunk) {
                            if ($tag =~ /^\//) {
                                # end tag
                                if (@chunk_stack) {
                                    pop @chunk_stack;
                                }
                            } else {
                                push(@chunk_stack,$tag);
                                $tag_list .= " $tag";
                                $txt .= "," if (length($txt));
                                $txt .= " $tag";
                            }
                        }
                    }
                    $intag = 0;

                    $tag = '';
                } else {
                    $tag .= $ch;
                }
            } else {
                if ($ch eq '<') {
                    $intag = 1;
                    $txt .= ", " if (length($txt) && length($tag));
                    $txt .= $tag;
                    $tag = '';
                } else {
                    if ($ch =~ /\s/) {
                        $tag .= $ch if (length($tag));
                    } else {
                        $tag .= $ch;
                    }
                }
            }
        }
    }
    #$chunks{'=SYS_LINES='} = \@lines;
    #$chunks{'=SYS_STACK='} = \@chunk_stack;
    return \%chunks;
}

my %g_in_props = ();
my %g_out_props = ();
sub check_props() {
    my @i_props = sort keys %g_in_props;
    my @o_props = sort keys %g_out_props;
    my $icnt = scalar @i_props;
    my $ocnt = scalar @o_props;
    prt("Got $icnt in, and $ocnt out props...\n");


}

sub show_chunks($) {
    my ($rchks) = @_;
    my ($ckey,$rchk,$key,$val,$show,$dir);
    my $name = '';
    my $path = '';
    my $obj_off = 0;
    $dir = '?';
    my $ccnt = scalar keys( %{$rchks} );
    prt("\nDisplay of $ccnt CHUNKS... x 2... plus '=SYS_' specials...\n");
    my @arr = ();
    my $curr_dir = '?';
    my ($dircnt,$dstg);
    $dircnt = 0;
    my $shwitms = 0;
    my ($rprops);
    # keys: 000001 000002 000003  ... 000154
    my @akeys = sort keys %{$rchks};
    #prt("keys:\n".join(" ",@akeys)."\n");
    #pgm_exit(1,"TEMPEXIT\n");
    #foreach $ckey (sort keys %{$rchks}) {
    foreach $ckey (@akeys) {
        next if ($ckey =~ /^=SYS_/);
        $rchk = ${$rchks}{$ckey};
        my @keys = sort keys %{$rchk};
        #prt("keys:\n".join(" ",@keys)."\n");
        #pgm_exit(1,"TEMPEXIT\n");
        # keys: aaa__name.o aaa__offset format node type
        foreach $key (sort keys %{$rchk}) {
            $val = ${$rchk}{$key};
            $show = 0;
            if ($key =~ /^aaa__name/) {
                $key =~ s/^aaa__//;
                if ($key =~ /name\.(o|i)$/) {
                    $dir = $1;
                    $key =~ s/\.(o|i)$//;
                    if ($dir ne $curr_dir) {
                        $curr_dir = $dir;
                        $dircnt = 0;
                        if ($dir eq 'o') {
                            prt("Direction is output...\n");
                            $rprops = \%g_out_props;
                        } elsif ($dir eq 'i') {
                            prt("Direction is input...\n");
                            $rprops = \%g_in_props;
                            $shwitms = 1;
                        } else {
                            prtw("WARNING: Direction UNKNOWN [$dir] [$key]...\n");
                        }
                    }
                    $dstg = sprintf("%04d",$dircnt);    # show logical (0,1,2,...(n-1))
                    $dircnt++;
                }
                $show = 1;
                $name = $val;
            } elsif ($key eq 'aaa__offset') {
                # just the offset in the LIST
                $obj_off = $val;
            } else {
                if ($key eq 'format') {

                } elsif ($key eq 'node') {
                    $path = $val;
                } elsif ($key eq 'type') {

                } else {
                    $show = 1;
                }
            }
            #prt("$dstg: $key $val ") if ($show && ($dir eq 'i')); 
            prt("$dstg: $key $val") if ($show && $dbg_sp04);
        }
        push(@arr, [$name,$obj_off,$path,$dir]);
        prt("$dstg: name $name, path $path\n");
        if (defined $rprops) {
            ${$rprops}{$path} = [$dstg,$name];
        }
        $name = '';
        $path = '';
        $obj_off = 0;
        $dir = '?';
        #prt("\n");
    }
    check_props();
    return \@arr;
}

sub secs_2_hhmmss($) {
   my ($secs) = shift;
   my $rt = '';
   my $mins = int($secs / 60);
    my $hrs = '00';
   $secs = $secs - ($mins * 60);
   $secs = (int(($secs * 10) + 0.5)) / 10;
   if ($mins > 60) {
      $hrs = int($mins / 60);
      $mins = $mins - ($hrs * 60);
      $hrs = '0'.$hrs if ($hrs < 10);
      $mins = '0'.$mins if ($mins < 10);
      $secs = '0'.$secs if ($secs < 10);
   } else {
      $mins = '0'.$mins if ($mins < 10);
      $secs = '0'.$secs if ($secs < 10);
   }
    $rt = "$hrs:$mins:$secs";
   return $rt;
}

sub in_world_range($$) {
    my ($nlat,$nlon) = @_;
    if (($nlat <= 90)&&
        ($nlat >= -90)&&
        ($nlon <= 180)&&
        ($nlon >= -180)) {
        return 1;
    }
    return 0;
}


sub in_the_real_world_range($$$) {
    my ($nlat,$nlon,$alt) = @_;
    if (in_world_range($nlat,$nlon)&&
        ($alt > -9999)) {
        return 1;
    }
    return 0;
}

# read_records ( $ref_array, $ref_hash, $def_rec_file );

# latitude-deg longitude-deg altitude-ft heading-deg airspeed-kt roll-deg pitch-deg
# 48.812668, 2.072042, 364.2, 294.1, 0.0, 0.000000, 0.307090
#my %min_wids = (
#    'latitude-deg'  => 16,
#    'longitude-deg' => 16,
#    'altitude-ft' => 10,
#    'heading-deg'  => 5,
#    'airspeed-kt'  => 7,
#    'roll-deg'     => 7,
#    'pitch-deg'    => 7
#    );
#             48.812668,   2.072042,      364.2, 294.1,     0.0, 0.000000, 0.307090
# my $head = " latitude    longitude    altitude  hdg        ias  pitch     roll";
sub read_records($$$) {
    my ( $rarr, $rhash, $inf ) = @_;
    # 'stat' returns 13 fields ...
    my $sb = stat($inf) or pgm_exit(1, "ERROR: Unable to 'stat' file [$inf]?\n" );
    if (! open INF, "<$inf") {
        pgm_exit(1,"ERROR: Unable to oopen $inf\n");
    }
    my @lines = <INF>;
    close INF;
    my @out_lines = ();
    gen_header_line();
    my $head = $g_header_line;
    my $lncnt = scalar @lines;
    my ($line,@arr,$lnn,$elev,$name,$tmp,$ailer,$ailert,$name1);
    my ($lat,$lon,$alt,$roll,$pitch,$heading,$speed);
    my ($nlat,$nlon,$nalt,$nroll,$npitch,$nheading,$nspeed);
    my ($max,$i,$msg,$off,$value,$banner,$pnt,$get1d,$snm,$len,$dvalue);
    my ($ongrd,$keep,$isok);
    my $minlat = -200;
    my $maxlat = 200;
    my $minlon = -200;
    my $maxlon = 200;
    my $first_lat = 200;
    my $first_lon = 200;
    my $first_alt = -9999;
    my $first_hdg = -1;
    my $first_speed = -1;
    my $first_roll = 0;
    my $first_pitch = 0;

    #   0         1         2         3         4           5          6    = 7 display items...
    my ($prev_lat,$prev_lon,$prev_alt,$prev_hdg,$prev_speed,$prev_roll,$prev_pitch);
    $max = scalar @set_of_offsets;
   my $tm = scalar localtime $sb->mtime;
    my $secs = $lncnt / $curr_hetz;
    my $fps = $lncnt / $run_time;
    my $run_tm = secs_2_hhmmss($run_time);
    my $play_time = secs_2_hhmmss($secs);
    $banner = "$run_tm: $lncnt lines, fps = $fps, $play_time. Size ".$sb->size." bytes,\n from [$inf] $tm... (".(int($secs+0.5))."s)";
    prt("\nRun: $banner\n");
    $lnn = 0;
    $tmp = ${$rarr}[$OFF_LAT];
    $nlat = ${$tmp}[0];
    $tmp = ${$rarr}[$OFF_LON];
    $nlon = ${$tmp}[0];
    $tmp = ${$rarr}[$OFF_ALT];
    $nalt = ${$tmp}[0];
    $tmp = ${$rarr}[$OFF_ROLL];
    $nroll = ${$tmp}[0];
    $tmp = ${$rarr}[$OFF_PITCH];
    $npitch = ${$tmp}[0];
    $tmp = ${$rarr}[$OFF_HEADING];
    $nheading = ${$tmp}[0];
    $tmp = ${$rarr}[$OFF_SPEED];
    $nspeed = ${$tmp}[0];
    my $rn2s = \%name_2_short;
    my $rwids = \%min_wids;
    prt("$head\n");
    foreach $line (@lines) {
        chomp $line;
        @arr = split(/,/,$line);
        $msg = '';
        $pnt = 1; # paint all lines, except those discarded
        $ongrd = 0;
        $keep = 1;
        $isok = 0;
        for ($i = 0; $i < $max; $i++) {
            $off = $set_of_offsets[$i];
            $tmp = ${$rarr}[$off];
            $name = ${$tmp}[0];
            $value = $arr[$off];
            $dvalue = $value;
            $get1d = 0;
            # my @list_order = qw( latitude-deg longitude-deg altitude-ft heading-deg airspeed-kt roll-deg pitch-deg );
            if ($name eq $list_order[0]) {
                $nlat = $value;
            } elsif ($name eq $list_order[1]) {
                $nlon = $value;
            } elsif ($name eq 'altitude-ft') {
                $nalt = $value;
                if ($value <= -9999) {
                    $pnt = 0;
                    $g_discarded++;
                    $ongrd = 2;
                    $keep = 0;
                } else {
                    # only to nearest 1/10 foot, a few centimeters...
                    $get1d = 1;
                    $ongrd = on_gound($value) ? 1 : 0;
                }
            } elsif ($name eq 'heading-deg') {
                $nheading = $value;
                if (abs($prev_hdg - $nheading) < 0.1) {
                    $tmp = int( $value /  10 );
                    $tmp = "0$tmp" if ($tmp < 10);
                    $value = $tmp."cap";
                } else {
                    $get1d = 1;
                }

            } elsif ($name eq 'airspeed-kt') {
                $nspeed = $value;
                if (abs($nspeed - $prev_speed) < 0.1) {
                    if (abs($nspeed - $first_speed) > 0.1) {
                        $value = "v";
                    } else {
                        $value = "bgn";
                    }
                } else {
                    $get1d = 1;
                }
            } elsif ($name eq 'roll-deg') {
                $nroll = $value;
            } elsif ($name eq 'pitch-deg') {
                $npitch = $value;
            }

            if ($get1d) {
                $tmp = int(($value + 0.05) * 10);
                $value = $tmp / 10;
                if ( !($value =~ /\./) ) {
                    $value .= ".0";
                }
            }

            $snm = $name;
            if ($name eq 'altitude-ft') {
                $value = '*GRD*' if ($ongrd);
            }
            if (defined ${$rn2s}{$snm}) {
                $snm = ${$rn2s}{$snm};
            }

            $msg .= ", " if (length($msg));
            # $msg .= "$name = [$value]";
            #$msg .= "$snm = [$value]";
            if (defined ${$rwids}{$name}) {
                $len = ${$rwids}{$name};
                $value = " $value" while (length($value) < $len);
            }
            $msg .= "$value";
        } # for each entry we are using from the stream - here just 7 - lat,lon,alt,$hdg,spd,hdg,roll,pitch

        if (in_the_real_world_range($nlat,$nlon,$nalt)) {
            if ($keep && $pnt) {
                if ($first_lat == 200) {
                    $first_lat = $nlat;
                    $first_lon = $nlon;
                    $first_alt = $nalt;
                    $first_hdg = $nheading;
                    $first_speed = $nspeed;
                    $first_roll = $nroll;
                    $first_pitch = $npitch;
                } else {
                    my ($sg_az1,$sg_az2,$sg_dist);
                    my ($sg_paz1,$sg_paz2,$sg_pdist);
                    my $res = fg_geo_inverse_wgs_84 ($nlat,$nlon,$first_lat,$first_lon,\$sg_az1,\$sg_az2,\$sg_dist);
                    my $res1 = fg_geo_inverse_wgs_84 ($nlat,$nlon,$prev_lat,$prev_lon,\$sg_paz1,\$sg_paz2,\$sg_pdist);
                    my $sg_km = $sg_dist / 1000;
                    my $sg_im = int($sg_dist);
                    my $sg_ikm = int($sg_km + 0.5);
                    if (abs($sg_pdist) < $CP_EPSILON) {
                        $msg .= " still";
                    } else {
                        $sg_az1 = int(($sg_az1 * 10) + 0.05) / 10;
                        if (abs($sg_km) > $CP_EPSILON) { # = 0.0000001; # EQUALS SG_EPSILON 20101121
                            if ($sg_ikm && ($sg_km >= 1)) {
                                $sg_km = int(($sg_km * 10) + 0.05) / 10;
                                $msg .= " Dist: $sg_km km";
                            } else {
                                $msg .= " Dist: $sg_im m, less 1 km";
                            }
                            $isok = 1;
                        } else {
                            $msg .= " Dist: First";
                        }
                    }
                }
            }
            # set as PREVIOUS
            $prev_lat = $nlat;
            $prev_lon = $nlon;
            $prev_alt = $nalt;
            $prev_hdg = $nheading;
            $prev_speed = $nspeed;
            $prev_roll = $nroll;
            $prev_pitch = $npitch;
        }

        prt("$msg\n") if ($pnt);
        #$ailer = $arr[0];
        #$ailert = $arr[1];
        #$tmp = ${$rarr}[0];
        #$name = ${$tmp}[0];
        #$tmp = ${$rarr}[1];
        #$name1 = ${$tmp}[0];
        #prt("$name: $ailer, $name1: $ailert\n");
        push(@out_lines,$line) if ($keep);
        $lnn++;
    } # for each LINE in the file

    prt("$head\n");
    prt("End $banner\n");
    # WRITE TO FILE
    if (length($def_edit_file) && @out_lines) {
        rename_2_old_bak($def_edit_file);
        $line = join("\n",@out_lines)."\n";
        write2file($line,$def_edit_file);
        prt("Written to [$def_edit_file]...\n");
    }
    return \@out_lines;
}


#########################################
### MAIN ###
parse_args(@ARGV);
### prt( "$pgmname: in [$cwd]: Hello, World...\n" );
my $ref_hash = process_in_file($in_file);
my $ref_array = show_chunks($ref_hash);
# read_records ( $ref_array, $ref_hash, $def_rec_file );

pgm_exit(0,"Normal exit(0)");
########################################
sub give_help {
    prt("$pgmname: version 0.0.1 2010-09-11\n");
    prt("Usage: $pgmname [options] in-file\n");
    prt("Options:\n");
    prt(" --help (-h or -?) = This help, and exit 0.\n");
}
sub need_arg {
    my ($arg,@av) = @_;
    pgm_exit(1,"ERROR: [$arg] must have following argument!\n") if (!@av);
}

sub parse_args {
    my (@av) = @_;
    my ($arg,$sarg);
    while (@av) {
        $arg = $av[0];
        if ($arg =~ /^-/) {
            $sarg = substr($arg,1);
            $sarg = substr($sarg,1) while ($sarg =~ /^-/);
            if (($sarg =~ /^h/i)||($sarg eq '?')) {
                give_help();
                pgm_exit(0,"Help exit(0)");
            } else {
                pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n");
            }
        } else {
            $in_file = $arg;
            prt("Set input to [$in_file]\n");
        }
        shift @av;
    }

    if ((length($in_file) ==  0) && $debug_on) {
        $in_file = $def_file;
    }
    if (length($in_file) ==  0) {
        pgm_exit(1,"ERROR: No input files found in command!\n");
    }
    if (! -f $in_file) {
        pgm_exit(1,"ERROR: Unable to find in file [$in_file]! Check name, location...\n");
    }
}

# ===================================
# made up of input and output lists of chunks, adding name, type, format, node (path)
sub xml_sample() {
    my $x = <<EOF;
<?xml version="1.0"?>
<PropertyList>
 <comment>
  <![CDATA[
    Usage:
    Recording: fgfs --generic=file,out,20,flight.out,playback
    Playback:  fgfs --generic=file,in,20,flight.out,playback --fdm=null
  ]]>
 </comment>
 <generic>
  <output>
   <line_separator>newline</line_separator>
   <var_separator>,</var_separator>
   <!-- Flight Controls -->
   <chunk>
    <name>aileron</name>
    <type>float</type>
    <format>%f</format>
    <node>/controls/flight/aileron[0]</node>
   </chunk>
   <!-- more of these ... -->
  </output>
  <input>
   <line_separator>newline</line_separator>
   <var_separator>,</var_separator>
   <!-- Flight Controls -->
   <chunk>
    <name>aileron</name>
    <type>float</type>
    <node>/controls/flight/aileron</node>
   </chunk>
   <chunk>
    <name>aileron-trim</name>
    <type>float</type>
    <node>/controls/flight/aileron-trim</node>
   </chunk>
 </input>
 </generic>
</PropertyList>
EOF
    return $x
}

# eof - shwplay.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional