#!/usr/bin/perl -w

$version = "0.07";
$inExt = ".hld";
$outExt = ".tex";

# how far above the staff to put stuff
$neumeLine = "r";		# which line the neumes will be printed on
$editFlatLine = "k";	# and the line for editorial accidentals

# The modern notation for these neumes gets special treatment
$quilismae	 = "wW";		# optional notes are smaller
$liquescents = "jJpPdm";	# consonental notes are hollow

# codes for adding white space of various sorts
%spacing = ( 
  L => '\alaligne',										# bar & new line
  l => '\zalaligne',									# new line alone
  b => '\bar',											# bar alone
  s => '\sk',											# extra space
  H => '\hardspace{10mm}',								# horz. space
  V => '\endpiece\bigskip\bigskip\startpiece',			# vert. space
  );

# sharps and flats needed for transpositions
%signatures = (	
  -6 => '+2',  -5 => '+4',  -4 => '-1',  -3 => '+1',  -2 => '+3',  -1 => '+5',
   0 => ' 0',
   1 => '+2',   2 => '+4',   3 => '-1',   4 => '+1',   5 => '+3',   6 => '-5',
);

@headerStuff = (
'\input musixtex             % for the notes',
'\input musixsty             % for the titles',
'\vsize=9.7in                % adjustments for English-speaking paper',
'\voffset=.2in',
'\hoffset=-.1in',				# how to switch margins on every other sheet?
'\elemskip=.25\elemskip      % space between neumes',
'\def\sp{\off{2.5\noteskip}} % space within neumes',
'\stafftopmarg=8\Interligne  % space left for words and neumes',
'\font\neumes=neumes         % the font to use for the neumes',
'\relativeaccid              % this shifts accidentals when transposing',
'\nobarnumbers',
'\instrumentnumber{1}        % a single instrument',
'\setclef1{0}                % ...with a G clef',
		);


# Process each requested file.
foreach $file (@ARGV) 
{
	if ( substr( $file, -4 ) eq $inExt ) { 
		processFile( $file );
	}
	else { 
		print STDERR "$file is not a proper input file\n";
	}
}



sub processFile
{
	my ($inFile) = @_;
	my $outFile = substr($inFile,0,(length($inFile)-length($inExt))) . $outExt;

	# Read the input.
	open IF, "$inFile"   || die "Could not open $inFile\n";
	@input = <IF>;
	close IF;

	# Open the output file 
	open OF, ">$outFile" || die "Could not open $outFile\n";

	# Write out some comments
	print OF "% $outFile\n";
	print OF "% Generated by hld2mtex version $version\n";
	print OF "% Source: $inFile\n";
	print OF "% " . localtime() ."\n";

	# Write out the constant header information
	foreach $line (@headerStuff) {
		print OF "$line\n";
	}

	# If transposition is requested, then do it.
	setSignature( grep /^X:(.*)/, @input );

	# Write out the variable header info
	setTitle( "fulltitle",   grep /^T:/, @input );
	setTitle( "shorttitle",  grep /^T:/, @input );
	setTitle( "subtitle",    grep /^B:/, @input );
	setTitle( "fullauthor",  grep /^C:/, @input );
	setTitle( "shortauthor", grep /^C:/, @input );
	print OF "\\maketitle\n";

	# Process the body of the music
	print OF "\\startpiece\n";
	processNotes( @input );
	print OF "\\endpiece\n";

	# Write in the final lines and close the output file.
	print OF "\\end{music}\n";
	close OF;
}

sub setSignature
{
	my ( $line ) = @_;
	my $trans;

	if ( $line ) {
		chop $line;
		$trans = substr($line,2);
		if ( '+' eq substr($trans,0,1) )	{ $trans = substr($trans,1); }
	} else {
		$trans = 0;
	}

	# Save the signature globally 
	# (we need to remember it for editorial accidentals)
	$signature = $signatures{$trans};

	print OF "\\transpose=".$trans."\n";
	print OF "\\generalsignature{".$signature."}\n";
}

sub setTitle
{
	my ($titlePart, $text) = @_;
	chop($text);  print OF "\\$titlePart {" . substr($text,2) . "}\n";
}

