#!/usr/local/bin/perl5
# 
#  Copyright (c) 1998
#       Jason Brazile.  All rights reserved.
# 
#  Redistribution and use in source and binary forms, with or without
#  modification, are permitted provided that the following conditions
#  are met:
#  1. Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
#  2. The name of the author may not be used to endorse or promote 
#     products derived from this software without specific prior written 
#     permission.
# 
# 
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
# OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
# 

use FileHandle;
use strict;
use integer;

#
# Return table used to look up note names
#
sub init_pitches
{
	my ($tab);

	$tab = [
		'C',
		'C#',
		'D',
		'D#',
		'E',
		'F',
		'F#',
		'G',
		'G#',
		'A',
		'A#',
		'B',
		];

	return($tab);
}
#
# Return table used to map chord pitches to chord names
#
sub init_chords
{
	my ($tab);
	my ($chord);

	$tab = [
		{ 
			'name'	=> '',
			'notes'	=> [0, 4],
		},
		{ 
			'name'	=> '',
			'notes'	=> [0, 4, 7],
		},
		{ 
			'name'	=> 'sus 4',
			'notes'	=> [0, 5, 7],
		},
		{ 
			'name'	=> 'b5',
			'notes'	=> [0, 4, 6],
		},
		{ 
			'name'	=> 'm',
			'notes'	=> [0, 3, 7],
		},
		{ 
			'name'	=> 'dim',
			'notes'	=> [0, 3, 6],
		},
		{ 
			'name'	=> 'aug',
			'notes'	=> [0, 4, 8],
		},
		{ 
			'name'	=> '6',
			'notes'	=> [0, 4, 7, 9],
		},
		{ 
			'name'	=> '69',
			'notes'	=> [0, 4, 7, 9, 14],
		},
		{ 
			'name'	=> '69',
			'notes'	=> [0, 4, 9, 14],
		},
		{ 
			'name'	=> '69',
			'notes'	=> [0, 7, 9, 14],
		},
		{ 
			'name'	=> 'm6',
			'notes'	=> [0, 3, 7, 9],
		},
		{ 
			'name'	=> 'm69',
			'notes'	=> [0, 3, 7, 9, 14],
		},
		{ 
			'name'	=> 'm69',
			'notes'	=> [0, 3, 9, 14],
		},
		{ 
			'name'	=> '7',
			'notes'	=> [0, 4, 7, 10],
		},
		{ 
			'name'	=> '7',
			'notes'	=> [0, 4, 10],
		},
		{ 
			'name'	=> '7 sus 4',
			'notes'	=> [0, 5, 7, 10],
		},
		{ 
			'name'	=> 'm7',
			'notes'	=> [0, 3, 7, 10],
		},
		{ 
			'name'	=> 'm7',
			'notes'	=> [0, 3, 10],
		},
		{ 
			'name'	=> 'm7 b5',
			'notes'	=> [0, 3, 6, 10],
		},
		{ 
			'name'	=> 'dim7',
			'notes'	=> [0, 3, 6, 9],
		},
		{ 
			'name'	=> '7 +5',
			'notes'	=> [0, 4, 8, 10],
		},
		{ 
			'name'	=> '7 b5',
			'notes'	=> [0, 4, 6, 10],
		},
		{ 
			'name'	=> 'M7',
			'notes'	=> [0, 4, 7, 11],
		},
		{ 
			'name'	=> 'M7',
			'notes'	=> [0, 4, 11],
		},
		{ 
			'name'	=> 'm #7',
			'notes'	=> [0, 3, 7, 11],
		},
		{ 
			'name'	=> '7 b9',
			'notes'	=> [0, 4, 7, 10, 13],
		},
		{ 
			'name'	=> '7 b9',
			'notes'	=> [0, 4, 7, 13],
		},
		{ 
			'name'	=> '7 b9',
			'notes'	=> [0, 4, 10, 13],
		},
		{ 
			'name'	=> '7 +9',
			'notes'	=> [0, 4, 7, 10, 15],
		},
		{ 
			'name'	=> '7 +9',
			'notes'	=> [0, 4, 10, 15],
		},
		{ 
			'name'	=> '7 +5 b9',
			'notes'	=> [0, 4, 8, 10, 13],
		},
		{ 
			'name'	=> '9',
			'notes'	=> [0, 4, 7, 10, 14],
		},
		{ 
			'name'	=> '9',
			'notes'	=> [0, 4, 10, 14],
		},
		{ 
			'name'	=> '9',
			'notes'	=> [0, 4, 7, 14],
		},
		{ 
			'name'	=> 'm9',
			'notes'	=> [0, 3, 7, 10, 14],
		},
		{ 
			'name'	=> 'm9',
			'notes'	=> [0, 7, 10, 14],
		},
		{ 
			'name'	=> 'm9',
			'notes'	=> [0, 3, 7, 14],
		},
		{ 
			'name'	=> 'm9',
			'notes'	=> [0, 3, 10, 14],
		},
		{ 
			'name'	=> '9 +5',
			'notes'	=> [0, 4, 8, 10, 14],
		},
		{ 
			'name'	=> '9 b5',
			'notes'	=> [0, 4, 6, 10, 14],
		},
		{ 
			'name'	=> '9 b5',
			'notes'	=> [0, 4, 10, 14],
		},
		{ 
			'name'	=> '9 b5',
			'notes'	=> [0, 6, 10, 14],
		},
		{ 
			'name'	=> 'M9',
			'notes'	=> [0, 4, 7, 11, 14],
		},
		{ 
			'name'	=> 'M9',
			'notes'	=> [0, 7, 11, 14],
		},
		{ 
			'name'	=> 'M9',
			'notes'	=> [0, 4, 11, 14],
		},
		{ 
			'name'	=> '9 #11',
			'notes'	=> [0, 4, 7, 10, 14, 18],
		},
		{ 
			'name'	=> 'm9 #7',
			'notes'	=> [0, 3, 7, 11, 14],
		},
		{ 
			'name'	=> '11',
			'notes'	=> [0, 7, 10, 14, 17],
		},
		{ 
			'name'	=> '11',
			'notes'	=> [0, 7, 10, 17],
		},
		{ 
			'name'	=> 'm11',
			'notes'	=> [0, 3, 7, 10, 17],
		},
		{ 
			'name'	=> 'm11',
			'notes'	=> [0, 3, 10, 17],
		},
		{ 
			'name'	=> 'dim7 b13',
			'notes'	=> [0, 3, 6, 8, 9],
		},
		{ 
			'name'	=> 'dim7 b13',
			'notes'	=> [0, 3, 8, 9],
		},
		{ 
			'name'	=> '13',
			'notes'	=> [0, 4, 7, 10, 14, 21],
		},
		{ 
			'name'	=> '13',
			'notes'	=> [0, 4, 10, 21],
		},
		{ 
			'name'	=> '13 b9',
			'notes'	=> [0, 4, 7, 10, 13, 21],
		},
		{ 
			'name'	=> '13 b9',
			'notes'	=> [0, 4, 13, 21],
		},
		{ 
			'name'	=> '13 b5 b9',
			'notes'	=> [0, 4, 6, 10, 13, 21],
		}
	];

	foreach $chord (@$tab){
		$chord->{'cnotes'} = &chord_canon(0, $chord->{'notes'});
	}

	return($tab);
}
#
# shift all notes in a chord a certain number of half steps based on a
# given root pitch.
#
sub chord_shift
{
	my ($root)	= shift;
	my ($chord)	= shift;
	my ($note, $shifted);

	foreach $note (@$chord){
		push(@$shifted, $note - $root);
	}

	return($shifted);
}
#
# fold all pitch octaves to fall into the first octave
#
sub chord_fold
{
	my ($chord)	= shift;
	my ($folded, $note);

	foreach $note (@$chord){
		push(@$folded, $note % 12);
	}
	return($folded);
}
#
# helper routine for sorting
#
sub numerically
{
	$a <=> $b;
}
#
# sort the pitches in a chord
#
sub chord_sort
{
	my ($chord)	= shift;
	my ($sorted);

	@$sorted = sort numerically @$chord;

	return($sorted);
}
#
# remove pitch duplicates which may have arrisen due to octaves
#
sub chord_uniq
{
	my ($chord)	= shift;
	my ($uniqed, $note);
	my ($tmp);

	foreach $note (@$chord){
		$tmp->{$note} = 1;
	}
	@$uniqed = keys(%$tmp);

	return($uniqed);
}
#
# reduce a set of chord pitches to a canonical form
#
sub chord_canon
{
	my ($root)	= shift;
	my ($chord) 	= shift;
	my ($shifted, $folded, $sorted, $uniqed);

	$shifted = &chord_shift($root, $chord);
	$folded  = &chord_fold($shifted);
	$uniqed  = &chord_uniq($folded);
	$sorted  = &chord_sort($uniqed);

	return($root, $sorted);
}
#
# compare 2 chords for equality
#
sub chord_compare
{
	my ($lhs)	= shift;
	my ($rhs)	= shift;
	my ($i);
	my ($ll, $lr);

	$ll = scalar(@$lhs);
	$lr = scalar(@$rhs);
	if ($ll != $lr){
		return($ll - $lr);
	}
	for($i=0; $i != $ll; $i++){
		if ($lhs->[$i] != $rhs->[$i]){
			return($lhs->[$i] - $rhs->[$i]);
		}
	}
	return(0);
}
#
# remove the place holders (for unused strings) in a chord
#
sub notes_only
{
	my ($chord)	= shift;
	my ($bottom, $the_rest, $combined, $c);

	$bottom = -1;
	$the_rest = [];
	$combined = [];
	foreach $c (@$chord){
		if ($c != -1){
			push(@$combined, $c);
			if ($bottom == -1){
				$bottom = $c;
			}else{
				push(@$the_rest, $c);
			}
		}
	}
	return($bottom, $the_rest, $combined);
}
#
# a helper routine for sorting
#
sub by_rank
{
	$a->[3] <=> $b->[3];
}
#
# given a set of pitches, try to deterine what chord it might be
#
sub chord_lookup
{
	my ($chord)	= shift;
	my ($chord_tab)	= shift;
	my ($root, $canon, $note);
	my ($c);
	my ($bottom, $the_rest);
	my ($combined);
	my ($matches);
	my ($index);
	my ($sorted_matches);


	$matches = [];

	($bottom, $the_rest, $combined) = &notes_only($chord);

	#
	# first, try building upon the bottom
	#
	$canon = &chord_canon($bottom % 12, $combined);
	$index = 0;
	foreach $c (@$chord_tab){
		if (&chord_compare($canon, $c->{'cnotes'}) == 0){
			push(@$matches, [$bottom % 12,
						$c->{'name'}, 
						$c->{'notes'},
						$index]);
		}
		$index++;
	}

	#
	# next, try each note in "the rest" as root
	#
	foreach $note (@$the_rest){
		$canon = &chord_canon($note % 12, $the_rest);
		$index = 0;
		foreach $c (@$chord_tab){
			if (&chord_compare($canon, $c->{'cnotes'}) == 0){
				push(@$matches, [$note % 12,
							$c->{'name'}, 
							$c->{'notes'},
							$index + 500]);
			}
			$index++;
		}
	}

	#
	# Last, try the_rest with "bottom + the_rest" combined
	#
	foreach $note (@$the_rest){
		$canon = &chord_canon($note % 12, $combined);
		$index = 0;
		foreach $c (@$chord_tab){
			if (&chord_compare($canon, $c->{'cnotes'}) == 0){
				push(@$matches, [$note % 12,
							$c->{'name'}, 
							$c->{'notes'},
							$index + 500]);
			}
			$index++;
		}
	}

	@$sorted_matches = sort by_rank @$matches;

	return($sorted_matches);
}

