#!/usr/bin/perl -w

# gentablature.pl
#
# «A script for those who like writing guitar tablatures»
#
# Copyright © 2003, crashnburn
# Under the terms of BSD License#
#
# The infile format is:
# 
# <E-fret>, <A-fret>, <D-fret>, <G-fret>, <B-fret>, <e-fret>
# 
# The fret can be an x or X if the it is not pressed.
# Each new line is a space (useful for chords or timing)
# 
# TODO:	Add "tab break" support with an optional repeater (like 2x
#       or 4x) and "automatic new line" support.
#
# PS:	This is one of my first scripts, and I haven't learned a lot
#		of PERL yet, so if there are any errors, bad implementations,
#		comments on the	code, whatever... please mail me to
#		crashnburn@ip.pt

use strict;
#use warnings;
#use diagnostics;

use constant SPACE		=> "space";
use constant NOTPLAYED	=> "xX";

my @music;
my @tablature = split(/\s/, "|- " x 6);

sub sintaxe {
	print STDERR "usage: ", $0, " <infile> [<outfile>]\n";
	exit 1;
}

# Returns the length (1 or 2) of the biggest number of the played
# notes of the fret, for alignment purposes
sub biggest {
	foreach (@_) {
		if (length > 1) {
			return 2;
		}
	}

	return 1;
}

# Converts each line of the @music array (the values from the file) to
# Converts each line of the @music array (the values from the file) to
# a visible tablature
sub convertToTablature {
	while ($_ = shift @music) {
		if ($_ eq SPACE) {
			foreach (@tablature) {
				$_ .= "-";
			}
		} else {
			my @frets = split / /;
			my $B = &biggest(@frets);
			
			foreach (@frets) {
				if (eval "/[" . NOTPLAYED . "]/") {
					$_ = "-";
				}
				if (length > 2) {
					die "Syntax error: Each value can only have one ",
						"or two characters\n";
				} elsif ($B > length) {
					$_ = "-" . $_;
				}
			}
				
			for (my $i = 0; $i < 6; $i++) {
				$tablature[$i] .= $frets[$i] . "-";
			}
		}
	}
	
	foreach (@tablature) {
		$_ .= "|";
	}
}

if (@ARGV < 1 || $ARGV[0] =~ /-h|--help/) {
	&sintaxe;
}

# Reads values and interprets some meanings (only new line yet)
open INFILE, $ARGV[0] or die "Error reading from $ARGV[0]: $!\n";

while (<INFILE>) {
	chomp;
	if ($_) {
		my @frets = split /[,+\s+]+/;
		die "Syntax error: Each line of the infile must have exactly",
			"  6 elements\n" unless @frets == 6;
		push @music, "@frets";
	} else {
		push @music, "space";
	}
}

close INFILE;

&convertToTablature(@music);

# Opens outfile if any
if (@ARGV >= 2) {
	open OUTFILE, ">$ARGV[1]" or die "Error writing to $ARGV[1]:",
		" $!\n";
	select(OUTFILE);
}

foreach (reverse(@tablature)) {
	print $_ . "\n";
}

close;