#!/usr/bin/perl
#
# NAME
#   abctr - abc transpose by interval (scale step).
#
# SYNOPSIS
#   abctr [interval] [file]..
#
# DESCRIPTION
#   Read an abc file (or passage from stdin), and  write  output  that
#   has the notes shifted by the given interval.
#
# BUGS
#   We don't do anything with accidentals, so you'll have to edit them
#   by  hand.  When I think of an elegant way to handle this, I'll add
#   it in.  If you have ideas, send them in.
#
# AUTHOR
#   John Chambers <jc@trillian.mit.edu>

$| = 1;
if ($ARGV[0] =~ /([-+]*\d+)/) {
	$interval = int($1);
	shift;
} else {
	$interval = 1;	# Default for Bb instruments.
}
@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.

line:
for $line (<>) {
	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 $i . &trkey($k) . $m . $s;
			next;
		}
		if ($line =~ s/^"([A-G])(\w*)"//) {
			$n = $1; $m = $2;
			$t = &trkey($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;
		}
		if (($hdr,$sp) = ($line =~ /^([A-Z]:)(\s*)/)) {
			print $line;
			next line;
		}
		if ($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/^(\[\w:[^]]*\])//) {
			 print $1;
			 next;
		}
		if ($line =~ s'^(.)'') {
			print $1;
			next;
		}
		print "Left: \"$line\"\n" if $D>1;
	}
}

sub trnote {
	$S[$I{$_[0]} + $interval] || "$n#";
}
sub trkey {
	uc(substr(&trnote($_[0]),0,1));
}