#
# test if this is a "fret" line
#
sub test_fret
{
	my ($line)	= shift;
	my (@ary);

	#
	# the line has to have a '+' and a '-' in it somewhere
	#
	if ($line !~ /\+/){
		return(0);
	}
	if ($line !~ /\-/){
		return(0);
	}

	@ary = $line =~ /^([\+\-\s]+)$/;

	if ($ary[0] eq $line){
		return(1);
	}else{
		return(0);
	}
}
#
# test if this is a "separator" line
#
sub test_separator
{
	my ($line)	= shift;
	my (@ary);

	@ary = $line =~ /^(\s*)$/;

	if ($ary[0] eq $line){
		return(1);
	}else{
		return(0);
	}
}
#
# test if this is a "comment" line
#
sub test_comment
{
	my ($line)	= shift;

	if ($line =~ /^#/){
		return(1);
	}else{
		return(0);
	}
}
#
# test if this is a "finger" line
#
sub test_finger
{
	my ($line)	= shift;
	my (@ary);

	#
	# the line has to have a '|' in it somewhere
	#
	if ($line !~ /\|/){
		return(0);
	}

	@ary = $line =~ /^([\|o\d\s]+)$/;

	if ($ary[0] eq $line){
		return(1);
	}else{
		return(0);
	}
}
#
# test if this is a "strings" line
#
sub test_strings
{
	my ($line)	= shift;
	my (@ary);

	#
	# the line has to have a 'x' in it somewhere
	#
	if ($line !~ /x/){
		return(0);
	}

	@ary = $line =~ /^([xO\s]+)$/;

	if ($ary[0] eq $line){
		return(1);
	}else{
		return(0);
	}
}

