#!/usr/bin/perl
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#DESCRIPTION
#  abcjoin - combine ABC files
#
#SYNOPSIS
#  abcjoin file...
#
#DESCRIPTION
#  Join a list of ABC files into a single file.  The tunes will be  separated
#  by  a  blank  line,  and will be numbered consecutively if they don't have
#  distinct X: index numbers already.
#
#  The result is written to standard output.
#
#OPTIONS
#
# +C Capitalize first letter of titles.
#    This is because it's common for articles to be lower case, to  help  the
#    software exclude articles from alphabetization.
#
# +F
#    Include a "% <filename>" line for each file, showing the file name
#
# +H<name>
#   Incorporate the header file <name>. If it exists, we will read it in, and
#   we will also convert T: titles to a P: header line.  This places the tune
#   names at the left, with the title from the header file centered at top.
#    
# +R
# +R<N>
#   Renumber the tunes.
#   The tunes will be renumbered consecutively, starting from X:<N>,  or  X:1
#   if  no starting index is given.  The default is -R, which also renumbers,
#   but only when the input X: indexes aren't increasing.  So  if  the  input
#   tunes  are  already  numbered  in  increasing order, the default will use
#   their numbers.
#
# +S<N>
#     Generate <N> separator lines.
#     This is done with the abc2ps %%sep directive. At present, there
#     is no way to specify the parameters.  The default <N> is 1.
#
# -W
# -w
#    These control whether W: and w: lines are included in the output.
#    By default, both are true, and everything in included.
#
#BUGS
#  The output X: numbers will be distinct.  This is a feature.
#
#  We never read from standard input.  Maybe we should add an  option
#  to do this.
#
#AUTHOR
#  John Chambers <jc@trillian.mit.edu> http://trillian.mit.edu/~jc/
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

$| = 1;
($P = $0) =~ s".*/"";
$V = $ENV{"V_$P"} || 1;

$Xlast = -1;	# Last index written
$Xnext =  0;	# Next index to write

$cont = 0;		# Previous line continued

# Default values of options:
$renum  = 0;	# Renumber the tunes
$wout = 1;		# Output w: lines
$Wout = 1;		# Output W: lines

for $f (@ARGV) {
	&outtune("#$P: arg='$f'") if $V>3;
	if (($flg,$opts) = ($f =~ /^([-+])(.*)/i)) {
		&outtune("#$P: flg=$flg' opts='$opts'") if $V>2;
		while ($opts =~ s/^(.)//) {
			$OPT = uc($opt = $1);
			&outtune("#$P: OPT='$OPT' opt='$opt'") if $V>2;
			if ($OPT eq 'C') {
				$UCT = ($flg eq '+') ? 1 : 0;		# Upper-case first letter of title
				&outtune("#$P: UCT=$UCT.") if $V>1;
			} elsif ($OPT eq 'F') {
				$showfile = ($flg eq '+') ? 1 : 0;		# Upper-case first letter of title
				&outtune("#$P: showfile=$showfile.") if $V>1;
			} elsif ($OPT eq 'S') {
				if ($opts =~ s/^(\d+)//) {
					$sep = ($flg eq '+') ? $1 : 0;		# Generate several separators
				} else {
					$sep = ($flg eq '+') ? 1 : 0;		# Generate separators
				}
				&outtune("#$P: sep=$sep.") if $V>1;
			} elsif ($OPT eq 'H') {
				$hopt = ($flg eq '-') ? 0 : 1;		# Look for header file
				&outtune("#$P: hopt=$hopt.") if $V>2;
				if (open(F,$h = $opts)				# Explicit header file?
				||  open(F,$h = "hdr/$opts")		# Is full name in hdr directory?
				||  open(F,$h = "hdr/$opts.hdr")	# Is fils in hdr directory with .hdr suffix?
				||  open(F,$h = "$opts.hdr")) {		# Is it named without a suffix?
					$hfile = 1;		# Produces T: -> P: header conversion
					&onefile($h);	# Copy it to output
					$hfile = 0;
					$opts = '';
				} else {
					print STDERR "#$P: Can't read \"$opts\" ($!)\n" if $V>1;
				}
			} elsif ($OPT eq 'N' || $OPT eq 'R') {
				$opts =~ s/^(\d*)//;				# Look for starting index number
				$Xnext = ($1 ne '') ? $1 : 1;		# Set next index
				$Xlast = $Xnext - 1;				# Fake "last" index
				$renum = ($flg eq '+') ? 1 : 0;		# Renumber the tunes.
				&outtune("#$P: ren=$renum Xlast=$Xlast Xnext=$Xnext.") if $V>2;
			} elsif ($opt eq 'W') {
				$Wout = ($flg eq '+') ? 1 : 0;		# Whether to include W: lines
				&outtune("#$P: Wout=$Wout.") if $V>1;
			} elsif ($opt eq 'w') {
				$wout = ($flg eq '+') ? 1 : 0;		# Whether to include w: lines
				&outtune("#$P: wout=$wout.") if $V>1;
			} else {
				print STDERR "#$P: Unknown option '$opt'\n" if $V>0;
			}
		}
	} elsif (open(F,$f)) {
		if ($last && $files) {
			&outtune("") unless $hopt;
		}
		&onefile($f);
	} else {
		print STDERR "#$P: Can't read \"$f\" [$~]\n";
	}
}

