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