nmra decoder for readlots output

diff --git a/parport/nmra-decode.pl b/parport/nmra-decode.pl
new file mode 100755 (executable)
index 0000000..3f7c520
--- /dev/null
+++ b/parport/nmra-decode.pl
@@ -0,0 +1,177 @@
+#!/usr/bin/perl -w
+#
+# Feed this the output from readlots
+
+use strict qw(vars refs);
+use IO::Handle;
+
+#---------- bit stream decoder ----------
+
+sub found_bit ($) {
+    my ($bit) = @_;
+}
+
+#---------- interval -> bit decoder ----------
+
+our (@valuefor);
+# @valuefor[0] = value for first half of a bit
+# @valuefor[1] = value for second half of a bit
+# undef: not seen yet
+
+our ($in_bit);
+# undef: not in a bit
+# S: in a short bit
+# L: in a long bit
+
+our ($bit_phase_determined);
+
+sub interval_mapchar ($$@) {
+    # compares $len with values in @l in turn, selecting
+    # first char from $chars if it is less than $l[0],
+    # otherwise 2nd char from $chars if it is less than $l[1],
+    # etc.; $chars should be one char longer than @l is long.
+    my ($len, $chars, @l) = @_;
+    while (@l && $len >= $l[0]) {
+       shift @l;
+       $chars =~ s/^.//;
+    }
+    return substr($chars,0,1);
+}
+
+sub reset_bit_decoder () {
+    printf "-- restarting bit decoder --\n";
+    undef @valuefor;
+    undef $in_bit;
+    $bit_phase_determined= 0;
+}
+
+sub found_interval ($$$) {
+    my ($value, $minlen, $maxlen) = @_;
+    die "$value $minlen $maxlen" if $minlen > $maxlen;
+
+    my ($class, $fudge_class);
+    my (@nomlens,$min_char,$max_char,$nomlens_chars);
+    my ($bit_half, $bit_value);
+    
+    # $minlen and $maxlen are actually differences of rounded values;
+    # so there's an extra 1 us of slop in each of them (from 2x 0.5us
+    # rounding error).  Ie, real value satisfies
+    #    $minlen - 1 < $real_value < $maxlen + 1
+
+    if ($minlen > 80) {
+       $class= 'L';
+       @nomlens= qw(90 95 10000 12000);
+    } elsif ($maxlen < 80) {
+       $class= 'S';
+       @nomlens= qw(52 55 61 64);
+    } else {
+       $class= 'U'; #urgh
+       @nomlens= qw(52 55 61 64);
+    }
+    $nomlens_chars= '<-=+>';
+    $min_char= interval_mapchar($minlen-0.9, $nomlens_chars, @nomlens);
+    $max_char= interval_mapchar($maxlen+0.9, $nomlens_chars, @nomlens);
+
+    printf("%s%s%s",
+          $class, $min_char, $max_char);
+
+    if (defined $in_bit and (($class eq 'U') xor ($in_bit eq 'U'))) {
+       $fudge_class= $class.$in_bit;
+       $fudge_class =~ s/U//;
+       $class= $in_bit= $fudge_class;
+       printf("%s ",$fudge_class);
+    } else {
+       printf("  ");
+    }
+    
+    if (defined $in_bit and $in_bit ne $class) {
+       if ($bit_phase_determined) {
+           printf("E (exp'd %s)\n", $in_bit);
+           reset_bit_decoder();
+           return;
+       }
+       undef $in_bit;
+       $bit_phase_determined= 1;
+    }
+    $bit_half= !!defined $in_bit;
+    if (!exists $valuefor[$bit_half]) {
+       $valuefor[$bit_half]= $value;
+    }
+    if ($valuefor[$bit_half] ne $value) {
+       printf("E (%s, exp'd %s)\n", $bit_half ? '2nd' : '1st',
+              $valuefor[$bit_half]);
+       reset_bit_decoder();
+       return;
+    }
+
+    if ($bit_half) {
+       $bit_value= !!($class eq 'S');
+       printf "  %d  ", $bit_value;
+       found_bit($bit_value);
+       undef $in_bit;
+    } else {
+       $in_bit= $class;
+    }
+    printf "\n";
+}
+
+sub usec_from_to ($$) {
+    my ($from,$to) = @_;
+    my ($s,$u);
+    $s= $to->{S} - $from->{S};
+    $u= $to->{U} - $from->{U};
+    die "interval $s.$u secs too big" if $s < -100 or $s > 100;
+    return $s * 1000000 + $u;
+}
+
+sub scan_for_intervals() {
+    my (%interval,%now,%last);
+    # $now{V}           value at this instant
+    # $now{S}           seconds
+    # $now{U}           microseconds
+    # $now{Slop}        slop in current transition; undef = no transition here
+    # $last{V}          value at last instant               } undef =
+    # $last{S}          time of last instant (seconds)      }    before first
+    # $last{U}          time of last instant (microseconds) }    instant
+    # $last{Slop}       irrelevant
+    # $interval{V}      value in the current interval; undef = before first val
+    # $interval{S}      } start of current interval
+    # $interval{U}      }  undef = no transition found yet
+    # $interval{Slop}   }
+    my ($minlen,$maxlen);
+
+    reset_bit_decoder();
+
+    while (<STDIN>) {
+       last if STDIN->eof;
+       m/^(\d+)\.(\d+) ([0-9a-f]{2})$/ or die "$_ ?";
+
+       %now= (S => $1,
+              U => $2,
+              V => hex $3);
+
+       if (exists $interval{V} and $now{V} ne $interval{V}) {
+           # found a transition
+           $now{Slop}= usec_from_to(\%last,\%now);
+       }
+       if (defined $now{Slop} and defined $interval{S}) {
+           # found an interval
+           $minlen= usec_from_to(\%interval,\%now);
+           $maxlen= $minlen + $interval{Slop} + $now{Slop};
+           printf("\@<%10d.%06d %6d..%-6d %s ",
+                  $now{S},$now{U}, $minlen,$maxlen, $interval{V});
+           found_interval($interval{V}, $minlen, $maxlen);
+       }
+       if (defined $now{Slop}) { # found a transition ? mark it as last one
+           %interval= %now;
+       }
+       if (!defined $interval{V}) { # if right at start, simply not current V
+           $interval{V}= $now{V};
+       }
+       %last= %now;
+    }
+}
+
+scan_for_intervals();
+die $! if STDIN->error;
+die $! if STDOUT->error;