#!/usr/bin/perl -w # NAME: showplayback.pl # AIM: SPECIFIC - Read the FG playback.xml, and show simple list of 'xml' chunks, # and then read a 'playback' recording, and show the 'changes' over time... # 05/06/2016 review - some minor tweaks... found typo in playback.xml file, # 17/12/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 Time::HiRes qw( usleep gettimeofday tv_interval ); my $perl_dir = 'C:\GTools\perl'; unshift(@INC, $perl_dir); require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; require 'fg_wsg84.pl' or die "Unable to load fg_wsg84.pl ...\n"; require "Bucket2.pm" or die "Unable to load Bucket2.pm ...\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 = 'D:\FG\d-and-c\install\FlightGear\fgdata\Protocol\playback.xml'; my $in_flight = 'D:\FG\d-and-c\tracks\6-27-2016-1.csv'; # Jsin's flight south #my $in_file = 'C:\FG\28\data\Protocol\playback.xml'; #my $in_file = 'D:\FG\fg-64\install\FlightGear\fgdata\Protocol\playback.xml'; #my $in_flight = 'D:\FG\fg-64\LPMA-01.csv'; # 1000 ft circuit #my $in_flight = 'C:\FG\27\bin\records\zips\temp2\flight_gil_03.txt'; # resonable circuit, bad landing #my $in_flight = 'C:\FG\27\bin\records\zips\temp\flt-gilc172-01.txt'; #my $in_flight = 'C:\FG\27\bin\records\third_flight.txt'; #my $in_flight = 'C:\FG\27\bin\records\flight_gil_02.txt'; #my $in_flight = 'C:\FG\27\bin\records\third_t01.txt'; my $SG_EPSILON = 0.000001; my $play_cols = 77; my $use_blanked_path = 0; my $list_node_set = 0; my $show_duplications = 0; my $min_name_len = 32; my $min_node_len = 48; my $debug_on = 0; my $def_file = 'def_file'; my $dbg_pb01 = 0; ### program variables my @warnings = (); my $cwd = cwd(); my $os = $^O; my $previous_node = ' '; my $g_used_of_cache = 0; my $t0 = [gettimeofday]; 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) = @_; show_warnings($val); if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg); } my $elap = tv_interval( $t0, [gettimeofday] ); prt("Ran of $elap seconds...\n"); # prt("Used offset cache $g_used_of_cache times...\n"); close_log($outfile,$load_log); exit($val); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub get_autopilot_nodes() { my $apnds = < 0) { $dec .= "."; $arr[1] = substr($arr[1],0,$dl) if (length($arr[1]) > $dl); $dec .= $arr[1]; } } } else { $dec = " $dec" while (length($dec) < $il); if ($dl) { $dec .= "."; while ($dl--) { $dec .= "0"; } } } return $dec; } sub get_heading_stg($) { my ($hdg) = @_; #return get_decimal_stg($hdg,3,1); return get_decimal_stg($hdg,3,0); } sub get_sg_dist_stg($) { my ($sg_dist) = @_; my $sg_km = $sg_dist / 1000; my $sg_im = int($sg_dist); my $sg_ikm = int($sg_km + 0.5); my $dlen = 5; # if (abs($sg_pdist) < $CP_EPSILON) my $sg_dist_stg = ""; if (abs($sg_km) > $SG_EPSILON) { # = 0.0000001; # EQUALS SG_EPSILON 20101121 if ($sg_ikm && ($sg_km >= 1)) { $sg_km = int(($sg_km * 10) + 0.05) / 10; #$sg_dist_stg .= get_decimal_stg($sg_km,5,1)." km"; $sg_dist_stg .= get_decimal_stg($sg_km,($dlen - 2),1)." km"; } else { #$sg_dist_stg .= "$sg_im m, <1km"; #$sg_dist_stg .= get_decimal_stg($sg_im,7,0)." m."; $sg_dist_stg .= get_decimal_stg($sg_im,$dlen,0)." m."; } } else { #$sg_dist_stg .= "0 m"; #$sg_dist_stg .= get_decimal_stg('0',7,0)." m."; $sg_dist_stg .= get_decimal_stg('0',$dlen,0)." m."; } return $sg_dist_stg; } sub process_in_file($) { my ($inf) = @_; if (! open INF, "<$inf") { pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); } my @lines = ; close INF; my $lncnt = scalar @lines; prt("Processing $lncnt lines, from [$inf]...\n"); my ($line,$inc,$lnn,$len,$i,$ch,$pc,$nc,$intag,$tag,$txt,$inch,$chcnt,$chunk,$type,$incomm); my ($indata,$lasttag,$tnum,$key,$val,$ininput,$inoutput,$where,$dir,$nodcnt,$namcnt,$nxttxt); my ($chname,$chnode,$chtype,$node,$name,$choff); $lnn = 0; $ch = ''; $intag = 0; $inch = 0; $tag = ''; $txt = ''; $chcnt = 0; $chunk = ''; $type = ''; $incomm = 0; $indata = 0; $ininput = 0; $inoutput = 0; my %chunks = (); # hold it all my %chunkh = (); my %inames = (); my %itypes = (); my %inodes = (); my %onames = (); my %otypes = (); my %onodes = (); my %nnames = (); my %ntypes = (); my %nnodes = (); my $rnames = \%nnames; my $rtypes = \%ntypes; my $rnodes = \%nnodes; #my @chunkrefsi = (); #my @chunkrefso = (); #my @nochunks = (); #my $rca = \@nochunks; $where = ''; $dir = 'n'; $choff = 0; # offset of this chunk as found in file foreach $line (@lines) { chomp $line; $lnn++; $line = trim_all($line); $len = length($line); next if ($len == 0); for ($i = 0; $i < $len; $i++) { $pc = $ch; $ch = substr($line,$i,1); if ($intag) { if ($ch eq '>') { if ($inch) { if ($tag =~ /^\?/) { # header $type = 'hdr'; } elsif ($tag =~ /^!--/) { $incomm = 1; $type = 'bgn.comm'; } elsif ($tag =~ /--$/) { $incomm = 0; $type = 'end.comm'; } elsif ($tag =~ /^!\[CDATA\[/) { $indata = 1; } elsif ($tag =~ /\]\]$/) { $indata = 0; } elsif ($tag =~ /\/$/) { $type = 'closed'; } elsif ($tag =~ /^\//) { $type = 'close'; if (length($txt)) { $chunk .= "$txt "; $chunkh{$lasttag} = $txt; } if ($tag eq '/chunk') { # STORE THE COLLECTED CHUNK # Get storage number - sequence counter $tnum = sprintf("%05d$dir",$chcnt); # ============================================= $chunkh{'offset'} = $choff; # keep OFFSET $chunks{$tnum} = { %chunkh }; # STORE THE CHUNK $val = $chunks{$tnum}; # EXTRACT A CHUNK #if (defined ${$val}{'name'} && ${$val}{'node'}) { # && ${$val}{'type'}) if (is_valid_ch_hash($val)) { $name = ${$val}{'name'}; # this can be duplicated, like $node = ${$val}{'node'}; # engine[0], engine[1]... if ($name eq $chname) { # this is NOT a duplicate } else { # prt("$chname $name\n"); ${$val}{'name'} = $chname; # use UNIQUE name i/o 'variable' } #${$val}{"_".$name."_"} = $node; # var name -> property nodes #${$val}{"$node"} = $name; # property node -> name } else { prt("Bad?: "); foreach $key (keys %{$val}) { $val = ${$val}{$key}; prt("[$key]=$val "); } prt("\n"); pgm_exit(1,"WHAT, an INVALID chunk ref!\n"); } # ============================================= foreach $key (keys %chunkh) { $val = $chunkh{$key}; prt("[$key]=$val ") if ($dbg_pb01); } # prt("$chunk"); prt("\n") if ($dbg_pb01); $chunk = ''; $inch = 0; %chunkh = (); } elsif ($tag eq '/format') { # various special formats } elsif ($tag eq '/node') { $chnode = $txt; if (length($txt)) { if (defined ${$rnodes}{$txt}) { $nodcnt = 0; if (defined $nnodes{$txt}) { $nodcnt = $nnodes{$txt}; } $nodcnt++; $nxttxt = $txt.sprintf("%d",$nodcnt); ${$rnodes}{$nxttxt} = $chcnt; prtw("Duplicated 'node' [$txt] cnt $nxttxt $where\n"); # if ($show_duplications); $nnodes{$txt} = $nodcnt; } else { ${$rnodes}{$txt} = $chcnt; } } } elsif ($tag eq '/name') { $chname = $txt; if (length($txt)) { if ( defined ${$rnames}{$txt} ) { $namcnt = 0; if (defined $nnames{$txt}) { $namcnt = $nnames{$txt} } $namcnt++; $nxttxt = $txt.sprintf("%d",$namcnt); ${$rnames}{$nxttxt} = $chcnt; $chname = $nxttxt; # update the CHUNK (unique) name prt("Duplicated 'name' [$txt] cnt $nxttxt $where\n") if ($show_duplications); $nnames{$txt} = $namcnt; } else { ${$rnames}{$txt} = $chcnt; } } } elsif ($tag eq '/type') { $chtype = $txt; if (length($txt)) { ${$rtypes}{$txt} = $chcnt; } } } else { $type = 'open'; # closing another tag, within a chunk $chunk .= "$txt " if (length($txt)); $chunk .= "[$tag] "; #prt("[$txt] [$tag] "); $lasttag = $tag; } } else { if ($tag eq 'chunk') { $inch = 1; $chcnt++; $choff++; # BUMP OFFSET of chunk in list } } if ($tag eq 'output') { $inoutput = 1; $rnames = \%onames; $rtypes = \%otypes; $rnodes = \%onodes; #$rca = \@chunkrefso; $where = 'output'; $dir = 'o'; $choff = 0; # restart OFFSET of chunk in list } elsif ($tag eq '/output') { $inoutput = 0; $rnames = \%nnames; $rtypes = \%ntypes; $rnodes = \%nnodes; #$rca = \@nochunks; $where = 'nowhereo'; $dir = 'n'; %nnames = (); %ntypes = (); %nnodes = (); $choff = 0; } elsif ($tag eq 'input') { $ininput = 1; $rnames = \%inames; $rtypes = \%itypes; $rnodes = \%inodes; #$rca = \@chunkrefsi; $where = 'input'; $dir = 'i'; $choff = 0; # restart OFFSET of chunk in list } elsif ($tag eq '/input') { $ininput = 0; $rnames = \%nnames; $rtypes = \%ntypes; $rnodes = \%nnodes; #$rca = \@nochunks; $where = 'nowherei'; $dir = 'n'; %nnames = (); %ntypes = (); %nnodes = (); $choff = 0; } $intag = 0; $tag = ''; $txt = ''; } else { $tag .= $ch; } } else { if ($ch eq '<') { $intag = 1; $tag = ''; } else { $txt .= $ch; } } } # process the line $txt .= " " if (length($txt) && ($txt =~ /\S$/)); } prt("Done $chcnt chunks...\n"); $chunks{'ONAMES'} = { %onames }; $chunks{'ONODES'} = { %onodes }; $chunks{'OTYPES'} = { %otypes }; $chunks{'INAMES'} = { %inames }; $chunks{'INODES'} = { %inodes }; $chunks{'ITYPES'} = { %itypes }; return \%chunks; } # WARNING: NF aileron o /controls/flight/aileron[0] = NOT FOUND # WARNING: NF aileron i /controls/flight/aileron = NOT FOUND sub nodes_are_equiv($$) { my ($n1,$n2) = @_; return 1 if ($n1 eq $n2); $n1 =~ s/\[0\]//; $n2 =~ s/\[0\]//; return 1 if ($n1 eq $n2); return 0; } sub prt_name_node_dir($$$$$) { my ($name,$node,$dir,$kn1,$kn2) = @_; $name .= ' ' while (length($name) < $min_name_len); $node .= ' ' while (length($node) < $min_node_len); my $len = length($previous_node); my $lstsep = 0; my ($i,$ch); for ($i = 0; $i < $len; $i++) { $ch = substr($node,$i,1); last if (substr($previous_node,$i,1) ne $ch); $lstsep = $i if ($ch eq '/'); } $previous_node = $node; if ($lstsep && $use_blanked_path) { my $tmp = ''; for ($i = 0; $i < $lstsep; $i++) { $tmp .= ' '; } $tmp .= substr($node,$lstsep); $node = $tmp; } $ch = "$kn1"; $ch .= "/$kn2" if ($kn2); prt( "$name = [$node] $dir $ch\n"); } sub show_ref_hash($) { my ($rh) = @_; # = $ref_hash my ($key,$val,$k2,$v2,$ncnt,$name,$dir,@arr,$node,$msg,$type,$len,$i,$tmp,$ch); my ($mhd,$ci,$rnh,$c2,$ky2,$di2,$fnd,$na2,$nod2); my ($knum,$kn2,$offs); my @names = qw( NAMES NODES TYPES ); # by 2 output/input my @chunkkeys = sort keys %{$rh}; my $chcnt = scalar @chunkkeys; my %onames = (); my %inames = (); my @nodes = (); my %done = (); # go through the chunks collected, and try to match # an INPUT with an OUTPUT - should 100% match! for ($ci = 0; $ci < $chcnt; $ci++) { $key = $chunkkeys[$ci]; # this is order in the file - they were grouped if ($key =~ /^(\d+)(i|o|n)$/) { $knum = $1; $dir = $2; $rnh = ($dir eq 'i') ? \%inames : \%onames; $val = ${$rh}{$key}; # if (defined ${$val}{'name'} && ${$val}{'node'} && ${$val}{'type'}) if (is_valid_ch_hash($val)) { $name = ${$val}{'name'}; # this can be duplicated, 1, 2, ...like $node = ${$val}{'node'}; # engine[0], engine[1], ... $type = ${$val}{'type'}; $offs = ${$val}{'offset'}; $fnd = 0; for ($c2 = 0; $c2 < $chcnt; $c2++) { if ($c2 != $ci) { $ky2 = $chunkkeys[$c2]; if ($ky2 =~ /^(\d+)(i|o|n)$/) { $kn2 = $1; $di2 = $2; if ($dir ne $di2) { $v2 = ${$rh}{$ky2}; if (defined ${$v2}{'name'} && ${$v2}{'node'} && ${$v2}{'type'}) { $na2 = ${$v2}{'name'}; $nod2 = ${$v2}{'node'}; if ($name eq $na2) { if (nodes_are_equiv($node,$nod2)) { $fnd = 1; ${$v2}{'_IO_'} = $key; # exchange keys ${$val}{'_IO_'} = $ky2; push(@nodes,$node); last; } } } } } } } if (!$fnd) { prtw("WARNING: NF $name ".(($dir eq 'i') ? "i" : "o")." $node = NOT FOUND\n"); } } } } %done = (); @nodes = sort @nodes; foreach $nod2 (@nodes) { for ($ci = 0; $ci < $chcnt; $ci++) { $key = $chunkkeys[$ci]; # this is order in the file - they were grouped if ($key =~ /^(\d+)(i|o|n)$/) { $knum = $1; $dir = $2; $val = ${$rh}{$key}; next if ($done{$key}); # if (defined ${$val}{'name'} && ${$val}{'node'} && ${$val}{'type'}) if (is_valid_ch_hash($val)) { $name = ${$val}{'name'}; # this can be duplicated, 1, 2, ...like $node = ${$val}{'node'}; # engine[0], engine[1], ... $type = ${$val}{'type'}; $offs = ${$val}{'offset'}; if ($node eq $nod2) { if (defined ${$val}{'_IO_'}) { $ky2 = ${$val}{'_IO_'}; $kn2 = substr($ky2,0,(length($ky2)-1)); $done{$ky2} = 1; # mark this as DONE $done{$key} = 1; $dir = "i/o"; prt_name_node_dir($name,$node,$dir,$knum,$kn2); } } } } } } # foreach $key (sort keys %{$rh}) - pre-sorted the list for ($ci = 0; $ci < $chcnt; $ci++) { $key = $chunkkeys[$ci]; # this is order in the file - they were grouped if ($key =~ /^(\d+)(i|o|n)$/) { $knum = $1; $dir = $2; $val = ${$rh}{$key}; next if ($done{$key}); $done{$key} = 1; $tmp = substr($key,0,(length($key) - 1)); $len = length($tmp); $msg = ''; # start output $mhd = $dir; for ($i = 0; $i < $len; $i++) { $ch = substr($tmp,$i,1); last if ($ch ne '0'); #$msg .= ' '; $mhd .= '_'; } for (; $i < $len; $i++) { $ch = substr($tmp,$i,1); $mhd .= $ch; } $mhd .= "_"; # header, making it unique # if (defined ${$val}{'name'} && ${$val}{'node'} && ${$val}{'type'}) { if (is_valid_ch_hash($val)) { $name = ${$val}{'name'}; $node = ${$val}{'node'}; $type = ${$val}{'type'}; $name =~ s/-/_/g; $kn2 = 0; if (defined ${$val}{'_IO_'}) { $ky2 = ${$val}{'_IO_'}; $kn2 = substr($ky2,0,(length($ky2)-1)); $done{$ky2} = 1; # mark this as DONE $dir = "i/o"; } prt_name_node_dir($name,$node,$dir,$knum,$kn2); # $msg .= $type."_"; $name .= ' ' while (length($name) < $min_name_len); $node .= ' ' while (length($node) < $min_node_len); $msg .= $name." = [$node]"; } else { $msg .= $mhd; foreach $k2 (sort keys %{$val}) { $v2 = ${$val}{$k2}; $msg .= "$k2 $v2, "; } $msg .= $dir; prt("$msg\n"); } # prt("$msg $dir\n"); } else { # other keys } } # just show the COUNTS # ==================== $msg = ''; foreach $name (@names) { $key = 'O'.$name; if (defined ${$rh}{$key}) { $val = ${$rh}{$key}; $ncnt = scalar keys(%{$val}); $msg .= "$key $ncnt "; } $key = 'I'.$name; if (defined ${$rh}{$key}) { $val = ${$rh}{$key}; $ncnt = scalar keys(%{$val}); $msg .= "$key $ncnt "; } } prt("$msg\n") if (length($msg)); # ==================== if ($list_node_set) { $name = "NODES"; $key = 'O'.$name; $msg = ''; if (defined ${$rh}{$key}) { $val = ${$rh}{$key}; @arr = sort keys(%{$val}); $v2 = ''; foreach $node (@arr) { $msg .= "$node\n"; } } prt("$msg\n") if (length($msg)); } } # given an offset, find the chunk ref hash # of course, will only find the first, if more than one sub find_chunk_obj_by_off($$$) { my ($rh,$i2,$rval) = @_; my ($key,$val,$off); foreach $key (keys %{$rh}) { $val = ${$rh}{$key}; if (defined ${$val}{'offset'}) { $off = ${$val}{'offset'}; if ($off == $i2) { ${$rval} = $val; # pass back the chunk hash - name, path, etc... return 1; } } } return 0; } # given a name, find the chunk ref hash sub find_chunk_by_name($$$) { my ($rh,$name,$rval) = @_; my ($key,$val,$n2); foreach $key (keys %{$rh}) { $val = ${$rh}{$key}; if (defined ${$val}{'name'}) { $n2 = ${$val}{'name'}; if ($n2 eq $name) { ${$rval} = $val; # pass back the chunk hash - name, path, etc... return 1; } } } return 0; } my %missed_names = (); sub get_item_val_by_name($$$$$) { my ($rh,$cols,$rcurr,$name,$rval) = @_; my ($val,$off); if (find_chunk_by_name($rh,$name,\$val)) { if (is_valid_ch_hash($val)) { # is valid $off = ${$val}{'offset'} - 1; # OFFSET ${$rval} = ${$rcurr}[$off]; return 1; } else { if (!defined $missed_names{$name}) { $missed_names{$name} = 1; prtw("WARNING: Failed finding [$name]\n"); } } } else { if (!defined $missed_names{$name}) { $missed_names{$name} = 1; prtw("WARNING: Missed finding [$name]\n"); } } return 0; } my %ch_name2offset = (); my $g_shwn_roll = -1; my $g_shwn_pitch = -1; sub get_latlonalt($$$$$$) { my ($rh,$cols,$rcurr,$rlat,$rlon,$ralt) = @_; my $name1 = 'latitude-deg'; my $name2 = 'longitude-deg'; my $name3 = 'altitude-ft'; my $rn2off = \%ch_name2offset; my $ok = 0; my ($off1,$off2,$off3,$val1,$val2,$val3); if (defined ${$rn2off}{$name1} && defined ${$rn2off}{$name2} && defined ${$rn2off}{$name3} ) { $off1 = ${$rn2off}{$name1}; $off2 = ${$rn2off}{$name2}; $off3 = ${$rn2off}{$name3}; $ok = 1; $g_used_of_cache++; } elsif ( find_chunk_by_name($rh,$name1,\$val1) && find_chunk_by_name($rh,$name2,\$val2) && find_chunk_by_name($rh,$name3,\$val3) ) { # we have hash refs to check if (is_valid_ch_hash($val1) && is_valid_ch_hash($val2) && is_valid_ch_hash($val3) ) { # they are valid $off1 = ${$val1}{'offset'} - 1; # OFFSET $off2 = ${$val2}{'offset'} - 1; $off3 = ${$val3}{'offset'} - 1; # we have offsets to check if (($off1 >= 0) && ($off1 < $cols) && ($off2 >= 0) && ($off2 < $cols) && ($off3 >= 0) && ($off3 < $cols) ) { $ok = 1; # offsets within range ${$rn2off}{$name1} = $off1; ${$rn2off}{$name2} = $off2; ${$rn2off}{$name3} = $off3; } } } if ($ok) { ${$rlat} = ${$rcurr}[$off1]; ${$rlon} = ${$rcurr}[$off2]; ${$ralt} = ${$rcurr}[$off3]; } return $ok; } sub get_latlonalt_msg($$$) { my ($rh,$cols,$rcurr) = @_; my ($lat,$lon,$alt,$msg); $msg = ''; if (get_latlonalt($rh,$cols,$rcurr,\$lat,\$lon,\$alt)) { my $factor = 1000; my ($latm,$lonm,$altm); # $lat = ${$rcurr}[$off1]; # $lon = ${$rcurr}[$off2]; # $alt = ${$rcurr}[$off3]; # $msg = "$off1:lat $lat $off2:lon $lon $off3:alt $alt"; $latm = $lat * $factor; $latm = ($latm < 0.0) ? int($latm - 0.5) : int($latm + 0.5); $latm = $latm / $factor; $latm = " $latm" while (length($latm) < 7); $latm = "lat $latm "; $lonm = $lon * $factor; $lonm = ($lonm < 0.0) ? int($lonm - 0.5) : int($lonm + 0.5); $lonm = $lonm / $factor; $lonm = " $lonm" while (length($lonm) < 8); $lonm = "lon $lonm "; if ($alt < -9990) { $altm = 'N/A'; } else { if ($alt < 0) { $alt = int($alt - 0.5); } else { $alt = int($alt + 0.5); } $altm = "$alt"; } $altm = " $altm" while (length($altm) < 5); $altm = "alt $altm "; $msg = "$latm $lonm $altm "; } return $msg; } my $blank_hdg_msgs = 0; #heading-deg = [/orientation/heading-deg ] i/o 00054/00131 #pitch-deg = [ /pitch-deg ] i/o 00053/00130 #roll-deg = [ /roll-deg ] i/o 00052/00129 sub compare_hdgpitchroll($$$$$) { my ($rh,$cols,$rfirst,$rlast,$rcurr) = @_; my ($i,$msg,$v1,$v2,$i2); my ($val1,$val2,$val3,$name1,$name2,$name3); my ($off1,$off2,$off3,$latc,$latp,$lonc,$lonp,$altc,$altp,$ok); my ($latm,$lonm,$tmp,$len,$altm); my $rn2off = \%ch_name2offset; $msg = ''; $name1 = 'heading-deg'; $name2 = 'pitch-deg'; $name3 = 'roll-deg'; $ok = 0; if (defined ${$rn2off}{$name1} && defined ${$rn2off}{$name2} && defined ${$rn2off}{$name3} ) { $off1 = ${$rn2off}{$name1}; $off2 = ${$rn2off}{$name2}; $off3 = ${$rn2off}{$name3}; $ok = 1; $g_used_of_cache++; } elsif ( find_chunk_by_name($rh,$name1,\$val1) && find_chunk_by_name($rh,$name2,\$val2) && find_chunk_by_name($rh,$name3,\$val3) ) { # we have hash refs to check if (is_valid_ch_hash($val1) && is_valid_ch_hash($val2) && is_valid_ch_hash($val3) ) { # they are valid #$name1 = ${$val1}{'name'}; # get NAME #$name2 = ${$val2}{'name'}; #$name3 = ${$val3}{'name'}; $off1 = ${$val1}{'offset'} - 1; # OFFSET $off2 = ${$val2}{'offset'} - 1; $off3 = ${$val3}{'offset'} - 1; # we have offsets to check if (($off1 >= 0) && ($off1 < $cols) && ($off2 >= 0) && ($off2 < $cols) && ($off3 >= 0) && ($off3 < $cols) ) { $ok = 1; # offsets within range ${$rn2off}{$name1} = $off1; ${$rn2off}{$name2} = $off2; ${$rn2off}{$name3} = $off3; } } else { pgm_exit(1,"ERROR: Have an INVALID ref chunk hash for [$name1] or [$name2] or [$name3] chunks...\n"); } } else { pgm_exit(1,"ERROR: No find of [$name1] or [$name2] chunks...\n"); } if ($ok) { $ok = 0; # hdg $latc = ${$rcurr}[$off1]; # compare current $latp = ${$rlast}[$off1]; # with previous # pitch $lonc = ${$rcurr}[$off2]; $lonp = ${$rlast}[$off2]; # roll $altc = ${$rcurr}[$off3]; $altp = ${$rlast}[$off3]; # get the text to display # heading $latm = int($latc + 0.5); $latm = ($latm < 10) ? " $latm" : ($latm < 100) ? " $latm" : $latm; if (($blank_hdg_msgs > 20) || (abs($latc - $latp) > 1.0)) { # $SG_EPSILON $ok++; # changed #$latm = "$off1:hdg $latm "; $latm = "hdg $latm "; $blank_hdg_msgs = 0; } else { #$tmp = "$off1:$name1 - $latc "; #$tmp = "$off1:hdg $latm "; $tmp = "hdg $latm "; $len = length($tmp); $latm = ' ' x $len; $blank_hdg_msgs++; } # pitch # $lonc = ${$rcurr}[$off2]; # $lonp = ${$rlast}[$off2]; if ($lonc < 0.0) { $lonm = int($lonc - 0.5); } else { $lonm = int($lonc + 0.5); } $lonm = " $lonm" while (length($lonm) < 3); if (abs($lonc - $lonp) > 0.5) { # $SG_EPSILON $ok++; # changed #$lonm = "$off2:$name2 - $lonc "; #$lonm = "$off2:pitch $lonm "; $lonm = "pitch $lonm "; $g_shwn_pitch = $lonc; } elsif (abs($lonc - $g_shwn_pitch) > 0.5) { $ok++; # changed #$lonm = "$off2:pitch $lonm "; $lonm = "pitch $lonm "; $g_shwn_pitch = $lonc; } else { #$tmp = "$off2:$name2 - $lonc "; #$tmp = "$off2:pitch $lonm "; $tmp = "pitch $lonm "; $len = length($tmp); $lonm = ' ' x $len; } # roll # $altc = ${$rcurr}[$off3]; # $altp = ${$rlast}[$off3]; if ($altc < 0.0) { $altm = int($altc - 0.5); } else { $altm = int($altc + 0.5); } $altm = " $altm" while (length($altm) < 3); if (abs($altc - $altp) > 0.5) { # $SG_EPSILON $g_shwn_roll = $altc; $ok++; #$altm = "$off3:roll $altm "; $altm = "roll $altm "; } elsif (abs($altc - $g_shwn_roll) > 0.5) { $g_shwn_roll = $altc; $ok++; #$altm = "$off3:roll $altm "; $altm = "roll $altm "; } else { #$tmp = "$off3:roll $altm "; $tmp = "roll $altm "; $len = length($tmp); $altm = ' ' x $len; } $tmp = "$latm $lonm $altm "; if ($ok) { $msg = $tmp; } else { $len = length($tmp); $msg = '.' x $len; } } return $msg; } #latitude-deg = [ /latitude-deg ] i/o 00049/00126 #longitude-deg = [ /longitude-deg ] i/o 00050/00127 sub compare_latlonalt($$$$$) { my ($rh,$cols,$rfirst,$rlast,$rcurr) = @_; my ($i,$msg,$v1,$v2,$i2); my ($val1,$val2,$val3,$name1,$name2,$name3); my ($off1,$off2,$off3,$latc,$latp,$lonc,$lonp,$altc,$altp,$ok); my ($latm,$lonm,$tmp,$len,$altm); my $rn2off = \%ch_name2offset; my $factor = 1000; $msg = ''; $name1 = 'latitude-deg'; $name2 = 'longitude-deg'; $name3 = 'altitude-ft'; $ok = 0; if (defined ${$rn2off}{$name1} && defined ${$rn2off}{$name2} && defined ${$rn2off}{$name3} ) { $off1 = ${$rn2off}{$name1}; $off2 = ${$rn2off}{$name2}; $off3 = ${$rn2off}{$name3}; $ok = 1; $g_used_of_cache++; } elsif ( find_chunk_by_name($rh,$name1,\$val1) && find_chunk_by_name($rh,$name2,\$val2) && find_chunk_by_name($rh,$name3,\$val3) ) { # we have hash refs to check if (is_valid_ch_hash($val1) && is_valid_ch_hash($val2) && is_valid_ch_hash($val3) ) { # they are valid #$name1 = ${$val1}{'name'}; # get NAME #$name2 = ${$val2}{'name'}; #$name3 = ${$val3}{'name'}; $off1 = ${$val1}{'offset'} - 1; # OFFSET $off2 = ${$val2}{'offset'} - 1; $off3 = ${$val3}{'offset'} - 1; # we have offsets to check if (($off1 >= 0) && ($off1 < $cols) && ($off2 >= 0) && ($off2 < $cols) && ($off3 >= 0) && ($off3 < $cols) ) { $ok = 1; # offsets within range ${$rn2off}{$name1} = $off1; ${$rn2off}{$name2} = $off2; ${$rn2off}{$name3} = $off3; } } } else { pgm_exit(1,"ERROR: No find of [$name1] or [$name2] chunks...\n"); } if ($ok) { $ok = 0; # latitude $latc = ${$rcurr}[$off1]; # compare current $latp = ${$rlast}[$off1]; # with previous # longitude $lonc = ${$rcurr}[$off2]; $lonp = ${$rlast}[$off2]; # altitude $altc = ${$rcurr}[$off3]; $altp = ${$rlast}[$off3]; $latm = $latc * $factor; $latm = ($latm < 0.0) ? int($latm - 0.5) : int($latm + 0.5); $latm = $latm / $factor; $latm = " $latm" while (length($latm) < 7); if (abs($latc - $latp) > $SG_EPSILON) { $ok++; # changed #$latm = "$off1:$name1 - $latc "; #$latm = "$off1:lat $latm "; #$latm = "lat $latm "; $latm = "$latc"; } else { #$tmp = "$off1:$name1 - $latc "; #$tmp = "$off1:lat $latm "; #$tmp = "lat $latm "; $tmp = "$latc"; $len = length($tmp); $latm = ' ' x $len; } # longitude # $lonc = ${$rcurr}[$off2]; # $lonp = ${$rlast}[$off2]; $lonm = $lonc * $factor; $lonm = ($lonm < 0.0) ? int($lonm - 0.5) : int($lonm + 0.5); $lonm = $lonm / $factor; $lonm = " $lonm" while (length($lonm) < 8); if (abs($lonc - $lonp) > $SG_EPSILON) { $ok++; # changed #$lonm = "$off2:$name2 - $lonc "; #$lonm = "$off2:lon $lonm "; #$lonm = "lon $lonm "; $lonm = "$lonc"; } else { #$tmp = "$off2:$name2 - $lonc "; #$tmp = "$off2:lon $lonm "; #$tmp = "lon $lonm "; $tmp = "$lonc"; $len = length($tmp); $lonm = ' ' x $len; } ######################################################### # altitude # $altc = ${$rcurr}[$off3]; # $altp = ${$rlast}[$off3]; if ($altc < 0) { if ($altc < -9990) { $altc = int($altc - 0.5); $altm = "n/a"; } else { $altc = int($altc - 0.5); $altm = "$altc"; } } else { $altc = int($altc + 0.5); $altm = "$altc"; } $altm = " $altm" while (length($altm) < 5); if ($altp < 0) { $altp = int($altp - 0.5); } else { $altp = int($altp + 0.5); } if (abs($altc - $altp) > $SG_EPSILON) { #$altm = "$off3:alt $altm "; #$altm = "alt $altm "; #$altm = "$altm "; $altm = "$altm"; $ok++; } else { #$tmp = "$off3:alt $altm "; #$tmp = "alt $altm "; #$tmp = "$altm "; $tmp = "$altm"; $len = length($tmp); $altm = ' ' x $len; } ########################################################### $tmp = "$latm $lonm $altm"; if ($ok) { $msg = $tmp; } else { $len = length($tmp); $msg = '.' x $len; } } return $msg; } # passed the chunk ref hash, and # the first, last, and current array of variables (from the playback file) sub compare_arrays_test($$$$$) { my ($rh,$cols,$rfirst,$rlast,$rcurr) = @_; my ($i,$msg,$v1,$v2,$keyi,$keyo,$i2); my ($val,$name,$node,$type,$ok,$offs); $msg = ''; for ($i = 0; $i < $cols; $i++) { $i2 = $i + 1; $v1 = ${$rcurr}[$i]; $v2 = ${$rlast}[$i]; $keyi = sprintf("%5d",$i2); $keyo = $keyi; $keyi .= 'i'; $keyo .= 'o'; $ok = 0; if (abs($v1 - $v2) < $SG_EPSILON) { # ($v1 == $v2) # skip } else { # processing by column, get the 'chunk' object at this 'offset' if ( find_chunk_obj_by_off($rh,$i2,\$val) ) { # if (defined ${$val}{'name'} && ${$val}{'node'} && ${$val}{'type'}) if ( is_valid_ch_hash($val) ) { $name = ${$val}{'name'}; $node = ${$val}{'node'}; $type = ${$val}{'type'}; $offs = ${$val}{'offset'}; $ok = 1; } } if ($ok) { $msg .= "$i:$name $v1 ($offs)"; } else { $msg .= "$i - $v1 "; } } } # prt("$msg\n") if (length($msg)) return $msg; } # brake-left = [/controls/gear/brake-left] i/o 00026/00103 # brake-right = [/controls/gear/brake-right] i/o 00027/00104 sub get_brake_msg($$$$) { my ($rh,$cols,$rarr,$rbrmsg) = @_; my $name1 = 'brake-left'; my $name2 = 'brake-right'; my $rn2off = \%ch_name2offset; my $ok = 0; my ($off1,$off2,$val1,$val2); my $brmsg = ${$rbrmsg}; if (defined ${$rn2off}{$name1} && defined ${$rn2off}{$name2} ) { $off1 = ${$rn2off}{$name1}; $off2 = ${$rn2off}{$name2}; $ok = 1; $g_used_of_cache++; } elsif ( find_chunk_by_name($rh,$name1,\$val1) && find_chunk_by_name($rh,$name2,\$val2) ) { # we have hash refs to check if (is_valid_ch_hash($val1) && is_valid_ch_hash($val2) ) { # they are valid #$name1 = ${$val1}{'name'}; # get NAME #$name2 = ${$val2}{'name'}; $off1 = ${$val1}{'offset'} - 1; # OFFSET $off2 = ${$val2}{'offset'} - 1; # we have offsets to check if (($off1 >= 0) && ($off1 < $cols) && ($off2 >= 0) && ($off2 < $cols) ) { $ok = 1; # offsets within range ${$rn2off}{$name1} = $off1; ${$rn2off}{$name2} = $off2; } } } else { pgm_exit(1,"ERROR: No find of [$name1] or [$name2] chunks...\n"); } if ($ok) { my $b1 = ${$rarr}[$off1]; my $b2 = ${$rarr}[$off2]; if ((length($brmsg) == 0) || ($brmsg =~ /^\s+$/)) { if (($b1 > 0) || ($b2 > 0)) { $brmsg = 'B'; } else { $brmsg = ' '; } } } else { $brmsg = '?'; pgm_exit(1,"ERROR: No find of [$name1] or [$name2] chunks...2\n"); } ${$rbrmsg} = $brmsg; } sub process_flight($$) { my ($rh,$inf) = @_; if (!open INF, "<$inf") { prt("ERROR: Unable to open flight file [$inf]...\n"); return; } my @lines = ; close INF; my $lncnt = scalar @lines; my ($line,@arr,$cols,$i,$lnn,$msg,$clnn,$val,$ok,$len); my $linesfnd = 0; prt("Processing $lncnt lines, from [$inf]...\n"); my @first_arr = (); my @last_arr = (); my @max_arr = (); my @min_arr = (); $lnn = 0; my $brmsg = ''; my $thmsg = ''; my $stmsg = ''; my $hdgpr = ''; my $cthrot = 0; my $pthrot = -1; my $last_dist_msg = ''; my $tbgn = [gettimeofday]; foreach $line (@lines) { chomp $line; @arr = split(/,/,$line); $cols = scalar @arr; if ($cols >= $play_cols) { $lnn++; $clnn = sprintf("%5d",$lnn); $ok = 0; # assume not for display # prepare output messages # brake-left = [/controls/gear/brake-left] i/o 00026/00103 # brake-right = [/controls/gear/brake-right] i/o 00027/00104 get_brake_msg($rh,$cols,\@arr,\$brmsg); $ok |= 4 if ($brmsg eq 'B'); if ((length($stmsg) == 0)||($stmsg =~ /^\s+$/)) { if (get_item_val_by_name($rh,$cols,\@arr,'starter',\$val)) { if ($val > 0.0) { $stmsg = "S"; # ($val)"; $ok |= 1; } else { $stmsg = " "; # ($val)"; } } else { $stmsg = 'x'; } } if (get_item_val_by_name($rh,$cols,\@arr,'throttle',\$val)) { if ($val <= 0.0) { if (($pthrot == 0) && $linesfnd) { $thmsg = ' ' x 6; } else { $thmsg = "closed"; $pthrot = 0; } } elsif ($val >= 1.0) { if (($pthrot == 100) && $linesfnd) { $thmsg = ' ' x 6; } else { $thmsg = "full "; $pthrot = 100; } } else { # between 0 & 1 - show percentage $thmsg = int(($val * 100) + 0.5); if (($thmsg == $pthrot) && $linesfnd) { $thmsg = ' ' x 6; } else { $pthrot = $thmsg; $thmsg = "$thmsg\%"; $thmsg = " $thmsg" while (length($thmsg) < 6); } } # $thmsg = "$val"; } else { $thmsg = 'X' x 6; } if ($linesfnd) { for ($i = 0; $i < $cols; $i++) { $max_arr[$i] = $arr[$i] if ($arr[$i] > $max_arr[$i]); $min_arr[$i] = $arr[$i] if ($arr[$i] < $min_arr[$i]); } # compare, and show changes #$msg = compare_arrays_test($rh,$cols,\@first_arr,\@last_arr,\@arr); $hdgpr = compare_hdgpitchroll($rh,$cols,\@first_arr,\@last_arr,\@arr); $msg = compare_latlonalt($rh,$cols,\@first_arr,\@last_arr,\@arr); if (length($msg)) { if ($msg =~ /^\.+$/) { # no lat,lon,alt change } else { $ok |= 2; } if ($ok) { my ($res,$lat1,$lon1,$alt1,$lat2,$lon2,$alt2,$sg_az1,$sg_az2,$sg_dist); my $dmsg = ''; if (get_latlonalt($rh,$cols,\@arr,\$lat1,\$lon1,\$alt1) && get_latlonalt($rh,$cols,\@first_arr,\$lat2,\$lon2,\$alt2)) { $res = fg_geo_inverse_wgs_84 ($lat1,$lon1,$lat2,$lon2,\$sg_az1,\$sg_az2,\$sg_dist); #$dmsg = "home: on ".get_heading_stg($sg_az1)." at ".get_sg_dist_stg($sg_dist); $dmsg = "bgn: ".get_heading_stg($sg_az1)." at ".get_sg_dist_stg($sg_dist); if ($sg_dist < 200) { $len = length($dmsg); $dmsg = "at home (<200m)"; $dmsg .= ' ' while (length($dmsg) < $len); } if ($last_dist_msg eq $dmsg) { $len = length($dmsg); $dmsg = ' ' x $len; } else { $last_dist_msg = $dmsg; } } prt("$clnn: $msg ${stmsg}${brmsg} $thmsg $hdgpr $dmsg\n"); # clear EVENT values after a display of it... $stmsg = ''; $brmsg = ''; } } } else { @first_arr = @arr; @min_arr = @arr; @max_arr = @arr; prt("First with $cols columns...\n"); $msg = get_latlonalt_msg($rh,$cols,\@arr); prt("$clnn: $msg $stmsg $thmsg\n") if (length($msg)); } @last_arr = @arr; $linesfnd++; } else { pgm_exit(1,"WHAT IS THIS [$line]\n"); } } # end of scan of lines from 'playback' file # ========================================= my $elap = tv_interval( $tbgn, [gettimeofday] ); my $htz = $lncnt / $elap; if ($htz > 1000) { $htz = int(($htz / 1000) * 10) / 10; $htz .= "K"; } prt("Done $lncnt lines, at ${htz}Hz, from [$inf]\n"); if ($linesfnd) { my $ramin = \@min_arr; my $ramax = \@max_arr; # DO MAX INFO LIST $brmsg = ''; $pthrot = -1; get_brake_msg($rh,$cols,$ramax,\$brmsg); if (get_item_val_by_name($rh,$cols,$ramax,'starter',\$val)) { if ($val > 0.0) { $stmsg = "S"; # ($val)"; } else { $stmsg = " "; # ($val)"; } } else { $stmsg = 'x'; } if (get_item_val_by_name($rh,$cols,$ramax,'throttle',\$val)) { if ($val <= 0.0) { if (($pthrot == 0) && $linesfnd) { $thmsg = ' ' x 6; } else { $thmsg = "closed"; $pthrot = 0; } } elsif ($val >= 1.0) { if (($pthrot == 100) && $linesfnd) { $thmsg = ' ' x 6; } else { $thmsg = "full "; $pthrot = 100; } } else { # between 0 & 1 - show percentage $thmsg = int(($val * 100) + 0.5); if (($thmsg == $pthrot) && $linesfnd) { $thmsg = ' ' x 6; } else { $pthrot = $thmsg; $thmsg = "$thmsg\%"; $thmsg = " $thmsg" while (length($thmsg) < 6); } } # $thmsg = "$val"; } else { $thmsg = 'X' x 6; } $hdgpr = compare_hdgpitchroll($rh,$cols,\@first_arr,$ramin,$ramax); $msg = compare_latlonalt($rh,$cols,\@first_arr,$ramin,$ramax); prt("max : $msg ${stmsg}${brmsg} $thmsg $hdgpr\n"); # DO MIN INFO LIST $brmsg = ''; $pthrot = -1; get_brake_msg($rh,$cols,$ramin,\$brmsg); if (get_item_val_by_name($rh,$cols,$ramin,'starter',\$val)) { if ($val > 0.0) { $stmsg = "S"; # ($val)"; } else { $stmsg = " "; # ($val)"; } } else { $stmsg = 'x'; } if (get_item_val_by_name($rh,$cols,$ramin,'throttle',\$val)) { if ($val <= 0.0) { if (($pthrot == 0) && $linesfnd) { $thmsg = ' ' x 6; } else { $thmsg = "closed"; $pthrot = 0; } } elsif ($val >= 1.0) { if (($pthrot == 100) && $linesfnd) { $thmsg = ' ' x 6; } else { $thmsg = "full "; $pthrot = 100; } } else { # between 0 & 1 - show percentage $thmsg = int(($val * 100) + 0.5); if (($thmsg == $pthrot) && $linesfnd) { $thmsg = ' ' x 6; } else { $pthrot = $thmsg; $thmsg = "$thmsg\%"; $thmsg = " $thmsg" while (length($thmsg) < 6); } } # $thmsg = "$val"; } else { $thmsg = 'X' x 6; } $hdgpr = compare_hdgpitchroll($rh,$cols,\@first_arr,$ramax,$ramin); $msg = compare_latlonalt($rh,$cols,\@first_arr,$ramax,$ramin); prt("min : $msg ${stmsg}${brmsg} $thmsg $hdgpr\n"); } } ######################################### ### MAIN ### parse_args(@ARGV); prt( "$pgmname: in [$cwd]: Hello, World...\n" ); my $ref_hash = process_in_file($in_file); show_ref_hash($ref_hash); process_flight($ref_hash,$in_flight); 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"); } } # eof - template.pl