#!/home/jmc/bin/perl
#
#=head1 NAME
#  abc - module for handling music in abc notation.
#
#=head1 SYNOPSIS
#  use abc;
#  $t = Tune(Xval);
#
#=head1 DESCRIPTION
#
#=head1 BUGS
#
#=head1 SEE ALSO
#
#=head1 AUTHOR
#John Chambers <jc@trillian.mit.edu>
#
#=cut

package abc;
use Carp;

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub Bar {
	local($tune,$sym) = @_;
	local($music);
	print "abc::Bar called for tune=\"$tune\" sym=\"$sym\"\n";
	if (!($music = $tune->{Music})) {
		print "abc::Bar tune doesn't yet have any music.\n" if $main::D;
		$tune->Music();
		print "abc::Bar tune should now have a Music structure.\n" if $main::D;
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub Music {
	local($tune) = @_;
	local($v);
	print "abc::Music called for tune=\"$tune\"\n" if $main::D;
	$tune->{Music} = $v = bless [];
	print "abc::Music called for tune=\"$tune\"\n" if $main::D;
	return $v;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Calculate the accidentals for a key signature.  The defaults key is C, the
# default mode is major, and the default accidental list is empty, of course.
# At present, we don't handle double sharps or flats in the signature.
@shrps = ('^f','^c','^g','^d','^A','^e','^B');
@flats = ('_B','_e','_A','_d','_G','_c','_F');
$shrps = 'CGDAEBFC';
$flags = 'CBFEADGC';
%modes = (
	'lyd' => +1,
	'ly'  => +1,
	'maj' => +0,
	'aeo' => +0,
	'ae'  => +0,
	'mix' => -1,
	'dor' => -2,
	'min' => -3,
	'mi'  => -3,
	'm'   => -3,
	'phr' => -4,
	'ph'  => -4,
);
sub Sig {
	local($key,$mode,$acc) = @_;
	local($m) = lc(substr($mode,3) || $mode);
	local($i,$n,@v);
	if      (($n = index($shrps,$key,0)) >= 0) {
	} elsif (($n = index($flats,$key,0)) >= 0) {
	} else   {$n = 0}
	print "Sig: n=$n for key \"$key\"\n" if $main::D;
	if ($i = $modes{$m}) {
		$n += $i;
		print "Sig: n=$n i=$i for mode \"$mode\"\n" if $main::D;
	}
	@v = ($n > 0) ? @shrps[0..$n-1] : @flats[0..-($n+1)];
	while ($acc) {
		if ($acc =~ s/\s*([_=^][A-Ga-g])\s*//) {
			push @v, $1;
		} else {
			print STDERR "abc::Sig: Bad char in accidental list \"$acc\"\n" if $main::D;
			$acc =~ s/^.\s*//;
		}
	}
	return join('',@v);
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Allocate a new tune and fill in it's X and type fields.
sub Tune {
	local $obj = bless {};		# New hash for abc tune object.
	$obj->{X} = @_ ? shift : '1';
	$obj->{type} = 'Tune';
	return $obj;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
return 1;