#
# we know that at this point the input contains only valid chars
#
sub parse_fret
{
	my ($line)	= shift;
	my ($num_objs, $objs, $obj);
	my ($state, $len, $i, $c, $col);

	$num_objs = 0;
	$objs = [];

	$state = 0;
	$col = -1;

	$len = length($line);
	for($i=0; $i<$len; $i++){
		$c = substr($line, $i, 1);
		if ($state == 0){
			if ($c eq '+'){
				$state = 1;
				$col = $i;
			}
		}elsif ($state == 1){
			if ($c !~ /[\+\-]/){

				$obj = {};
				$obj->{'type'} = 'fret';
				$obj->{'col'} = $col;
				$obj->{'data'} = substr($line, $col, $i - $col);

				push(@$objs, $obj);
				$num_objs++;

				$state = 0;
				$col = -1;
			}
		}else{
			die("parse_fret: bad state: <$state>");
		}
	}

	return($num_objs, $objs);
}
#
# we know that at this point the input contains only valid chars
#
sub parse_separator
{
	my ($line)	= shift;
	my ($num_objs, $objs, $obj);

	$num_objs = 0;
	$objs = [];

	$obj = {};
	$obj->{'type'} = 'separator';
	$obj->{'col'} = 0;
	$obj->{'data'} = $line;

	push(@$objs, $obj);
	$num_objs = 1;

	return($num_objs, $objs);
}
#
# we know that at this point the input contains only valid chars
#
sub parse_comment
{
	my ($line)	= shift;
	my ($num_objs, $objs, $obj);

	$num_objs = 0;
	$objs = [];

	$obj = {};
	$obj->{'type'} = 'comment';
	$obj->{'col'} = 0;
	$obj->{'data'} = $line;

	push(@$objs, $obj);
	$num_objs = 1;

	return($num_objs, $objs);
}
#
# we know that at this point the input contains only valid chars
#
sub parse_finger
{
	my ($line)	= shift;
	my ($num_objs, $objs, $obj);
	my ($position);
	my ($state, $len, $i, $c, $col, $pcol);

	$num_objs = 0;
	$objs = [];

	$position = '';
	$state = 0;
	$col = -1;

	$len = length($line);
	for($i=0; $i<$len; $i++){
		$c = substr($line, $i, 1);
		if ($state == 0){
			if ($c =~ /[o\|]/){
				$state = 1;
				$col = $i;
			}
		}elsif ($state == 1){
			if ($c eq "\n"){
				$obj = {};
				$obj->{'type'} = 'finger';
				$obj->{'col'} = $col;
				$obj->{'data'} = substr($line, $col, $i - $col);

				push(@$objs, $obj);
				$num_objs++;

				$position = '';
				$state = 0;
				$col = -1;

			}elsif ($c =~ /\s/){
				$state = 2;
			}else{
				die("parse_finger: space expected <$line>");
			}
		}elsif ($state == 2){
			if ($c =~ /[o\|]/){
				$state = 1;
			}elsif ($c =~ /\d/){

				$pcol = $i;

				$state = 3;
				$position = $c;

			}elsif ($c =~ /\s/){

				$obj = {};
				$obj->{'type'} = 'finger';
				$obj->{'col'} = $col;
				$obj->{'data'} = substr($line, $col, 
							$i - $col - 1);

				push(@$objs, $obj);
				$num_objs++;

				$position = '';
				$state = 0;
				$col = -1;
			}else{
				die("parse_finger: state 2 <$c> unexpected");
			}
		}elsif ($state == 3){
			if ($c =~ /\d/){
				$position = $position . $c;
			}elsif ($c =~ /\s/){

				$obj = {};
				$obj->{'type'} = 'finger';
				$obj->{'col'} = $col;
				$obj->{'data'} = substr($line, $col, 
							$pcol - $col - 1);

				push(@$objs, $obj);
				$num_objs++;

				$obj = {};
				$obj->{'type'} = 'position';
				$obj->{'col'} = $pcol;
				$obj->{'data'} = $position;

				push(@$objs, $obj);
				$num_objs++;

				$position = '';
				$state = 0;
				$col = -1;
				$pcol = -1;
			}
		}else{
			die("parse_finger: bad state: <$state>");
		}
	}

	return($num_objs, $objs);
}
#
# we know that at this point the input contains only valid chars
#
sub parse_strings
{
	my ($line)	= shift;
	my ($starts)	= shift;
	my ($lens)	= shift;
	my ($line_len, $len);
	my ($i, $num_objs, $objs, $obj);

	$num_objs = 0;
	foreach (@$starts){
		$num_objs++;
	}

	$objs = [];

	chop($line);
	$line_len = length($line);

	for ($i=0; $i<$num_objs; $i++){

		$obj = {};

		$obj->{'type'} = 'strings';
		$obj->{'col'} = $starts->[$i];

		$len = $lens->[$i];
		if (($starts->[$i] + $len) > $line_len){
			$len = $line_len - $starts->[$i];
		}

		$obj->{'data'} = substr($line, $starts->[$i], $len);

		push(@$objs, $obj);
	}

	return($num_objs, $objs);
}
#
# we know that at this point the input contains only valid chars
#
sub parse_words
{
	my ($line)	= shift;
	my ($num_objs, $objs, $obj);
	my ($state, $len, $i, $ii, $c, $col, $real_col);
	my ($word, @ary);

	$num_objs = 0;
	$objs = [];

	$state = 0;
	$col = -1;
	$real_col = -1;

	$len = length($line);
	$ii = 0;
	for($i=0; $i<$len; $i++){
		$c = substr($line, $i, 1);
		if ($state == 0){
			if ($c !~ /\s/){
				$state = 1;
				$col = $i;
				$real_col = $ii;
			}
		}elsif ($state == 1){
			if ($c eq "\n"){

				#
				# strip off trailing white space
				#
				$word = substr($line, $col, $i - $col);
				$word = reverse($word);
				@ary = $word =~ /^\s*(.*)$/;
				$word = reverse($ary[0]);

				$obj = {};
				$obj->{'type'} = 'words';
				$obj->{'col'} = $real_col;
				$obj->{'data'} = $word;

				push(@$objs, $obj);
				$num_objs++;

				$state = 0;
				$col = -1;
				$real_col = -1;
			}elsif ($c =~ /\s/){
				$state = 2;
			}
		}elsif ($state == 2){
			if ($c =~ /[\s\n]/){
				#
				# strip off trailing white space
				#
				$word = substr($line, $col, $i - $col);
				$word = reverse($word);
				@ary = $word =~ /^\s*(.*)$/;
				$word = reverse($ary[0]);

				$obj = {};
				$obj->{'type'} = 'words';
				$obj->{'col'} = $real_col;
				$obj->{'data'} = $word;

				push(@$objs, $obj);
				$num_objs++;

				$state = 0;
				$col = -1;
				$real_col = -1;
			}else{
				$state = 1;
			}
		}else{
			die("parse_fret: bad state: <$state>");
		}

		if ($c eq "\t"){
			$ii += 8;
		}else{
			$ii++;
		}
	}

	return($num_objs, $objs);
}
#
# return 2 arrays containing starting columns and string lengths
#
sub starts_and_lens
{
	my ($objs)	= shift;
	my ($obj, $starts, $lens);

	foreach $obj (@$objs){
		push(@$starts, $obj->{'col'});
		push(@$lens, length($obj->{'data'}));
	}

	return($starts, $lens);
}
#
# we know that at this point the input contains only valid chars
#
sub parse_line
{
	my ($line)	= shift;
	my ($starts)	= shift;
	my ($lens)	= shift;
	my ($num_objs, $objs);
	my ($type);
	my ($l_info);

	if 	(&test_fret($line)){
		($num_objs, $objs) = &parse_fret($line);
		$type = 'fret';
	}elsif	(&test_separator($line)){
		($num_objs, $objs) = &parse_separator($line);
		$type = 'separator';
	}elsif	(&test_finger($line)){
		($num_objs, $objs) = &parse_finger($line);
		$type = 'finger';
	}elsif	(&test_comment($line)){
		($num_objs, $objs) = &parse_comment($line);
		$type = 'comment';
	}elsif	(&test_strings($line)){
		($num_objs, $objs) = &parse_strings($line, $starts, $lens);
		$type = 'strings';
	}else{
		($num_objs, $objs) = &parse_words($line);
		$type = 'words';
	}

	$l_info = {};
	$l_info->{'type'} = $type;
	$l_info->{'num_objs'} = $num_objs;
	$l_info->{'objs'} = $objs;

	return($l_info);
}
#
# parse input into tokens that will be used for further parsing
#
sub parse
{
	my ($filename)	= shift;
	my ($fh, $line, $l_info, $lines);
	my ($starts, $lens);

	$fh = new FileHandle;

	$fh->open($filename, "r") || die("open $filename failed: $!");

	$starts	= [];
	$lens	= [];
	while($line = $fh->getline){
		$l_info = &parse_line($line, $starts, $lens);
		if ($l_info->{'type'} ne 'comment'){
			push(@$lines, $l_info);
			if ($l_info->{'type'} eq 'fret'){
				($starts, $lens) = 
					&starts_and_lens($l_info->{'objs'});
			}
		}
	}
	$fh->close || die("close $filename failed: $!");

	return($lines);
}

