#!/usr/bin/perl
#
# abctrs [interval] [file]..
#
# abc transpose by (multiples of) semitones.
#
# Read an abc file (or passage from stdin), and write output that  has
# the  notes,  keys  and  chords  shifted  by the given interval.  The
# interval is in half-steps (semitones). An initial '-' meaning "down"
# and '+' means "up" (the default).
#
# This is highly experimental ...

$| = 1;
if ($ARGV[0] =~ /([-+]*)(\d+)([#b]*)/) {
	$interval = int("$1$2");
	$shorfl   = $3 || '#';	# Use sharps or flats?
	shift;
} else {
	$interval = 1;	# Default for Bb instruments.
}
@FN = ( # Note names using flats.
	"C,","_D,","D,","_E,","E,","F,","_G,","G,","_A,","A,","_B,","B,",
	"C", "_D", "D", "_E", "E", "F", "_G", "G", "_A", "A", "_B", "B",  
	"c", "_d", "d", "_e", "e", "f", "_g", "g", "_a", "a", "_b", "b",  
	"c'","_d'","d'","_e'","e'","f'","_g'","g'","_a'","a'","_b'","b'",  
);
@SN = ( # Note names using sharps.
	"C,","^C,","D,","^D,","E,","F,","^F,","G,","^G,","A,","^A,","B,",
	"C", "^C", "D", "^D", "E", "F", "^F", "G", "^G", "A", "^A", "B", 
	"c", "^c", "d", "^d", "e", "f", "^f", "g", "^g", "a", "^a", "b", 
	"c'","^c'","d'","^d'","e'","f'","^f'","g'","^g'","a'","^a'","b'",
);
@FC = ( # Chord names using flats.
	"C","Db","D","Eb","E","F","Gb","G","Ab","A","Bb","B",
);
@SC = ( # Chord names using sharps.
	"C","C#","D","D#","E","F","F#","G","G#","A","A#","B",
);
%KS = (
	'B'  => '^f#,^c#,^g#,^d#,^A#',
	'E'  => '^f#,^c#,^g#,^d#',
	'A'  => '^f#,^c#,^g#',
	'D'  => '^f#,^c#',
	'G'  => '^f#',
	'C'  => '',
	'F'  => '_Bb',
	'Bb' => '_Bb,_eb',
	'Eb' => '_Bb,_eb,_Ab',
	'Ab' => '_Bb,_eb,_Ab,_db',
	'Db' => '_Bb,_eb,_Ab,_db,_Gb',
);
for ($i=0; $i<@FN; $i++) {
	$IFN{$FN[$i]} = $i;	# Indices of flat  notes.
	$ISN{$SN[$i]} = $i;	# Indices of sharp notes.
}
for ($i=0; $i<@FC; $i++) {
	$IFC{$FC[$i]} = $i;	# Indices of flat  chords.
	$ISC{$SC[$i]} = $i;	# Indices of sharp chords.
}
for $k (keys %KS) {
	for $a (split $KS{$k}) {
	}
}

$A = '[\^=_]*';			# Accidentals (notes).
$M = '[b#]*';			# Modifications (chords, keys).
$N = '[A-Ga-g][\',]*';	# Note.
$L = '[/\d.\<>]*';		# Length.

line:
for $line (<>) {
	while ($line) {
		if ($line =~ s/^(\s+)//) {print $1}
		if ($line =~ s/^(K:\s*)($N$M)(\s*)//) {
			$i = $1; $k = $2;  $s = $3;
			print $i . &trchord($k) . $s;
			next;
		} elsif ($line =~ s/^"([A-G][b#]?)(\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/^($A)($N)($L)(\s*)//) {
			 $m = $1; $n = $2;  $l = $3; $s = $4;
			 print $m . &trnote($n) . $l . $s;
			 next;
		}
		if ($line =~ s'^(.)'')          {print $1; next;
		}
		print "Left: \"$line\"\n" if $D>1;
	}
}

sub trnote {
	local($x) = @_;
	local($i,$j,$k);
	if ($shorfl eq '#') {
		$i = $ISN{$x} || $IFN{$x};
		$j = $i + $interval;
		$k = $SN[$j];
#		$SN[$I{$_[0]} + $interval] || "${n}#";
	} else {
		$i = $IFN{$x} || $ISN{$x};
		$j = $i + $interval;
		$k = $FN[$j];
#		$FN[$I{$_[0]} + $interval] || "${n}#";
	}
	$k;
}

sub trchord {
	local($x) = @_;
	local($i,$j,$k);
#	uc(substr(&trnote($_[0]),0,1));
	if ($shorfl eq '#') {
		$i = $ISC{$x} || $IFC{$x};
		$j = $i + $interval;
		while ($j <  0) {$j += 12}
		while ($j > 11) {$j -= 12}
		$k = $SC[$j];
#		uc($SC[$ISC{$x} + $interval] || "${n}#");
	} else {
		$i = $IFC{$x} || $ISC{$x};
		$j = $i + $interval;
		while ($j <  0) {$j += 12}
		while ($j > 11) {$j -= 12}
		$k = $SC[$j];
#		uc($FC[$IFC{$x} + $interval] || "${n}b");
	}
	$k;
}