#!/usr/bin/perl
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#NAME
#  abctr - abc transpose by interval (scale step).
#
#SYNOPSIS
#  abctr [interval] [keys] [file]..
#
#DESCRIPTION
#  Read one or more abc files (or stdin), and write output that has the notes
#  shifted by the given interval or to the given key.
#
#  The [interval] arg, if present, is a '-' or '+' followed  by  a  a  number
#  that  is  how many scale steps to transpose.  Using this method, you can't
#  include a 'b' or '#' in the target key; this program will  pick  the  most
#  common target for that note.
#
#  The [keys] arg, if present, is a '-' or '+' followed by "K:"  and  a  key.
#  -K: gives the source key; +K: gives the target key. The source key is only
#  needed if it's not in the input.  This method lets you  specify  the  full
#  target key.
#
#OPTIONS
#  
#BUGS
#
#AUTHOR
#  John Chambers <jc@trillian.mit.edu>
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

$| = 1;
$exitstat = 0;
($P = $0) =~ s".*/"";
$V = $ENV{"V_$P"} || 2;	# Verbose level
open(V,">&STDERR");		# Verbose output defaults to STDERR
#$steps = 1;	# Scale steps for Bb instruments.
#$semis = 2;	# Semitones for Bb instruments.

args:
for $arg (@ARGV) {
	print V "% ARG $arg\n" if $V>1;
	if ($arg =~ /^([-+]*)(\d+)$/) {
		print V "% OPT $arg\n" if $V>1;
		$steps = int($arg);
		print V "% === steps=$steps\n" if $V>1;
	} elsif ($arg =~ /^([-+])K:(.*)$/) {
		print V "% OPT $arg\n" if $V>1;
		$ud = $1;
		$ks = $2;
		print V "% === $ud K: $ks\n" if $V>1;
		&trgkey($ks);
	} elsif (-f $arg) {
		print V "% FIL $arg\n" if $V>1;
		push @files, $arg;
	} else {
		print V "% ??? $arg\n" if $V>1;
	}
}
@Key2Semis = (		# Numeric values of white notes
	"Cb"=>47,
	"C" =>48,
	"C#"=>49,
	"Db"=>49,
	"D" =>50,
	"D#"=>51,
	"Eb"=>51,
	"E" =>52,
	"E#"=>53,
	"Fb"=>52,
	"F" =>53,
	"F#"=>54,
	"Gb"=>54,
	"G" =>55,
	"G#"=>56,
	"Ab"=>56,
	"A" =>57,
	"A#"=>58,
	"Bb"=>58,
	"B" =>59,
	"B#"=>60,
	"cb"=>59,
	"c" =>60,
	"c#"=>61,
	"db"=>61,
	"d" =>62,
	"d#"=>63,
	"eb"=>63,
	"e" =>64,
	"e#"=>65,
	"fb"=>64,
	"f" =>65,
	"f#"=>66,
	"gb"=>66,
	"g" =>67,
	"g#"=>68,
	"ab"=>68,
	"a" =>69,
	"a#"=>70,
	"Bb"=>70,
	"b" =>71,
	"b#"=>72,
);
@Semis2Key = (		# Numeric values of white notes
	48=>"C" ,
	49=>"C#",
	50=>"D" ,
	51=>"Eb",
	52=>"E" ,
	53=>"F" ,
	54=>"F#",
#	54=>"Gb",
	55=>"G" ,
	56=>"Ab",
	57=>"A" ,
	58=>"Bb",
	59=>"B" ,
	60=>"C" ,
);
@Nwhite = (		# Numeric values of white notes
	"C"=>48, "D"=>50, "E"=>52, "F"=>53, "G"=>55, "A"=>57, "B"=>59,
	"c"=>60, "d"=>62, "e"=>64, "f"=>65, "g"=>67, "a"=>69, "b"=>71,
);
@S = (
	"C,","D,","E,","F,","G,","A,","B,",
	"C", "D", "E", "F", "G", "A", "B",
	"c", "d", "e", "f", "g", "a", "b",
	"c'","d'","e'","f'","g'","a'","b'",
);
for ($i=0; $i<@S; $i++) {
	$I{$S[$i]} = $i;
}

$M = '[\^=_]*';			# Modification.
$N = '[A-Ga-g][\',]*';	# Note.
$L = '[/\d.\<>]*';		# Length.

for $file (@files) {
	++$files;
	if (open(FILE,$file)) {
		print V "% <<< \"$file\"\n" if $V>1;
		&onefile(*FILE);
	} else {
		print V "$P: Can't read \"$file\" ($!)\n" if $V>0;
	}
}
unless ($files) {
	&onefile(*STDIN);
}

exit $exitstat;
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

