#!/usr/bin/perl
# tr5dump -- dump parts of a Parnass Icom IC-R5 .tr5 file into
# something readable. We mostly focus parts that Bob's program doesn't
# dump to CSV or .tk5rc So we can see our data without using the tk5
# browser.
# Copyright       : http://www.fsf.org/copyleft/gpl.html
# Author          : Dan Jacobson -- http://jidanni.org/
# Created On      : Sat Dec  2 13:07:06 2006
# Last Modified By: Dan Jacobson
# Last Modified On: Sun Feb 18 14:21:01 2007
# Update Count    : 837
use strict;
use warnings;
##use diagnostics;
open( F, "<  $ARGV[0]" ) || die("can't open datafile: $!");
my $MEM_LETTERS = 'ABCDEFGHJLNOPQRTUY';
my @RIstep      = ( .005, .00625, 1 / 120, .009 );
my @mode        = qw/NFM WFM AM/;
my @steps =
  ( .005, .00625, 1 / 120, .009, .01, .0125, .015, .02, .025, .03, .05, .1 );
my @duplex = ( " ", "-", "+" );
my @rskip = ( " ", "skip", " ", "pskip" );
my @toneflag = ( q( ), qw(t b d p) );
my @CTCSS = qw{ 67.0 69.3 71.9 74.4 77.0 79.7 82.5 85.4 88.5 91.5 94.8
  97.4 100.0 103.5 107.2 110.9 114.8 118.8 123.0 127.3 131.8 136.5
  141.3 146.2 151.4 156.7 159.8 162.2 165.5 167.9 171.3 173.8 177.3
  179.9 183.5 186.2 189.9 192.8 196.6 199.5 203.5 206.5 210.7 218.1
  225.7 229.1 233.6 241.8 250.3 254.1};
my @DCS = qw{ 023 025 026 031 032 036 043 047 051 053 054 065 071 072
  073 074 114 115 116 122 125 131 132 134 143 145 152 155 156 162 165
  172 174 205 212 223 225 226 243 244 245 246 251 252 255 261 263 265
  266 271 274 306 311 315 325 331 332 343 346 351 356 364 365 371 411
  412 413 423 431 432 445 446 452 454 455 462 464 465 466 503 506 516
  523 526 532 546 565 606 612 624 627 631 632 654 662 664 703 712 723
  731 732 734 743 754};

sub tv {
    for ( 0 .. (shift) - 1 ) {
        my $l;
        read( F, $l, 8 );
        my @a = unpack( "CA3A4", $l );
        printf "TV%02d,%-3s,%07.03f,%-4s\n", $_ + 1    #to match Parnass
          , $a[0] - 1 ? "AM" : "WFM",
          0.005 * vec( "\0" . ( reverse $a[1] |= "\0" x 3 ), 0, 32 ), $a[2];
    }
}

sub tvc {
    for (qw/invalid skip/) {
        my $control;
        read( F, $control, 10 );
        printf "TV %-7s: %0v8b\n", $_, $control;
    }
}

sub mem16 {
    my @ret;
    for ( 0 .. (shift) - 1 ) {
        my $bytes;
        read( F, $bytes, 16 );
        my $tmp = unpack( "b*", $bytes );
        my @f =
##bytes:           012       3         45  6  7    8
          unpack( "A18A2A2A2 A2A2A2A2  A16 A8 A6AA A4A4", $tmp );
##array index:     0  1 2 3  4 5 6 7   8   9  1012 1314
        for (@f) { $_ = oct( "0b" . reverse ) }
        next unless $f[0];
        my $label = substr( unpack( "B*", $bytes ), -36, 36 );
        $label =~ s/.{6}/chr 32+eval "0b".$&/ge;
        $label =~ tr/.:=/,|-/;
        push @ret, join(
            ",",
            ( sprintf " %03d", $_ ),    ##Mem
            ( sprintf "%010.5f", $f[0] * $RIstep[ $f[2] ] ),    ##MHz
            ( sprintf "%3s",     $mode[ $f[5] ] ),              ##Mod
            ( sprintf "%4s",     $steps[ $f[14] ] * 1000 ),     ##Step
            ( sprintf "%09.5f",  $f[8] * $RIstep[ $f[2] ] ),    ##Offset
            $duplex[ $f[4] ],
            $toneflag[ $f[6] ],
            ( sprintf "%5.1f", $CTCSS[ $f[9] ] ),
            $DCS[ $f[10] ],
            $f[11] ? "r" : "n",                                 ##polarity
            "SKIP?,BANK,CH",                                    ##later
            $label
        ) . "\n";
    }
    return @ret;
}

sub memory2bytes {
    for ( 0 .. (shift) - 1 ) {
        my $l;
        read( F, $l, 2 );
        my @a = unpack( "CC", $l );
        printf "%03d,%5s,%s%02d\n", $_, $rskip[ $a[0] >> 5 ],
          substr( $MEM_LETTERS, $a[0] & 0b11111, 1 ), $a[1]
          unless $a[1] == 0xFF;
    }
}

sub banknames {
    for ( 0 .. (shift) - 1 ) {
        my $l;
        read( F, $l, 6 );
        print substr( $MEM_LETTERS, $_, 1 ), ",$l\n" if $l =~ /\w/;
    }
}

print
  "#Mem,       MHz,Mod,Step,Offset   ,+,t,CTCSS,DCS,n,Skip ,Bank,Ch,Label\n";
print mem16(1000);
print "\n";
for ( mem16(50) )          { s@\d+@sprintf "%02d%s",$&/2,$&%2?'B':'A'@e; print }
print "\n";
for ( reverse mem16(200) ) { s@ \d+@sprintf "R%03d",200-$&@e;            print }
print "\n";
tv(70);
print "\n";
memory2bytes(1000);
print "\n";
memory2bytes(50);
seek( F, 22720, 0 );
tvc();
seek( F, 23056, 0 );
print "\n";
banknames(16);
sub dummp {
    my $l;
    my $t = tell F;
    read( F, $l, $_[0] );
    printf "%0v8b\n", $l;
}

##We are not making any second passes yet to fill in the missing items,
##nor indeed have we finshed the first pass.

##Note: As of 2006, Parnass' tk5 code has many comments in it that
##refer to tk2 not tk5!