#
# determine the fingerings from this parsed line
#
sub proc_finger
{
	my ($params)	= shift;
	my ($offset)	= shift;
	my ($finger)	= shift;
	my ($notes, $i, $j);
	my ($pattern);

	$notes = [];

	for($i = 0; $i < $params->{'num_strings'}; $i++){

		if (substr($finger, $i * 2, 1) eq 'o'){
			$notes->[$i] = 
				@{$params->{'tuning'}}->[$i] + $offset;
		}else{
			$notes->[$i] = -1;
		}
	}

	return ($notes);
}
#
# determine the strings used from this parsed line
#
sub proc_strings
{
	my ($params)	= shift;
	my ($strings)	= shift;
	my ($notes, $i);

	$notes = [];

	for($i = 0; $i < $params->{'num_strings'}; $i++){

		if (substr($strings, $i * 2, 1) eq 'O'){
			$notes->[$i] = @{$params->{'tuning'}}->[$i];
		}else{
			$notes->[$i] = -1;
		}
	}

	return ($notes);
}
#
# merge given pitches into a single chord
#
sub chord_merge
{
	my ($params)	= shift;
	my ($lhs)	= shift;
	my ($rhs)	= shift;
	my ($bad_string, $tmp, $i);


	$tmp = [];
	$bad_string = -1;
	for($i = 0; $i < $params->{'num_strings'}; $i++){
		$tmp->[$i] = -1;
		if ($lhs->[$i] != -1){
			if ($rhs->[$i] != -1){
				$bad_string = $i;
			}else{
				$tmp->[$i] = $lhs->[$i];
			}
		}elsif ($rhs->[$i] != -1){
			$tmp->[$i] = $rhs->[$i];
		}
	}
	return($bad_string, $tmp);
}
#
# see if a given chord is already in our list of unique chords
#
sub uniq_lookup
{
	my ($uniq_chords)	= shift;
	my ($notes)		= shift;
	my ($index);
	my ($i);

	$index = -1;
	for ($i = 0; $i < scalar(@$uniq_chords); $i++){
		if (&chord_compare($uniq_chords->[$i]->{'midi_notes'}, 
							$notes) == 0){
			return($i);
		}
	}

	return($index);
}
#
# add a chord to our list of unique chords
#
sub uniq_add
{
	my ($uniq_chords)	= shift;
	my ($notes)		= shift;

	push(@$uniq_chords, {'midi_notes' => $notes});

	return(scalar(@$uniq_chords) - 1, $uniq_chords);
}
#
# given a partially processes chord entity, fully process it and if we
# haven't seen it before, add it to the list of unique chords
#
sub process_chord
{
	my ($params)		= shift;
	my ($uniq_chords)	= shift;
	my ($one_chord)		= shift;
	my ($chord);
	my ($obj);
	my ($index);
	my ($fretno);
	my ($strings);
	my ($position);
	my ($notes, $newnotes);
	my ($bad_string, $bad_strings);

	$position = 1;
	foreach $obj (@$one_chord){
		if ($obj->{'type'} eq 'position'){
			$position = $obj->{'data'};
		}
	}

	$fretno = 0;
	$notes = [];
	for($index = 0; $index < $params->{'num_strings'}; $index++){
		$notes->[$index] = -1;
	}

	$bad_strings = [];
	$bad_string = -1;
	foreach $obj (@$one_chord){
		if ($obj->{'type'} eq 'finger'){
			$newnotes = &proc_finger($params, $position + $fretno, 
							$obj->{'data'});
			if (defined(@$newnotes)){
				($bad_string, $notes) = 
					&chord_merge($params, $notes, $newnotes);
			}
			$fretno++;
		}elsif ($obj->{'type'} eq 'strings'){
			$newnotes = &proc_strings($params, $obj->{'data'});
			if (defined(@$newnotes)){
				($bad_string, $notes) = 
					&chord_merge($params, $notes, $newnotes);
			}
		}elsif ($obj->{'type'} eq 'words'){
			push(@{$chord->{'lyrics'}}, $obj->{'data'});
		}elsif ($obj->{'type'} eq 'chord_name'){
			$chord->{'name'} = $obj->{'data'};
		}

		if ($bad_string != -1){
			push(@$bad_strings, $bad_string);
		}
	}

	if (scalar(@$bad_strings) > 0){
		print("ERROR: Overspecified string(s):\n");

		for($index=0; $index < $params->{'num_strings'}; $index++){
			foreach $bad_string (@$bad_strings){
				if ($bad_string == $index){
					print("| ");
				}else{
					print("  ");
				}
			}
		}
		print("\n"); 
		for($index=0; $index < $params->{'num_strings'}; $index++){
			foreach $bad_string (@$bad_strings){
				if ($bad_string == $index){
					print("V ");
				}else{
					print("  ");
				}
			}
		}

		foreach $obj (@$one_chord){
			if ($obj->{'type'} eq "position"){
				print(" $obj->{'data'}");
			}else{
				print("\n+");
				for($index=0; 
					$index < $params->{'num_strings'} - 1; 
						$index++){
					print("-+");
				}
				print("\n", $obj->{'data'});
			}
		}
		print("\n");
		exit(1);
	}

	if (($index = &uniq_lookup($uniq_chords, $notes)) == -1){
		($index, $uniq_chords) = &uniq_add($uniq_chords, $notes);
	}
	$chord->{'chord_index'} = $index;

	return($chord, $uniq_chords);
}
#
# we are given a cluster of chords (because serveral may have appeared on
# a single line), separate them into individual chords and process them
#
sub process_cluster
{
	my ($params)		= shift;
	my ($uniq_chords)	= shift;
	my ($cluster)		= shift;
	my ($line);
	my ($cols, $count, $i);
	my ($obj, $one_chord);
	my ($chord);
	my ($chord_cluster);

	$chord_cluster = [];

	#
	# count how many objects there are
	#
	$cols = [];
	$count = 0;
	foreach $line (@$cluster){
		if ($line->{'type'} eq 'strings'){
			foreach $obj (@{$line->{'objs'}}){
				push(@$cols, $obj->{'col'});
				$count++;
			}
		}
	}

	#
	# add a sentinel
	#
	push(@$cols, 999999);

	for($i=0; $i<$count; $i++){
		$one_chord = [];
		foreach $line (@$cluster){
			foreach $obj (@{$line->{'objs'}}){
				if (($obj->{'col'} >= $cols->[$i]) &&
				    ($obj->{'col'} < $cols->[$i+1])){
					if ($line->{'type'} eq 'chord_names'){
						$obj->{'type'} = 'chord_name';
					}
					push(@$one_chord, $obj);
				}
			}
		}
		($chord, $uniq_chords) = 
			&process_chord($params, $uniq_chords, $one_chord);
		push(@$chord_cluster, $chord);
	}

	return($chord_cluster, $uniq_chords);
}