exit 0;
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

sub onefile {my($f) = @_;
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Read one file and copy it to output.  It must be  the  file  F,  which  was #
# opened by the caller.                                                       #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($h,$s,$l,$T,$X);
	$last = '';
	while ($l = <F>) {		# Read the file one line at a time
		$l =~ s/\s+$//;		# Trim trailing white space
		if ($l || $last) {
			if ($cont) {
				if ($lasttype eq 'W:') {
					&outtune($l) if $Wout;
					if ($l =~ /\\\s*$/) {$cont = 1} else {$cont = 0}
					next;
				} elsif ($lasttype eq 'w:') {
					&outtune($l) if $wout;
					if ($l =~ /\\\s*$/) {$cont = 1} else {$cont = 0}
					next;
				} else {
				}
			} else {
				$lasttype = '';
			}
		#	$l =~ s/^(\w:)\s*/$1 /;		# Adjust spacing after :
			if ($l =~ /\\\s*$/) {$cont = 1} else {$cont = 0}
			if ($l =~ /^X:\s*(\d+)/) {	# X: line
				$lasttype = 'X:';
				$X = $1;
				$Xnext = $renum ? $Xlast+1 : ($X <= $Xlast) ? $Xlast+1 : $X;
				&outtune("% X=$X Xnext=$Xnext Xlast=$Xlast renum=$renum.") if $V>3;
				if ($sep && $tunes) {	# Insert separator line(s)?
					$h = 2;
					for ($s=0; $s<$sep; $s++) {
						&outtune("%%sep $h 1 500");
						$h = 1;
					}
				}
				$l = "X: $Xnext";
				&outtune("\n$l") unless $hopt && $tunes;
				$Xlast = $Xnext;		# Remember this tune index
				if ($Xnext <= $Xlast) {$Xnext = $Xlast + 1}
				&outtune("% Xnext=$Xnext Xlast=$Xlast") if $V>2;
				++$tunes;
			} elsif ($l =~ /^T:\s*(.+)/) {	# T: line
				$lasttype = 'T:';
				if (!defined($X)) {
					$X = 0;
					&outtune("\nX: 0");
				}
				&outtune("%T $1") if $V>2;
				if (!defined($T) || (!$hopt) || $hfile) {
					&outtune("% Copy title because T not defined.") if !defined($T) && $V>2;
					&outtune("% Copy title in header file.")        if $hfile && $V>2;
					&outtune("% Copy title because no H option.")   if !$hopt && $V>2;
					$T = $1;				# Only do first title for non-header files
					$T =~ s/^(\w)/\U$1/		# Capitalize first letter in title
						if $UCT;
					if ($hfile || !$hopt) {
						&outtune("T: $T");	# Use regular title line.
					} else {
						&outtune("P: $T");	# Convert title to "part" name.
					}
				}
			} elsif ($l =~ /^P:\s*(.+)/) {	# P: line
                $P = $1;
				$P =~ s/^(\w)/\U$1/		# Capitalize first letter in Part name
					if $UCT;
				&outtune("P: $P");	# Convert title to "part" name.
			} elsif ($l =~ /^W:\s*(.+)/) {	# W: line
				$lasttype = 'W:';
				&outtune($l) if $Wout;
			} elsif ($l =~ /^w:\s*(.+)/) {	# w: line
				$lasttype = 'w:';
				&outtune($l) if $wout;
			} else {
				&outtune($l);
			}
		}
		$last = $l;
	}
	if ($showfile && ($f =~ /\.abc$/)) {&outtune("%%center $f")}
	++$files;
}

sub outtune {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
    local($l);
    for $l (@_) {
        $l = '%' if $hopt && !$l;
        print "$l\n";
    }
}