--- /dev/null
+#!/usr/bin/perl -w
+#
+# Feed this the output from readlots
+
+# Note that the interval length determination is known to be slightly
+# buggy at least under certain adverse conditions.
+
+# Output format:
+# ,value during interval
+# / ,classification chars
+# @<1105296455.621813 55..59 5e S-= 1 I112
+# ^interval ends just before \ decoded bit' `interpretation
+# `computed min and maxlength
+# Classification chars
+# S short interval
+# L long interval
+# U interval might have been short or long but we don't know
+# (interval is short iff actual length < 80)
+# followed by two chars which classify the measurement error etc.
+# first the min length is classified
+# < too short for NMRA decoder spec for interval (as classified)
+# - decoder must decode but power station may not produce, too short
+# = in spec
+# + decoder must decode but power station may not produce, too long
+# > too long for NMRA decoder spec for interval (as classified)
+# then the max length, just the same way.
+#
+# interpretations
+# Innn idle/preamble bit, number nnn
+# F <bytes>... framing bit indicates more data
+# <bytes> is those already received
+# B <bytes>(<bitno>) data bit no <bitno>
+# <bytes> includes byte under construction
+# P <bytes> packet end bit of good packet, <bytes> includes csum
+# EP (<error msg>) framing/decoding error
+
+use strict qw(vars refs);
+use IO::Handle;
+
+sub usec_from_to ($$) {
+ my ($from,$to) = @_; # uses $from->{S}, $from->{U}, $to->{S}, $to->{U}
+ 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;
+}
+
+#---------- bit stream (packet) decoder ----------
+
+our ($idle_counter, $bitnum, @bytes);
+
+sub reset_packet_decoder () {
+ $idle_counter= 0;
+}
+
+sub packet_decoder_error ($) {
+ printf "EP (%s)\n", $_[0];
+ reset_packet_decoder();
+}
+
+sub found_bit ($) {
+ my ($bit) = @_;
+ if (defined $idle_counter) {
+ if ($bit) {
+ $idle_counter++;
+ printf "I%-4d\n", $idle_counter;
+ return;
+ }
+ if ($idle_counter < 10) {
+ packet_decoder_error("I only $idle_counter");
+ return;
+ }
+ undef $idle_counter;
+ $bitnum= -1;
+ @bytes= ();
+ }
+ if ($bitnum<0) {
+ if ($bit) {
+ my ($checksum,$byte);
+ $checksum= 0;
+ foreach $byte (@bytes) {
+ $checksum ^= hex $byte;
+ }
+ if ($checksum) {
+ $checksum= sprintf '%02x', $checksum;
+ packet_decoder_error("csum err $checksum in @bytes");
+ return;
+ }
+ print "P @bytes\n";
+ $idle_counter= 0;
+ return;
+ }
+ $bitnum= 7;
+ print "F @bytes...\n";
+ push @bytes, '00';
+ return;
+ }
+ $b= hex $bytes[$#bytes];
+ $b |= ($bit << $bitnum);
+ $bytes[$#bytes]= sprintf "%02x", $b;
+ print "B @bytes($bitnum)\n";
+ $bitnum--;
+}
+
+#---------- 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;
+ reset_packet_decoder();
+}
+
+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;
+ undef @valuefor;
+ $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) {
+ undef $in_bit;
+ if ($class eq 'U') {
+ printf " E UU";
+ reset_packet_decoder();
+ return;
+ }
+ $bit_value= !!($class eq 'S');
+ printf " %d ", $bit_value;
+ found_bit($bit_value);
+ } else {
+ $in_bit= $class;
+ printf "\n";
+ }
+}
+
+#---------- interval scanner ----------
+
+our (%interval,%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} }
+
+sub found_datapoint ($$$$) {
+ # found_datapoint($s,$u,$value,$inacc) is called
+ # when we find that $value was measured at between $s.$u and $s.$u+$inacc
+ my (%now) = (S => $_[0], U => $_[1], V => $_[2]);
+ my ($inacc) = $_[3];
+ my ($minlen,$maxlen);
+
+ if (exists $interval{V} and $now{V} ne $interval{V}) {
+ # found a transition
+ $now{Slop}= usec_from_to(\%last,\%now) + $inacc;
+ }
+ if (defined $now{Slop} and defined $interval{S}) {
+ # found an interval
+ $minlen= usec_from_to(\%interval,\%now) - $now{Slop};
+ $maxlen= $minlen + $interval{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;
+}
+
+#---------- datapoint reader ----------
+
+sub read_input_file() {
+ my (%now,%last);
+
+ reset_bit_decoder();
+
+ while (<STDIN>) {
+ last if STDIN->eof;
+ m/^(\d+)\.(\d+) ([0-9a-f]{2})$/ or die "$_ ?";
+
+ %now= (S => $1,
+ U => $2,
+ V => $3);
+ if (defined $last{V}) {
+ found_datapoint($last{S}, $last{U}, $last{V},
+ usec_from_to(\%last, \%now));
+ }
+ %last= %now;
+ }
+ die $! if STDIN->error;
+}
+
+read_input_file();
+die $! if STDOUT->error;
~ijackson / trains.git / commitdiff