#
# state machine used to parse partially digested input into 4 objects -
# a header, the individual parts of chords, the list of unique chords,
# and a trailer
#
sub process
{
	my ($params)	= shift;
	my ($lines)	= shift;
	my ($state, $line, $last_line, $cluster, $chord_cluster);
	my ($uniq_chords);
	my ($header, $trailer, $chords);
	my ($lineno);

	$uniq_chords = [];

	$state		= 0;
	$last_line	= {};
	$cluster	= [];
	$chord_cluster	= [];
	$chords		= [];

	$header		= [];
	$trailer	= [];

	$lineno = 1;

	foreach $line (@$lines){

#		print "state = $state\n";
#		print "\t $line->{'objs'}->[0]->{'data'} \n";

		if	($state == 0){

			if	($line->{'type'} eq 'fret'){

				if ($line->{'num_objs'} == 
						$last_line->{'num_objs'}){
					$last_line->{'type'} = 'chord_names';
					push(@$cluster, $last_line);
				}else{
					if (scalar(%$last_line)){
						push(@$header, $last_line);
					}
				}

				$last_line = {};
				$state = 1;
			}else{
				if (scalar(%$last_line) > 0){
					push(@$header, $last_line);
				}
				$last_line = $line;
			}

		}elsif	($state == 1){

			if	($line->{'type'} eq 'finger'){
				push(@$cluster, $line);
				$state = 2;
			}elsif	($line->{'type'} eq 'strings'){
				push(@$cluster, $line);
				$state = 3;
			}else{
print STDERR "process: line $lineno <$line->{'objs'}->[0]->{'data'} ...>\n";
		print STDERR "process: type = \"$line->{'type'}\"\n";
		die("process: but type \"finger\" or \"strings\" was expected");
			}

		}elsif	($state == 2){

			if	($line->{'type'} eq 'fret'){
				$state = 1;
			}else{
print STDERR "process: line $lineno <$line->{'objs'}->[0]->{'data'} ...>\n";
		print STDERR "process: type = \"$line->{'type'}\"\n";
				die("process: but type \"fret\" was expected");
			}

		}elsif	($state == 3){

			if	($line->{'type'} eq 'separator'){
				$state = 4;
			}else{
print STDERR "process: line $lineno <$line->{'objs'}->[0]->{'data'} ...>\n";
		print STDERR "process: type = \"$line->{'type'}\"\n";
				die("process: but type \"separator\" was expected");
			}

		}elsif	($state == 4){

			if	($line->{'type'} eq 'separator'){
				$state = 5;
			}elsif	($line->{'type'} eq 'fret'){

				($chord_cluster, $uniq_chords) = 
					&process_cluster($params, 
						$uniq_chords, $cluster);
				push(@$chords, @$chord_cluster);
			
				$state = 1;
				$cluster = [];
				$chord_cluster = [];

			}elsif	($line->{'type'} eq 'words'){
				$state = 6;
				#
				# this is either lyrics or chords - need
				# next line to find out
				#
				$last_line = $line;
			}else{
print STDERR "process: line $lineno <$line->{'objs'}->[0]->{'data'} ...>\n";
		print STDERR "process: type = \"$line->{'type'}\"\n";
		die("process: but type \"separator\" or \"words\" was expected");
			}

		}elsif	($state == 5){

			if	($line->{'type'} eq 'separator'){

				($chord_cluster, $uniq_chords) = 
					&process_cluster($params,
						$uniq_chords, $cluster);
				push(@$chords, @$chord_cluster);

				$state = 11;
				$cluster = [];
				$chord_cluster = [];

			}elsif	($line->{'type'} eq 'fret'){

				($chord_cluster, $uniq_chords) = 
					&process_cluster($params, 
						$uniq_chords, $cluster);
				push(@$chords, @$chord_cluster);
			
				$state = 1;
				$cluster = [];
				$chord_cluster = [];

			}elsif	($line->{'type'} eq 'words'){
				$state = 6;
				#
				# this is either lyrics or chords - need
				# next line to find out
				#
				$last_line = $line;
			}else{
print STDERR "process: line $lineno <$line->{'objs'}->[0]->{'data'} ...>\n";
		print STDERR "process: type = \"$line->{'type'}\"\n";
		die("process: but type \"separator\" or \"words\" was expected");
			}

		}elsif	($state == 6){

			if	($line->{'type'} eq 'words'){

				$last_line->{'type'} = 'lyrics';
				push(@$cluster, $last_line);

				$line->{'type'} = 'lyrics';
				push(@$cluster, $line);

				$state = 7;

			}elsif	($line->{'type'} eq 'fret'){

				($chord_cluster, $uniq_chords) = 
					&process_cluster($params, 
						$uniq_chords, $cluster);
				push(@$chords, @$chord_cluster);

				$state = 1;
				$cluster = [];
				$chord_cluster = [];

				$last_line->{'type'} = 'chord_names';
				push(@$cluster, $last_line);

			}elsif	($line->{'type'} eq 'separator'){

				$state = 8;
				$last_line->{'type'} = 'lyrics';
				push(@$cluster, $last_line);

			}else{
print STDERR "process: line $lineno <$line->{'objs'}->[0]->{'data'} ...>\n";
	print STDERR "process: type = \"$line->{'type'}\"\n";
	die("process: but type \"words\", \"separator\" or \"fret\" was expected");
			}

		}elsif	($state == 7){

			if	($line->{'type'} eq 'words'){

				$line->{'type'} = 'lyrics';
				push(@$cluster, $line);

				$state = 7;

			}elsif	($line->{'type'} eq 'fret'){

				($chord_cluster, $uniq_chords) = 
					&process_cluster($params, 
						$uniq_chords, $cluster);
				push(@$chords, @$chord_cluster);

				$state = 1;
				$cluster = [];
				$chord_cluster = [];

			}elsif	($line->{'type'} eq 'separator'){

				#
				# XXX ?
				#
				$state = 8;

			}else{
print STDERR "process: line $lineno <$line->{'objs'}->[0]->{'data'} ...>\n";
	print STDERR "process: type = \"$line->{'type'}\"\n";
	die("process: but type \"words\", \"separator\" or \"fret\" was expected");
			}

		}elsif	($state == 8){

			if	($line->{'type'} eq 'words'){

				($chord_cluster, $uniq_chords) = 
					&process_cluster($params, 
						$uniq_chords, $cluster);
				push(@$chords, @$chord_cluster);

				$state = 10;
				$cluster = [];
				$chord_cluster = [];

				$line->{'type'} = 'chord_names';
				push(@$cluster, $line);

			}elsif	($line->{'type'} eq 'fret'){

				($chord_cluster, $uniq_chords) = 
					&process_cluster($params,
						$uniq_chords, $cluster);
				push(@$chords, @$chord_cluster);

				$state = 1;
				$cluster = [];
				$chord_cluster = [];

			}elsif	($line->{'type'} eq 'separator'){
				$state = 9;
			}else{
print STDERR "process: line $lineno <$line->{'objs'}->[0]->{'data'} ...>\n";
	print STDERR "process: type = \"$line->{'type'}\"\n";
	die("process: but type \"words\", or \"fret\" was expected");
			}

		}elsif	($state == 9){

			if	($line->{'type'} eq 'separator'){

				($chord_cluster, $uniq_chords) = 
					&process_cluster($params,
						$uniq_chords, $cluster);
				push(@$chords, @$chord_cluster);

				$state = 11;
				$cluster = [];
				$chord_cluster = [];

			}elsif	($line->{'type'} eq 'words'){

				($chord_cluster, $uniq_chords) = 
					&process_cluster($params, 
						$uniq_chords, $cluster);
				push(@$chords, @$chord_cluster);

				$state = 10;
				$cluster = [];
				$chord_cluster = [];

				$line->{'type'} = 'chord_names';
				push(@$cluster, $line);

			}elsif	($line->{'type'} eq 'fret'){

				($chord_cluster, $uniq_chords) = 
					&process_cluster($params,
						$uniq_chords, $cluster);
				push(@$chords, @$chord_cluster);

				$state = 1;
				$cluster = [];
				$chord_cluster = [];

			}else{
			}

		}elsif	($state == 10){
			if	($line->{'type'} eq 'fret'){

				$state = 1;

			}else{

print STDERR "process: line $lineno <$line->{'objs'}->[0]->{'data'} ...>\n";
		print STDERR "process: type = \"$line->{'type'}\"\n";
				die("process: but type \"fret\" was expected");

			}

		}elsif	($state == 11){

			push(@$trailer, $line);
			$state = 11;

		}else{
			die("process: bad state");
		}

		$lineno++;
	}

	#
	# not accepting states
	#
	if (($state == 0) || ($state == 1) || ($state == 2) || ($state == 10)){
		die("process: state = $state, which is not an accepting state");
	}

	if ($state == 6){
		$last_line->{'type'} = 'lyrics';
		push(@$cluster, $last_line);
	}

	if (scalar($cluster) > 0){
		($chord_cluster, $uniq_chords) = 
			&process_cluster($params, $uniq_chords, $cluster);
		push(@$chords, @$chord_cluster);
	}

	return($header, $trailer, $chords, $uniq_chords);
}
#
# given a list of pitches, return their human readable names
#
sub chord_pitches
{
	my ($midi_notes)	= shift;
	my ($pitch_tab)		= shift;
	my ($pitches);
	my ($bottom);
	my ($i, $pitch, $octave);

	$bottom = -1;
	for($i = 0; $i < scalar(@$midi_notes); $i++){
		if ($midi_notes->[$i] == -1){
			$pitches->[$i] = -1;
		}else{
			$pitch  = $midi_notes->[$i] % 12;
			$octave = $midi_notes->[$i] / 12;
			$pitches->[$i] = sprintf("%s(%d)",
				$pitch_tab->[$pitch],
				$octave);
			if ($bottom == -1){
				$bottom = $pitch;
			}
		}
	}
	return($bottom, $pitches);
}
#
# add human readable names for all the pitches to the list of unique chords
#
sub add_pitches
{
	my ($pitch_tab)		= shift;
	my ($uniq_chords)	= shift;
	my ($bottom, $pitches, $chord);

	foreach $chord (@$uniq_chords){
		($bottom, $pitches) = 
			&chord_pitches($chord->{'midi_notes'}, $pitch_tab);
		$chord->{'pitches'} = $pitches;
		$chord->{'bottom'} = $bottom;
	}

	return($uniq_chords);
}
#
# for each unique chord, add a list of possible chord names that chord
# might be labelled with
#
sub add_pnames
{
	my ($pitch_tab)		= shift;
	my ($chord_tab)		= shift;
	my ($uniq_chords) 	= shift;
	my ($result, $chord);
	my ($bottom, $space);
	my ($pname_tab, $pname, $r);

	foreach $chord (@$uniq_chords){
	
		$result = &chord_lookup($chord->{'midi_notes'}, $chord_tab);

		if (scalar(@$result) > 0){
			$pname_tab = {};
			$bottom = $chord->{'bottom'};
			foreach $r (@$result){
				#
				# for space after accidental
				#
				if (length($pitch_tab->[$r->[0]]) > 1){
					$space = ' ';
				}else{
					$space = '';
				}

				if ($r->[0] == $bottom){
					$pname = sprintf("%s%s%s",
						$pitch_tab->[$r->[0]], 
						$space,
						$r->[1]);
				}else{
					$pname = sprintf("%s%s%s/%s",
						$pitch_tab->[$r->[0]], 
						$space,
						$r->[1],
						$pitch_tab->[$bottom]);
				}

				if (exists($pname_tab->{$pname})){
				}else{
					$pname_tab->{$pname} = 1;
					push(@{$chord->{'possible_names'}}, 
						$pname);
				}
			}
		}
	}

	return($uniq_chords);
}
#
# print whatever text came before or after the chord grids
#
sub print_header_or_trailer
{
	my ($fh)	= shift;
	my ($header)	= shift;
	my ($item, $obj, $i);

	foreach $item (@$header){
		foreach $obj (@{$item->{'objs'}}){
			$i = $obj->{'col'};
			while($i > 7){
				$fh->print("\t");
				$i -= 8;
			}
			while($i > 0){
				$fh->print(' ');
				$i--;
			}
			$fh->print($obj->{'data'});
			if ($obj->{'type'} eq 'words'){
				$fh->print("\n");
			}
		}
	}
}

