#!/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.  Note that +R0 starts renumbering at zero, which is  often
#   used  for  an  initial  no-music  "header"  title,  and some ABC software
#   interprets X:0 as meaning "select all tunes in the file".
#
# +S<N>
# +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.  Gimmick: +S puts
#     the separators between input files; +s puts them after the X: lines.
#
# -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
$UCT    = 0;	# Capitalize titles
$Wout   = 1;	# Output W: lines
print "%$P\n" if $V>1;	# Do we want to identify ourself in the output?

for $f (@ARGV) {
	&outtune("%$P: arg='$f'") if $V>3;
	if (($flg,$opts) = ($f =~ /^([-+])(.*)/i)) {
		&outtune("%$P: flg=$flg' opts='$opts'") if $V>1;
		while ($opts =~ s/^(.)//) {
			$OPT = uc($opt = $1);
			&outtune("%$P: OPT='$OPT' opt='$opt'") if $V>1;
			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') {
				$Sflg = $OPT;			# Remember for positioning
				&outtune("%$P: Sflg='$Sflg' sep=$sep.") if $V>2;
				if ($opts =~ s/^(\d+)//) {
					&outtune("%$P: Sflg='$Sflg' sep='$sep' n='$1'") if $V>2;
					$sep = ($flg eq '+') ? int($1) : 0;	# Generate several separators
				} else {
					$sep = ($flg eq '+') ? 1 : 0;		# Generate separators
				}
				&outtune("%$P: Sflg='$Sflg' sep=$sep.") if $V>2;
			} 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>0;
				}
			} elsif ($OPT eq 'N' || $OPT eq 'R') {
				$Xnext = ($opts =~ s/^(\d+)//) ? int($1) : 1;	# Look for starting index number
				$Xlast = $Xnext - 1;				# Fake "last" index
				$renum = ($flg eq '+') ? 1 : -1;	# Renumber the tunes.
				print STDERR "$P: renum=$renum.\n" if $V>0;
				&outtune("%$P: renum=$renum Xlast=$Xlast Xnext=$Xnext [opt '$flg$OPT']") if $V>0;
			} 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='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 = '';
	if ($tunes && $sep && (Sflg eq 's')) {	# Have we produced any tunes yet?
		&outtune("% Sflg=s tunes=$tunes $sep separator lines in tune.") if $V>1;
		&seplines($sep);			# Produce separator lines between tunes
	}
	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;	# Original 2-mode renumbering
				if      ($renum > 0) {	# Renumbering tunes successively
					$Xnext =  $Xlast + 1;
				} elsif ($renum < 0) {	# Renumber only to get increasing index numbers
					$Xnext = ($X <= $Xlast) ? $Xlast+1 : $X;
				} else               {	# Default: No renumbering at all, use X: number
					$Xnext = $X;
				}
				&outtune("%$F: tunes=$tunes X=$X Xnext=$Xnext Xlast=$Xlast renum=$renum Sflg='Sflg'sep=$sep.") if $V>1;
			#	if ($tunes && $sep && ($Sflg eq 'S')) {	# Produce separator lines between tunes
			#		&outtune("% Sflg=S sep=$sep separator line before tune.") if $V>1;
			#		&seplines($sep);			# Produce separator lines between tunes
			#	}
				$l = "X: $Xnext";
				&outtune("$l") unless $hopt;	# Produce the X: line for this tune
				$Xlast = $Xnext;				# Remember this tune index
			#	if ($tunes && $sep && (Sflg eq 's')) {	# Have we produced any tunes yet?
			#		&outtune("% Sflg=s tunes=$tunes $sep separator lines in tune.") if $V>1;
			#		&seplines($sep);			# Produce separator lines between tunes
			#	}
				if ($Xnext <= $Xlast) {$Xnext = $Xlast + 1}
				&outtune("% tunes=$tunes Xnext=$Xnext Xlast=$Xlast") if $V>1;
				++$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;
#	if ($tunes && $sep && ($Sflg eq 'S')) {	# Produce separator lines between tunes
#		&outtune("% Sflg=S sep=$sep separator line before tune.") if $V>1;
#		&seplines($sep);			# Produce separator lines between tunes
#		&outtune("");
#	}
}

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

sub seplines { my($n) = @_;
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Generate the separator lines between tunes.  The parameter is the number of #
# lines  wanted.   Note  that  we currently produce these after the X: header #
# line.  This causes the separator lines to be printed at the top  of  a  new #
# page. If the %%sep lines are before the X: header line, some ABC formatters #
# will put the lines at the bottom of the previous page.  Which you want is a #
# matter  of  style, and maybe we should have a way of indicating this on the #
# command line.                                                               #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($h);
	if ($n) {	# Insert separator line(s)?
		$h = 1;				# Wider space above the first line?
		for ($s=0; $s<$n; $s++) {
			&outtune("%%sep $h 1 500");
			$h = 1;
		}
	}
}