#!/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;