#
# print a guitar chord grid to an internal buffer
#
sub print_chord_grid
{
	my ($params)		= shift;
	my ($buf)		= shift;
	my ($row)		= shift;
	my ($col)		= shift;
	my ($midi_notes)	= shift;
	my ($dist_notes);
	my ($position);
	my ($i, $j, $r, $nrows);
	my ($tmpstr);

	$position = 999999;

	#
	# which position?
	#
	for($i=0; $i<scalar(@$midi_notes); $i++){
		if ($midi_notes->[$i] == -1){
			$dist_notes->[$i] = -1;
		}else{
			$dist_notes->[$i] = 
				$midi_notes->[$i] - 
					@{$params->{'tuning'}}->[$i];
			if (($dist_notes->[$i] > 0) && 
					($dist_notes->[$i] < $position)){
				$position = $dist_notes->[$i];
			}
		}
	}

	#
	# for each fret, loop through each string on that fret
	#
	$r = 0;
	for ($i=0; $i<$params->{'num_frets'}; $i++){
		#
		# print fret bar
		#
		$tmpstr = '';
		for($j=0; $j < ($params->{'num_strings'} - 1); $j++){
			$tmpstr = $tmpstr . '+-';
		}
		$tmpstr = $tmpstr . '+';
		($buf, $nrows) = &bprint($params, $buf, $row + $r, $col,
			"$tmpstr");
		$r += $nrows;
	
		#
		# print fingerings
		#
		$tmpstr = '';
		for($j=0; $j < $params->{'num_strings'}; $j++){
			if ($i == ($params->{'num_frets'} - 1)){
				#
				# the last fret
				#
				if ($midi_notes->[$j] == -1){
					$tmpstr = $tmpstr . 'x';
				}elsif ($midi_notes->[$j] == 
					@{$params->{'tuning'}}->[$j]){
					$tmpstr = $tmpstr . 'O';
				}else{
					$tmpstr = $tmpstr . ' ';
				}
			}else{
				#
				# not the last fret
				#
				if (($dist_notes->[$j] - $position) == $i){
					$tmpstr = $tmpstr . 'o';
				}else{
					$tmpstr = $tmpstr . '|';
				}
			}

			#
			# separator/terminator after each string
			#
			if ($j < ($params->{'num_strings'} - 1)){
				$tmpstr = $tmpstr . ' ';
			}else{
				if ($i == 0){
					#
					# print position number if > 0
					#
					if (($position > 1) && 
							($position != 999999)){
						$tmpstr = 
							$tmpstr . " $position";
					}
				}
				($buf, $nrows) = 
					&bprint($params, $buf, $row + $r, $col,
						"$tmpstr");
				$r += $nrows;
			}
		}
	}

	return($buf, $r);
}
#
# print to a string centered
#
sub sprint_centered
{
	my ($str)	= shift;
	my ($width)	= shift;
	my ($len, $off);
	my ($tmpstr);

	$len = length($str);
	$off = ($width / 2) - ($len / 2);
	$tmpstr = sprintf("%${off}s%s", "", $str);

	return ($tmpstr);
}
#
# split into an array of strings separated by a particular character
# treat multiple split chars in a row individually unlike the builtin split
#
sub mysplit
{
	my ($splitchar) = shift;
	my ($string)    = shift;
	my ($lines, $line, $len, $i, $c);

	$len = length($string);

	$lines = [];
	$line = '';
	for($i=0; $i<$len; $i++){
		$c = substr($string, $i, 1);
		if ($c eq $splitchar){
			push(@$lines, $line);
			$line = '';
		}else{
			$line = $line . $c;
		}
	}
	if ($line ne ''){
		push(@$lines, $line);
	}
	return(@$lines);
}
#
# print to a buffer
#
sub bprint
{
	my ($params)    = shift;
	my ($buf)       = shift;
	my ($row)       = shift;
	my ($col)       = shift;
	my ($string)    = shift;
	my ($line, $lines);
	my ($len, $i);

	@$lines = &mysplit("\n", $string);

	$i = 0;
	foreach $line (@$lines){
		$len = length($line);
		if ($len > $params->{'col_width'}){
			print("ERROR: line too wide (>",
				$params->{'col_width'}, ")\n");
			print("line: $line\n");
			exit(1);
		}       
		if (!defined($buf->[$row + $i])){
			$buf->[$row + $i] = ' ' x $params->{'line_width'};
		}
		substr($buf->[$row + $i], $col, $len) = $line;
		$i++;   
	}

	return($buf, $i);
}
#
# flush the contents of the buffer out to a file
#
sub bflush      
{
	my ($fh)        = shift;
	my ($buf)       = shift;
	my ($chopped, $line);

	foreach $line (@$buf){
		$chopped = reverse($line);
		($chopped) = ($chopped =~ /^\s*(.*)/);
		$line = reverse($chopped);
		$fh->print ($line, "\n");
	}
}
#
# pretty print the chord section to a file
#
sub print_chords
{
	my ($fh)		= shift;
	my ($params)		= shift;
	my ($chords)		= shift;
	my ($uniq_chords)	= shift;
	my ($chord_info);
	my ($i, $r, $nchords);
	my ($buf, $nrows, $maxrows, $col_no);
	my ($row, $col);
	my ($chord, $pname, $index);
	my ($tmpstr);

	$nchords = scalar(@$chords);

	$i	= 0;	
	$row	= 0;
	$col_no	= 0;
	$buf	= [];

	while($i < $nchords){
		#
		# fetch chord information
		#
		$chord = $chords->[$i];
		$index = $chord->{'chord_index'};
		$chord_info = $uniq_chords->[$index];

		#
		# determine column number for this chord
		#
		$col    = ($col_no * $params->{'col_width'}) +
			  ($col_no * $params->{'col_gap'});

		$r = 0;

		#
		# for this option, cols is expected to be 1
		#
		if ($params->{'analyze'}){
			$tmpstr = join(',', @{$chord_info->{'pitches'}});
			($buf, $nrows) = 
				&bprint($params, $buf, $row + $r, $col, 
					"# pitches: [$tmpstr]");
			$r += $nrows;

			($buf, $nrows) = 
				&bprint($params, $buf, $row + $r, $col, "#");
			$r += $nrows;

			foreach $pname (@{$chord_info->{'possible_names'}}){
				($buf, $nrows) = 
					&bprint($params, $buf, $row + $r, $col,
						"# $pname");
				$r += $nrows;
			}

			($buf, $nrows) = 
				&bprint($params, $buf, $row + $r, $col, "#");
			$r += $nrows;
		}

		#
		# print chord name
		#
		if ($params->{'keep_names'}){
			if (exists($chord->{'name'})){
				$tmpstr = 
					&sprint_centered($chord->{'name'}, 
						$params->{'min_col_width'} - 3);
				($buf, $nrows) = 
					&bprint($params, $buf, $row + $r, $col,
						"$tmpstr");
				$r += $nrows;
			}else{
				($buf, $nrows) = 
					&bprint($params, $buf, $row + $r, $col,
						 " ");
				$r += $nrows;
			}
		}else{
			if (exists($chord_info->{'possible_names'}) > 0){
				$tmpstr =
					&sprint_centered(
					$chord_info->{'possible_names'}->[0],
					$params->{'min_col_width'} - 3);
				($buf, $nrows) = 
					&bprint($params, $buf, $row + $r, $col,
						"$tmpstr\n");
				$r += $nrows;
			}else{
				($buf, $nrows) = 
					&bprint($params, $buf, $row + $r, $col,
						" ");
				$r += $nrows;
			}
		}

		#
		# print chord grid
		#
		($buf, $nrows) = 
			&print_chord_grid($params, $buf, $row + $r, $col,
				$chord_info->{'midi_notes'});
		$r += $nrows;

		#
		# if there are lyrics for this chord, print them
		#
		if (exists($chord->{'lyrics'})){

			($buf, $nrows) = 
				&bprint($params, $buf, $row + $r, $col, " ");
			$r += $nrows;

			$tmpstr = join("\n", @{$chord->{'lyrics'}});
			($buf, $nrows) = 
				&bprint($params, $buf, $row + $r, $col, 
					"$tmpstr");
			$r += $nrows;
		}

		#
		# keep track of the longest column per row
		#
		if ($r > $maxrows){
			$maxrows = $r;
		}

		#
		# if this was the last column, wrap around and add row gap
		#
		if (($col_no == ($params->{'cols'} - 1)) ||
						($i == ($nchords - 1))){
			$col_no = 0;
			$row    = $row + $maxrows;
			$maxrows = 0;

			#
			# add space between rows
			#
			for($r=0; $r<$params->{'row_gap'}; $r++){
				&bprint($params, $buf, $row + $r,
					0, " ");
			}

			$row = $row + $r;
		}else{
			$col_no++;
		}

		$i++;
	}
	&bflush($fh, $buf);
}
#
# pretty print all sections (i.e. header, chords, trailer) to a file
#
sub write_out
{
	my ($params)		= shift;
	my ($filename)		= shift;
	my ($header)		= shift;
	my ($trailer)		= shift;
	my ($chords)		= shift;
	my ($uniq_chords)	= shift;
	my ($fh, $i);

	$fh = new FileHandle;

	$fh->open($filename, "w") || 
			die("open($filename failed: $!");

	&print_header_or_trailer($fh, $header);

	&print_chords($fh, $params, $chords, $uniq_chords);

	#
	# There has to be at least 3 lines between chords and trailer.
	#
	for($i=0; $i < (3 - $params->{'row_gap'}); $i++){
		$fh->print("\n");
	}

	&print_header_or_trailer($fh, $trailer);

	$fh->close || die("close($filename failed: $!");
}
#
# show usage message and exit
#
sub usage
{
	my ($name)	= shift;

	print STDERR ("usage: $name [-a] [-c columns] [-k] ");
	print STDERR ("[-l linewidth] [-r]\n");
	print STDERR ("\t\t\t\t\t[-t tuning] [file1 ...]\n");
	print STDERR ("Description:\n");
	print STDERR ("\t-a\t\tanalyze\n");
	print STDERR ("\t-c columns\tnumber of chord columns in output\n");
	print STDERR ("\t-k\t\tkeep original chord names\n");
	print STDERR ("\t-l linewidth\tnumber of characters per line in output\n");
	print STDERR ("\t-r\t\treshape (reformat) only\n");
	print STDERR ("\t-t tuning\ttuning of instrument\n");
	print STDERR ("\n");
	print STDERR ("\tNote: Tuning is specified by ");
	print STDERR ("colon separated midi note numbers\n");
	print STDERR ("\t\te.g. standard tuning is \"-t 52:57:62:67:71:76\"\n");
	exit(2);
}
#
# parse command line arguments
#
sub do_args
{
	my ($state);
	my ($params);
	my ($argi);
	my ($argc);
	my ($notes);
	my ($missing_arg_fmt);

	my ($START);
	my ($ARG_COLS);
	my ($ARG_LINEWIDTH);
	my ($ARG_TUNING);
	my ($ARG_ARGS);


	$START		= 's';
	$ARG_COLS	= 'c';
	$ARG_LINEWIDTH	= 'l';
	$ARG_TUNING	= 't';
	$ARG_ARGS	= 'a';

	$missing_arg_fmt = "ERROR: %s Missing Argument\n";

	$state	= $START;

	$argc = scalar(@ARGV);

	$params->{'my_name'}		= $0;
	$params->{'infiles'}		= [];
	$params->{'outfile_name'}       = 'output';
	$params->{'num_frets'}          = 5;
	$params->{'tuning'}             = [52, 57, 62, 67, 71, 76];
	$params->{'width'}              = 1;
	$params->{'process'}            = 1;
	$params->{'reshape'}            = 0;
	$params->{'analyze'}            = 0;
	$params->{'keep_names'}         = 0;
	$params->{'num_strings'}        = 6;
	$params->{'line_width'}         = 78;
	$params->{'col_gap'}            = 1;
	$params->{'row_gap'}            = 1;
	$params->{'cols'}               = 5;

	while($argc > 0){

		if ($state eq $START){
			if	 ($ARGV[$argi] eq "-a"){
				if ($state eq $START){
					$params->{'analyze'} = 1;
				}else{
					printf STDERR ( $missing_arg_fmt, 
								"-$state");
					&usage($params->{'my_name'});
				}
			}elsif ($ARGV[$argi] eq "-c"){
				if ($state eq $START){
					$state = $ARG_COLS;
				}else{
					printf STDERR ( $missing_arg_fmt, 
								"-$state");
					&usage($params->{'my_name'});
				}
			}elsif ($ARGV[$argi] eq "-k"){
				if ($state eq $START){
					$params->{'keep_names'} = 1;
					$state = $START;
				}else{
					printf STDERR ( $missing_arg_fmt,
								"-$state");
					&usage($params->{'my_name'});
				}
			}elsif ($ARGV[$argi] eq "-l"){
				if ($state eq $START){
					$state = $ARG_LINEWIDTH;
				}else{
					printf STDERR ( $missing_arg_fmt,
								"-$state");
					&usage($params->{'my_name'});
				}
			}elsif ($ARGV[$argi] eq "-r"){
				if ($state eq $START){
					$params->{'reshape'} = 1;
				}else{
					printf STDERR ( $missing_arg_fmt,
								"-$state");
					&usage($params->{'my_name'});
				}
			}elsif ($ARGV[$argi] eq "-t"){
				if ($state eq $START){
					$state = $ARG_TUNING;
				}else{
					printf STDERR ( $missing_arg_fmt,
								"-$state");
					&usage($params->{'my_name'});
				}
			}elsif ($ARGV[$argi] =~ /^-/){
				print STDERR ("Unknown option: $ARGV[$argi]\n");
				&usage($params->{'my_name'});
			}else{
				$state = $ARG_ARGS;
				push(@{$params->{'infiles'}}, $ARGV[$argi]);
			}

		}elsif ($state eq $ARG_ARGS){

			push(@{$params->{'infiles'}}, $ARGV[$argi]);

		}elsif ($state eq $ARG_TUNING){

			@$notes = split(/:/, $ARGV[$argi]);

			if (scalar(@$notes) < 1){
				printf STDERR (
					"ERROR: failed to parse tuning arg\n");
				&usage($params->{'my_name'});
			}else{
				$params->{'tuning'} = $notes;
			}

			$state = $START;

		}elsif ($state eq $ARG_COLS){

			$params->{'cols'} = $ARGV[$argi];
			$state = $START;

		}elsif ($state == $ARG_LINEWIDTH){

			$params->{'linewidth'} = $ARGV[$argi];
			$state = $START;

		}else{
			printf STDERR ( 
				"do_args: %s - bad state\n", $state);
			&usage($params->{'my_name'});
		}

		$argc--; $argi++;
	}

	if ($state ne $ARG_ARGS){
		if ($state eq $START){
			printf STDERR 
				("You must give at least one input filename\n");
		}else{
			printf STDERR ( $missing_arg_fmt, "-$state");
		}
		&usage($params->{'my_name'});
	}

	$params->{'num_strings'}        = scalar(@{$params->{'tuning'}});
	$params->{'min_col_width'}      = $params->{'num_strings'} * 2 + 2;
	$params->{'col_width'}          = $params->{'line_width'} /
					  $params->{'cols'};

	if ($params->{'col_width'} < $params->{'min_col_width'}){
		&usage($params->{'my_name'});
	}

	if (($params->{'analyze'}) && ($params->{'cols'} > 1)){
		$params->{'cols'} = 1;
		$params->{'col_width'} = $params->{'line_width'};
	}
	
	return($params);
}