sub processNotes
{
	my (@input) = @_;
	my $lineNumber = 0;

	foreach $line (@input) {
		$lineNumber++;

		# Don't process header lines or blank lines.
		if ( $line =~ /^[A-Z]:/  ||  $line =~ /^\s*$/ ) { next; }

		# Lines that begin with a '+' contain spacing info.
		if ( $line =~ /^\+(\w)+/ ) {
			for ( $i=0; $i<length($1); $i++ ) {

				my $code = substr( $1, $i, 1 );

				if ( exists $spacing{$code} )	{ print OF $spacing{$code} . "\n"; }
				else { errorMsg( $lineNumber, $line ); }
			}
		}

		# All other lines contain one syllable and at least one neume.
		else {
			my ( $syllable, @groups ) = split( " ", $line );

			# Print out the text of the syllable.
			# It should be left-justified if has multiple notes,
			# and centered if it only has one note.
			if		( scalar(@groups) == 0 )	{ $song = "zsong"; }
			elsif	( scalar(@groups) > 1 )		{ $song = "zsong"; }
			elsif	( length($groups[0]) > 3 )	{ $song = "zsong"; }
			else								{ $song = "csong"; }
			print OF "\\notes\\".$song."{$syllable}\n";

			foreach $group (@groups) {
				my ( $neumes, $notes );

				# A neume/pitch group is marked with a `='.
				if ( $group =~ /(.+)=(.+)/ ) {
					my $neumes = $1;
					my $notes = getPitches( $neumes, $2 );

					# Print out the neume (possibly a compound one).
					print OF "\\zcharnote $neumeLine {\\neumes $neumes }"; 

					# Print out the round notes 
					# (shifted left to line up with the neumes and text).
					print OF "\\loff{ $notes }\n"; 
				}

				# A flat is marked with an `@'.
				elsif ( $group =~ /b@(.+)/ )	{
					print OF "\\fl{".&xlatePitches($1)."}\n"; 
				}

				else {
					errorMsg( $lineNumber, $line );
				}
			}

			print OF "\\enotes\n";
		}
	}
}

# Extract and process this group's pitches.
sub getPitches 
{
	my ( $neumes, $pitches ) = @_;

	my $notes = "";
	my $isQuilisma   = 1 + index( $quilismae,   substr( $neumes, 0, 1 ) );
	my $isLiquensent = 1 + index( $liquescents, substr( $neumes, -1 ) );

	# Translate from abc pitches to musixtex pitches.
	$pitches = &xlatePitches( $pitches );

	$length = length($pitches);
	for ( $i=0; $i<$length; $i++ ) {

		# Get the next pitch 
		$pitch = substr( $pitches, $i, 1 );

		# There may be extra pitches between the two notes of a quilisma.
		if ( $isQuilisma && $i == 1 ) {
			$notes .= &processQuilisma( $pitches );
		}

		# Special case for an editorial accidental
		if ( $pitch eq "_" ) {
			if ( $signature =~ /^\+/ )	{				# signature has sharps
				$notes .= "\\upperna{$editFlatLine}";
			} else {
				$notes .= "\\upperfl{$editFlatLine}";
			}
		}
		# The last note of a liquescent is small and hollow.
		elsif ( $isLiquensent && $i == $length-1 ) {
			$notes .= "\\smallnotesize\\nh{$pitch}";
		}
		# While a normal note is solid and large.
		else {
			$notes .= "\\nq{$pitch}";
		}
		# Add space between each note in the neume.
		if ( $pitch ne "_" && $i < $length-1 ) { $notes .= "\\sp"; }
	}

	return $notes;
}

# Translate from abc pitches to musixtex pitches.
# (Hmm, how do we handle A, to G, and a' to g'?)
sub xlatePitches
{
	my ( $pitches ) = @_;

	# This correctly handles the middle two octaves
	$pitches =~ tr/A-Ga-g/a-gh-n/;

	# Now for the bottom octave (or as much as I think that we'll need).
	$pitches =~ s/g,/N/;
	$pitches =~ s/f,/M/;
	$pitches =~ s/e,/L/;

	# And the same for the top octave...
	$pitches =~ s/h'/o/;
	$pitches =~ s/i'/p/;
	$pitches =~ s/j'/q/;
	$pitches =~ s/k'/r/;

	return $pitches;
}

# Add in small optional notes between the two ends of the quilisma.
sub processQuilisma
{
	my ( $pitches ) = @_;
	my $pitch = 1 + ord( substr( $pitches, 0 ) );
	my $endPitch =  ord( substr( $pitches, 1 ) );
	my $optionalNotes = "";

	if ( $pitch == $endPitch )	{ return ""; }

	while ( $pitch < $endPitch ) {
		$optionalNotes .= "\\nq{".chr($pitch)."}\\sp";
		$pitch++;
	}

	return "{\\tinynotesize $optionalNotes }";
}

# Write an error message to stderr
sub errorMsg
{
	my ( $lineNumber, $line ) = @_;

	print STDERR "Can't figure out line $lineNumber\n  $line";
}