#!/usr/bin/perl
# tr5jcsv -- manipulate more parts of a Parnass Icom IC-R5 .tr5 file via CSV
# 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:36:20 2007
# Update Count    : 1331

#This was supposed to be a way to take a .tr5 file, and make adjustments
#outside Parnass' browser for TV and PROG00-24, but now I chickened out.

#Now only leaving enabled its viewer, (which can't see Rxxx freqs,
#whereas tr5dump can.)

#Ohmygod I entered the deepest tangle. What a mess.
#Must rely on Parnass program to the max, tangled that is too.

#I needed to set "read back commands from serial port".

#I managed to wipe out my radio back to "clear" factory reset.

#TV:Stay away from too high or low tv 01,70? values?!

#Anyway, I managed to recover part by part, and managed to squeeze my TV
#settings in. So my strategy now is: stick with the Parnass world,
#All I have to feel bad about is having to use his browser to do
#PROG00-24: not worth doing on my own.

use strict;
use warnings;
my $USAGE = "Usage:
$0 readtr5=file.tr5 writecsv=file.csv OR:
##NEVER MIND: $0 readtr5=file.tr5 readcsv=file.csv writetr5=newfile.tr5\n";
my ( $readtr5, $writetr5 );
$_ = "@ARGV";
s/readtr5=(\S+)// or die $USAGE;
open( READTR5, "< $1" ) or die "can't open $1: $!";
$readtr5 = $1;

my @MODE = qw/NFM WFM AM/;
my %MEMLETTERS;
{
    my $temp = 0;
    for ( split //, 'ABCDEFGHJLNOPQRTUY' ) { $MEMLETTERS{ $temp++ } = $_ }
}
my @RISTEP = ( .005, .00625, 1 / 120, .009 );
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};
my $EDGESSTART     = 22608;
my $BANKNAMESSTART = 23056;
my $TVBITMAPSTART  = 22720;

if (s/readcsv=(\S+)//) {
    die "Never mind writing TR5 files with this program!";
    open( READCSV, "< $1" ) or die "can't open $1: $!";
    s/writetr5=(\S+)// or die $USAGE;
    /\S/ and die "extra args, $USAGE";
    open( WRITETR5, "> $1" ) or die "can't open $1: $!";
    $writetr5 = $1;
    select WRITETR5;
    print while (<READTR5>);

    #   close READTR5;
    goto WRITETR5MODE;
}
elsif (s/writecsv=(\S+)//) {
    /\S/ and die "extra args, $USAGE";
    open( WRITECSV, "> $1" ) or die "can't open $1: $!";
    select WRITECSV;
}
else { die $USAGE }
print "#Jidanni tr5 \"bounus\" CSV format, not original Parnass'!\n",
  "#ME,       MHZ,MOD,STEP,   OFFSET,+,T,CTCSS,DCS,N, SKIP,B,CH,\"LABEL \"\n";
for ( 0 .. 49 ) {    ##PROG00A..24B
    my $l;
    seek( READTR5, $EDGESSTART + $_ * 2, 0 );
    read( READTR5, $l, 2 );
    if ( $l eq "\xFF\xFF" ) { next }
    if ( $l ne "\x1F\xFF" ) { die "$0: What happened at $_?" }
    seek( READTR5, ( 1000 + $_ ) * 16, 0 );
    printf "%02d%s,", $_ / 2, $_ % 2 ? 'B' : 'A';
    r16();
}

sub r16 {
    my $l;
    read( READTR5, $l, 16 );
    my @f =
##bytes:       012       3         45  6  7    8
      unpack( "A18A2A2A2 A2A2A2A2  A16 A8 A6AA A4A4", unpack( "b*", $l ) );
##array index: 0  1 2 3  4 5 6 7   8   9  1012 1314
    for (@f) { $_ = oct( "0b" . reverse ) }
    die "Oh no Freq == 0 at $_" unless $f[0];
    my $label = substr( unpack( "B*", $l ), -36, 36 );
    $label =~ s/.{6}/chr 32+eval "0b".$&/ge;

    #    $label =~ tr/.:/,|/;
    $label =~ tr/.:=/,|-/;    #:just looks like |...
    printf "%010.5f,", $f[0] * $RISTEP[ $f[2] ];    ##MHz
    printf "%3s,",     $MODE[ $f[5] ];              ##Mod
    printf "%4s,",     $STEPS[ $f[14] ] * 1000;     ##Step
##For PROG00..24 these fields you just can't access with
##Parnass' browser (as of 2006)! Some maybe for a reason?:
    printf "%09.5f,", $f[8] * $RISTEP[ $f[2] ];     ##Offset
    print "$DUPLEX[ $f[4] ],$TONEFLAG[ $f[6] ],";
    printf "%5.1f,", $CTCSS[ $f[9] ];
    print "$DCS[ $f[10] ],", $f[11] ? "r" : "n", ",";    ##polarity.
##These too, and their two bytes seem different than 0..999's
##Oh boy, p/skip seems to be stored at the very tail of the .tr5 file?
##Let's not mess with them.
    printf "?????,?,??,";    ##SKIP MEMLETTERS,channel number
##Yes, Parnass' browser shows LABEL, but has a ballon saying
##they aren't used by the radio... but that probably applies to the R2!
    print "\"$label\"\n";
}
seek( READTR5, $TVBITMAPSTART, 0 );    ##TV
my %tv;
for ( "invalid", "skip" ) {
    my $l;
    read( READTR5, $l, 10 );
    $tv{$_} = unpack( "b80", $l );
}
for ( 0 .. 69 ) {
    seek( READTR5, 20000 + $_ * 8, 0 );
    my $l;
    read( READTR5, $l, 8 );
    my @a = unpack( "CA3A4", $l );
    printf "t%02d,", $_ + 1;           ###+1!!! to match parnass?!?!
    if ( substr $tv{invalid}, $_, 1 ) {    ##match parnass behaviour?!?!
        printf "%010.5f,", 0;              ##MHz
    }
    else {
        printf "%010.5f,",
          0.005 * vec( "\0" . ( reverse $a[1] |= "\0" x 3 ), 0, 32 );    ##MHz
    }
    printf "%3s,", $a[0] - 1 ? "AM" : "WFM";                             ##Mod
    printf "%4s,", "";    ##Step
    printf "%9s,", "";    ##Offset
    print " , ,";         ##DUPLEX,TONEFLAG
    printf "%5s,", "";
    print "   , ,";       ##DCS, polarity
    printf "%5s,", $RSKIP[ substr $tv{skip}, $_, 1 ];
    printf " ,  ,";       ##Bank, CH
    printf "\"%4s\"\n", $a[2];    ##label
}

