#!/usr/bin/perl
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
	if $running_under_some_shell;
				# this emulates #! processing on NIH machines.
				# (remove #! line above if indigestible)

eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_0-9]+=)(.*)/ && shift;
				# process any FOO=bar switches

open(CAT_1__2, '|cat 1>&2') || die 'Cannot pipe to "cat 1>&2".';

#!/usr/bin/gawk -f
# #Id: tune2scot,v 1.1 1992/11/13 18:30:04 putz Exp #
# sw2abc
#
# Converts SongWrite tunes found in the Digital Tradition Database to
# ABC score format (but very crudely!  some further editing is required!)
#
# Created by Steve Putz, 17 September 1992 (putz@parc.xerox.com)
#
# horrifically hacked by Steve Allen (sla@ucolick.org) 1995 June-July
#
# In the horrific hacking all of the Steve Putz neato work on handling
# multi-part tunes has been lost.  It looks like it would be straightforward
# to put it back in and generate multi-part ABC tunes in the manner used
# by the Don Ward PlayABC program.  As for the new multi-stave features
# of ABC:  I have never used them, I do not know if PlayABC can handle them,
# and thus I am not qualified to determine whether they are a better solution.
# I am currently too swamped to contribute to further development of this.
#
# Any copyrights on this belong to Steve Putz.  I merely ask to be informed
# of improved versions after they get polished--sla
########################################
$[ = 1;			# set array base to 1
$, = ' ';		# set output field separator
$\ = "\n";		# set output record separator

if ($nparts eq '') {	#???
	$nparts = 4;
}
else {
	$MaxVoice = $nparts;
}
if ($nparts < 2) {
	$nparts = 2;# avoid division by zero
	;
}
$CVoice = 0;
$pitches{'R'} = 'z';# rest
$pitches{'x'} = 'z';# unpitched/spoken note? (,,c is mostly noise)
$pitches{'X'} = 'z';# apparently another kind of rest
# apparently SongWright pitches ":" .. "@" are below A
$pitches{':'} = 'A,,';
$pitches{';'} = 'B,,';
$pitches{'<'} = 'C,';
$pitches{'='} = 'D,';
$pitches{'>'} = 'E,';
$pitches{'?'} = 'F,';
$pitches{'@'} = 'G,';
$pitches{'A'} = 'A,';
$pitches{'B'} = 'B,';
$pitches{'C'} = 'C';# middle C
$pitches{'D'} = 'D';
$pitches{'E'} = 'E';
$pitches{'F'} = 'F';
$pitches{'G'} = 'G';
$pitches{'a'} = 'A';
$pitches{'b'} = 'B';
$pitches{'c'} = 'c';
$pitches{'d'} = 'd';
$pitches{'e'} = 'e';
$pitches{'f'} = 'f';
$pitches{'g'} = 'g';
# apparently SongWright pitches "h" .. are above g
$pitches{'h'} = 'a';
$pitches{'i'} = 'b';
$pitches{'j'} = "c'";
$pitches{'k'} = "d'";
$pitches{'l'} = "e'";
$pitches{'m'} = "f'";
$pitches{'n'} = "g'";

$accidentals{'-'} = '';# none
$accidentals{'&'} = '_';# flat
$accidentals{'%'} = '=';# natural
$accidentals{'#'} = '^';# sharp
# pretend we will do everything in 16th notes
$durations{'1'} = '16';# whole
$durations{'2'} = '8';# half
$durations{'3'} = '12';# dotted half
$durations{'4'} = '4';# quarter
$durations{'5'} = '6';# dotted quarter
$durations{'6'} = '8/3';# apparently triplet quarters (6th note)
$durations{'7'} = '4/3';# apparently triplet eighths (12th note)
$durations{'8'} = '2';# eighth
$durations{'9'} = '3';# dotted eighth
$durations{'0'} = '1';# sixteenth
print '% ' . $ARGV;
print '% ABC score translated from SongWright by sw2abc';
$Title = 'Null Title';

########################################

line: while (<>) {
	chomp;	# strip record separator
	@Fld = split(' ', $_, 9999);
	########################################
	if (/^S-/) {
		# tempo
		$Tempo = substr($Fld[1], 3, 999999);
		next line;
	}
	if (/^K-/) {
		# key signature
		$KeyName = substr($Fld[1], 3, 999999);
		next line;
	}
	if (/^B-/) {
		# time signature
		$n = (@TimeSig = split(///, substr($Fld[1], 3, 999999), 9999));
		$Meter = substr($Fld[1], 3, 999999);
		$beatPerMeasure = $TimeSig[1];
		$getsOneBeat = $TimeSig[2];
		next line;
	}
	if (/^[Mm]/) {
		# music line
		# "M" (treble clef) or "m" (bass clef) melody line
		# don't know what 2nd char means (usually -, sometimes +)
		# don't know what 3rd char means (maybe time sig display info)
		if (substr($Fld[1], 1, 1) eq 'm') {
			$Bass = 1;
		} else {
			$Bass = 0;
		}
		# trim off initial [Mm][-+][0-9] leaving music
		$_ = substr($_, 4, 999999);
		$CVoice++;
		if ($CVoice > $MaxVoice) {	#???
			$MaxVoice = $CVoice;
			if ($LineCounts{1} > 1) {
			&warning('WARNING: voice ' . $CVoice . ' added after ' .

			  $LineCounts{1} . ' lines of voice 1');
			&voiceadd($CVoice,

			  '; WARNING: voice ' . $CVoice . ' added after ' .

			  $LineCounts{1} . ' lines of voice 1' . $\);
			}
		}
		$LineCounts{$CVoice} = $LineCounts{$CVoice} + 1;
		&checktime($CVoice);
		$RestLine = '';
		for ($i = 1; $i <= $#Fld; $i++) {
			$n = (@notes = split(/_/, $Fld[$i], 9999));
			for ($j = 1; $j < $n; $j++) {
			&getnote($CVoice, $notes[$j], '_');
			}
			if ($notes[$n] ne '') {
			&getnote($CVoice, $notes[$n], '');
			}
		}
		&voiceadd($CVoice, '');
		next line;
	}
	if (/^H-/) {
		# separates music systems, next will be first voice
		# H-headings (chords and other commentary above the music line)
		if (!$wrotehead) {
			&writehead();
		}
		&writesofar();
		if ($CVoice < $MaxVoice) {	#???
			# put in rests for missing staves
			for ($v = $CVoice + 1; $v <= $MaxVoice; $v++) {
			&checktime($v);
			&voiceadd($v, $RestLine);
			}
		}
		$CVoice = 0;
		print '%W: ' . substr($_, 3, 999999);
		next line;
	}
	if (/^.-$/) {
		# ignore empty fields
		next line;
	}
	if (/^N-/) {
		# N-title
		$Title = substr($_, 3, 999999);
		next line;
	}
	if (/^C-/) {
		# C-composer
		$Composer = $Composer . substr($_, 3, 999999);
		next line;
	}
	if (/^A-/) {
		# A-author
		$Author = $Author . substr($_, 3, 999999);
		next line;
	}
	if (/^T-/) {
		# T-tempo
		print '%SW tempo:' . substr($_, 3, 999999);
		next line;
	}
	if (/^[F]/) {
		# F-comment
		$Comment = $Comment . substr($_, 3, 999999);
		next line;
	}
	if (/^L-/) {
		# L-lyrics
		&writesofar();
		printf '%s%s', 'W:', substr($_, 3, 999999);
		next line;
	}
	# print everything else as a warning
	&warning('unexpected ' . $_);
	next line;

	########################################
}

&writesofar();

sub warning {
	local($message) = @_;
	print CAT_1__2 'sw2abc: ' . $ARGV . '(' . $. . '): ' . $message;
}

sub voiceadd {
	local($voice, $str) = @_;
	$VoiceBufs{$voice} = $VoiceBufs{$voice} . $str;
}

sub voiceinsert {
	local($voice, $str, $pos) = @_;
	$VoiceBufs{$voice} = substr($VoiceBufs{$voice}, 1,

	  $pos - 1) . $str . substr($VoiceBufs{$voice}, $pos, 999999);
}

sub voicepos {
	local($voice) = @_;
	length($VoiceBufs{$voice});
}

sub addbar {
	local($voice) = @_;
	&voiceadd($voice, '|');
	if ($voice lt $MaxVoice) {	#???
		$RestLine = $RestLine . '|';
	}
	$Mbeats = 0;
}

sub newkey {
	local($voice, $keyname) = @_;
	&voiceadd($voice, 'K:' . $keyname . "\n");
	$CurrKey{$voice} = $keyname;
}

sub newtime {
	local($voice, $beatsPerMeasure, $getsOneBeat) = @_;
	&voiceadd($voice,

	  'M:' . $beatsPerMeasure . '/' . $getsOneBeat . "\nL:1/16\n");
	$CurrBperM{$voice} = $beatsPerMeasure;
	$CurrMbeat{$voice} = $getsOneBeat;
}

sub checktime {
	local($voice) = @_;
	if ($CurrKey{$voice} ne $KeyName) {	#???
		# apparently: implicit return to global key for each line
		&newkey($voice, $KeyName);
	}
	if ($CurrBperM{$voice} ne $TimeSig[1] ||	#???

	  $CurrMbeat{$voice} ne $TimeSig[2]) {	#???
		# guess: implicit return to global time signature for each line
		&newtime($voice, $TimeSig[1], $TimeSig[2]);
	}
}

sub writehead {
	# write out all the info at the top of an ABC tune
	print 'X:1';# must be first.  I make every tune # 1
	print 'T:' . $Title;# must be second.
	print 'N:' . $Comment;
	print 'C:' . $Composer;
	print 'S:' . $Author;
	print 'A:';
	print 'O:';
	print 'R:';
	print 'M:' . $Meter;
	print 'K:' . $KeyName;# last in the header
	if ($Tempo ne '') {
		print 'I:speed ' . $Tempo;
	}
	$wrotehead = 1;
}

sub writesofar {
	for ($v = 1; $v <= $MaxVoice; $v++) {
		if ($LineCounts{$v} > 0) {
			printf "% voice %d (%d lines, %d notes)\n", $v, $LineCounts{$v},

			  $NoteCounts{$v};
		}
		print $VoiceBufs{$v};
		$LineCounts{$v} = 0;
		$NoteCounts{$v} = 0;
		$VoiceBufs{$v} = '';
	}
	$CVoice = 0;
}

sub getnote {
	local($voice, $note, $tie) = @_;

	# bug: wont find combined S commands if in different order then below
	if (substr($note, 1, 2) eq 'SK') {
		&newkey($voice, substr($note, 3, 2));
		$note = substr($note, 5, 999999);
	}
	if (substr($note, 1, 2) eq 'ST') {
		&voiceadd($voice, "\\\n");
		&newtime($voice, substr($note, 3, 1), substr($note, 4, 1));
		$note = substr($note, 5, 999999);
	}
	if (length($note) > 3) {
		&warning('unknown embedded-code: ' . substr($note, 1,

		  length($note) - 3));
		$note = substr($note, length($note) - 2, 999999);
	}
	if ($note eq 'S-9') {
		# fermata (apparently)
		return;
	} elsif ($note eq 'S-6') {
		# marks location of a bar (apparently)
		&addbar($voice);
		return;
	}
	# don't know what "S-1" "S-2" "S-4" "S-5" "S-8"  are
	# probably wrong about "S-6"
	# don't know what "SU" is (e.g. SUikSU!ka-8 SU!fR-2)
	# don't know what "SB" is (e.g. b-0_SB4)
	# don't know what "W-" is (e.g. W-2 W-3)
	$pit = $pitches{substr($note, 1, 1)};
	$sep = substr($note, 2, 1);
	$acc = $accidentals{$sep};
	$dur = $durations{substr($note, 3, 1)};
	if ($pit eq '') {
		&warning('unknown code: ' . $note);
	} elsif ($sep ne '-' && $acc eq '') {
		&warning('unknown accidental: ' . $note);
	} elsif ($dur eq '') {	#???
		&warning('unknown duration: ' . $note);
	} else {
		if ($dur eq '1') {	#???
			$odur = '';
		} else {
			$odur = $dur;
		}
		if ($tie eq '_') {
			$tie = '';
		} else {
			$tie = ' ';
		}
		$acc = $accidentals{$sep};
		if ($acc eq '' && $sep ne '-') {
			&warning('unknown accidental: ' . $note);
		}
		&voiceadd($voice, $acc . $pit . $odur . $tie);
		if ($voice lt $MaxVoice) {	#???
			$RestLine = $RestLine . ' ' . $dur . 'r';
		}
		$bea = $dur / $getsOneBeat;
		$Mbeats += $bea;
		if ($Mbeats >= $CurrBperM{$voice}) {	#???
			&addbar($voice);
		}
		$NoteCounts{$voice} = $NoteCounts{$voice} + 1;
	}
}