#
# backup the original (input) file
#
sub mk_backup_file
{
	my ($filename)	= shift;
	my ($backup_name);
	my ($line);
	my ($read_fh, $write_fh);

	$backup_name = $filename . ".bak";

	$read_fh = new FileHandle;
	$write_fh = new FileHandle;

	$read_fh->open($filename, "r") || 
				die("open($filename failed: $!");

	$write_fh->open($backup_name, "w") || 
				die("open($backup_name failed: $!");

	while($line = $read_fh->getline){
		$write_fh->print($line);
	}

	$write_fh->close || die("close($backup_name failed: $!");
	$read_fh->close || die("close($filename failed: $!");

	return($backup_name);
}
#
# pretty print and name guitar chords
#
sub main
{
	my ($lines);
	my ($header, $trailer, $chords, $uniq_chords);
	my ($chord_tab, $pitch_tab);
	my ($filename, $backup_file, $params);

	$params = &do_args;

	foreach $filename (@{$params->{'infiles'}}){

		$backup_file = &mk_backup_file($filename);

		$lines = &parse($backup_file);

		($header, $trailer, $chords, $uniq_chords) = 
						&process($params, $lines);

		printf("Total Chords:  %3d\n", scalar(@$chords));
		printf("Unique Chords: %3d\n", scalar(@$uniq_chords));

		if ($params->{'reshape'} > 1){

			$params->{'keep_names'} = 1;
			
		}else{

			$pitch_tab = &init_pitches;

			$uniq_chords = &add_pitches($pitch_tab, $uniq_chords);

			$chord_tab = &init_chords;

			$uniq_chords = &add_pnames($pitch_tab, 
						$chord_tab, $uniq_chords);
		}

		&write_out($params, $filename, 
				$header, $trailer, $chords, $uniq_chords);
	}
}

&main