seek( READTR5, $BANKNAMESSTART, 0 );
for ( 0 .. 15 ) {
    my $l;
    read( READTR5, $l, 6 );
    $l =~ tr/\0/ /;               ##sure hope they are all trailing
    print "$MEMLETTERS{$_},\"$l\"\n";
}

my $R000      = 16800;
my $RMAPSTART = 22784;
seek( READTR5, $RMAPSTART, 0 );
my $rmap;
read( READTR5, $rmap, 200 );
for ( reverse unpack( "C*", $rmap ) ) {    #not jumbled, but in display order
    next if $_ == 0xff;
    seek( READTR5, $R000 + $_ * 16, 0 );
    printf "#R%03d,", $_;
    r16();
}

##Note: As of 2006, Parnass' tk5 code has many comments in it that
##refer to tk2 not tk5!
exit;
WRITETR5MODE:
require Text::CSV_XS;
my ( @tv, @edges, @banknames );
my %REVERSE_MEMLETTERS = reverse %MEMLETTERS;

my $csv = Text::CSV_XS->new;
while (<READCSV>) {
    next if /^\s*(#|$)/;    ##comments etc.
    die $csv->error_input unless ( $csv->parse($_) );
    my @field = $csv->fields;

    for ( $field[0] ) {
        if (/^t([0-7]\d)$/) {    #TV
            my $this = $1 - 1;    ##to match parnass?!?!
            $tv[$this]{freq}  = $field[1];
            $tv[$this]{mode}  = $field[2];
            $tv[$this]{skip}  = $field[10];
            $tv[$this]{label} = $field[-1];
        }
        elsif (/^[0-4]\d[AB]$/) {
            die "Gosh, PROG00A..24B totaly not implemented!";
        }
        elsif (/^[[:upper:]]$/) {    #MEMLETTERS
            for ( $REVERSE_MEMLETTERS{$_} ) {
                for ( $banknames[$_] ) {
                    $_ = $field[1];  #but what about those letters I must tr///?
                    $_ =~ s/^      $/"\0"x6/e;
                }
            }
        }
        else { die "odd location $_" }
    }
}
my ( $tvinvalid, $tvskip );
seek( READTR5, $TVBITMAPSTART, 0 );    ##TV
for ( $tvinvalid, $tvskip ) {
    my $l;
    read( READTR5, $l, 10 );
    $_ = unpack( "b80", $l );
}
close READTR5;

##There is a "fixme" in Parnass's program. Parn_... :-)
##this must mean he does not hide hide(=invalid) items from you.
##instead setting the freq to 0 seems to blank them
##OK, so we will set hide if freq=0 too.
##Or something. Mom said to write programs to thwart Alzheimers.

for ( 0 .. 69 ) {
    next unless exists $tv[$_];
    substr $tvskip, $_, 1, $tv[$_]{skip} =~ /skip/ ? 1 : 0;
    seek( WRITETR5, 20000 + $_ * 8, 0 );
    my @a = ( undef, 0 );    #to avoid vec() warning
    for ( $tv[$_]{mode} ) {
        if    (/^AM$/)  { $a[0] = 2 }
        elsif (/^WFM$/) { $a[0] = 1 }
        else            { die }
    }
    substr $tvinvalid, $_, 1, 0 if $tv[$_]{freq} > 0;
    vec( $a[1], 1, 32 ) = 200 * $tv[$_]{freq};
    $a[1] = reverse $a[1];
    $a[2] = $tv[$_]{label};
    my $l = pack( "CA3A4", @a );
    print $l;

}
seek( WRITETR5, $TVBITMAPSTART, 0 );
for ( $tvinvalid, $tvskip ) { print pack( "b80", $_ ) }
for ( 0 .. 17 ) {    #do the edges
    next unless exists $banknames[$_];
    seek( WRITETR5, $BANKNAMESSTART + $_ * 6, 0 );
    printf "%6s", $banknames[$_];
}