sub onefile {
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local (*F) = @_;
	local($frkey,$tokey);
line:
	for $line (<F>) {
		if ($line =~ /^[Ww]:/) {print $line; next line}
		if ($line =~ /^\s*%/) {print $line; next line}
		while ($line) {
			if ($line =~ s/^(\s+)//) {print $1}
			if ($line =~ s/^(K:\s*)(\w)(\w*)(\s*)//) {
				$i = $1; $k = $2; $m = $3; $s = $4;
				print V "% From K: $k $m\n" if $V>1;
				&srckey($k .$m);
				$tokey = &trkey($k);
				print V "% tokey=\"$tokey\"\n" if $V>2;
				print $i . $tokey . $m . $s;
				next;
			} elsif ($line =~ /^[Ww]:/) {
				next;
			} elsif ($line =~ s/^"([A-G])(\w*)"//) {
				$n = $1; $m = $2;
				$t = &trchord($n);
				$m = '' if ($m eq 'b') && ($t eq 'C' || $t eq 'F');
				$m = '' if ($m eq '#') && ($t eq 'B' || $t eq 'E');
				print '"' . $t . $m . '"';
				next;
			} elsif (($hdr,$sp) = ($line =~ /^([A-Z]:)(\s*)/)) {
				print $line;
				next line;
			} elsif ($line =~ s/^($M)($N)($L)(\s*)//) {
				 $m = $1; $n = $2;  $l = $3; $s = $4;
				 $x = $m . &trnote($n) . $l . $s;
				 $x =~  s/_([cf])/=$1/i if $m eq '_';
				 $x =~ s/\^([be])/=$1/i if $m eq '^';
				 print $x;
				 next;
			}
			if ($line =~ s'^(.)'')          {print $1; next;
			}
			print "Left: \"$line\"\n" if $D>1;
		}
	}
}

sub trnote {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	$S[$I{$_[0]} + $steps] || "$n#";
}

sub trchord { $F= 'trchord';
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#	uc(substr(&trnote($_[0]),0,1));
	local($frkey) = @_;
	local($tokey,$frsemi,$tosemi,$tomode);
	$frsemi = $Key2Semis{$frkey};
	$tosemi = $frsemi + $trsemis;
	print "%$F From \"$frsemi\" to \"$tosemi\"\n" if $V>3;
	$tokey = $Semis2Key{$tosemi};
	print "%$F From \"$frkey\" to \"$tokey\"\n" if $V>3;
	unless ($tokey) {
		$tomode = $trgMode;
		$tomode = '' if lc($tomode) eq 'major';
		$tokey = "$trgTonic$tomode$trgAcc";
		print "%$F From \"$frkey\" to \"$tokey\"\n" if $V>3;
	}
	$tokey = "$trgTonic$tomode$trgAcc" unless %tokey;
	print "%$F From \"$frkey\" to \"$tokey\"\n" if $V>3;
	return $tokey;
}

sub trkey { $F = 'trkey';
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#	uc(substr(&trnote($_[0]),0,1));
	local($frkey) = @_;
	local($tokey,$frsemi,$tosemi,$tomode);
	$frsemi = $Key2Semis{$frkey};
	$tosemi = $frsemi + $trsemis;
	print "%$F From \"$frsemi\" to \"$tosemi\"\n" if $V>2;
	$tokey = $Semis2Key{$tosemi};
	print "%$F From \"$frkey\" to \"$tokey\"\n" if $V>2;
	unless ($tokey) {
		$tomode = $trgMode;
		$tomode = '' if lc($tomode) eq 'major';
		$tokey = "$trgTonic$tomode$trgAcc";
		print "%$F From \"$frkey\" to \"$tokey\"\n" if $V>2;
	}
	return $tokey;
}

sub transdata { $F = 'transdata';
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	print V "% $F()\n" if $V>2;
	unless ($steps) {
		$steps = ord(uc $trgTonic) - ord(uc $srcTonic);
		$steps += 7 while $steps < 0;
		$steps -= 7 while $steps > 7;
		print V "% steps = $steps\n" if $V>1;
	} else {
		print V "% steps = $steps (old value used)\n" if $V>1;
	}
}

sub srckey {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Process the source key, setting various globals to indicate  the  old  key, #
# the scale and semitone intervals, and the direction on the staff.           #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($tkey) = @_;
	local($tonic,$mode,$acc);
	if ($tkey =~ s/([A-G][#b]*)\s*//i) {
		$tonic = $1;
		print V "% tonic: $tonic\n" if $V>2;
	} else {
		print V "% No tonic.\n" if $V>2;
	}
	if ($tkey =~ s/([A-Z]+)\s*//i) {
		$mode = $1;
		print V "% mode: $mode\n" if $V>2;
	} else {
		print V "% No mode.\n" if $V>2;
	}
	if ($tkey =~ s/([_=^][A-G]*)\s*//i) {
		$acc = $1;
		print V "% acc: $acc\n" if $V>2;
	} else {
		print V "% No accidentals.\n" if $V>2;
	}
	print V "% left: \"$tkey\"\n" if $V>2 && $tkey;
	$mode = 'major' unless $mode || $add;
	$srcTonic = $tonic;
	$srcMode  = $mode;
	$trgAcc   = $acc;
	print V "% Source key: $srcTonic $srcMode $srcAcc\n" if $V>2;
	&transdata() if $trgTonic;
}

sub trgkey {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Process the target key, setting various globals to indicate  the  new  key, #
# the scale and semitone intervals, and the direction on the staff.           #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($tkey) = @_;
	local($tonic,$mode,$acc);
	if ($tkey =~ s/([A-G][b^]*)\s*//i) {
		$tonic = $1;
		print V "% tonic: $tonic\n" if $V>2;
	} else {
		print V "% No tonic.\n" if $V>2;
	}
	if ($tkey =~ s/([A-Z]+[#b])\s*//i) {
		$mode = $1;
		print V "% mode: $mode\n" if $V>2;
	} else {
		print V "% No mode.\n" if $V>2;
	}
	if ($tkey =~ s/([_=^][A-G]*)\s*//i) {
		$acc = $1;
		print V "% acc: $acc\n" if $V>2;
	} else {
		print V "% No accidentals.\n" if $V>2;
	}
	$mode = 'major' unless $mode || $add;
	print V "% left: \"$tkey\"\n" if $V>2 && $tkey;
	$trgTonic = $tonic;
	$trgMode  = $mode;
	$trgAcc   = $acc;
	print V "% Target key: $trgTonic $trgMode $trgAcc\n" if $V>2;
	&transdata() if $srcTonic;
}