#!/usr/bin/perl -w
#
# Anand Natrajan (www.anandnatrajan.com)
#
# Program to convert embedded tbl file formats to HTML.
# I/P and O/P: STDIN and STDOUT

use File::Basename;
use Getopt::Long;
$| = 1;
$MyName = basename($0);

$opt_border = 0;
$opt_pad = "";
$opt_space = "";
$opt_hstripe = 0;
$opt_vstripe = 0;
$opt_delim = "\t";

sub Usage
{
    print STDERR <<EOF;
Usage: $MyName [-help] [-debug] [-about] [-v[erbose]] [-delim <str>]
	[-border <num>] [-pad <num>] [-space <num>]
	[-hstripe <num>] [-vstripe <num>] [-notbl]
EOF

	if ($#_ > -1)
	{
		print STDERR <<EOF;

$MyName converts tbl-formatted files to HTML.
    -help                   : Print this help screen.
    -about                  : Print information about the author.
    -v[erbose]              : Turn verbose mode on.
    -debug                  : Turn debug mode on. Warning! Copious output.
    -delim <str>            : Specify delimiter for fields in table.
                              Default: \"$opt_delim\".
    -border <num>           : Specify width of the border between cells.
                              Default: \"$opt_border\".
    -pad <num>              : Specify the padding between cells.
                              Default: \"$opt_pad\".
    -space <num>            : Specify the spacing between cells.
                              Default: \"$opt_space\".
    -hstripe <num>          : Specify the number of colours for row stripes.
                              Default: \"$opt_hstripe\".
    -vstripe <num>          : Specify the number of colours for column stripes.
                              Default: \"$opt_vstripe\".
    -notbl                  : Treat the entire file as data with no tbl
                              specifications.

$MyName requires no input files and outputs no files. All inputs and
outputs are from STDIN and STDOUT respectively. The input format must
conform to syntax for tbl. See \"man tbl\" for details. Briefly, a tbl
file has the following syntax:
.TS
l c r s n.
Left	Centre	RightSpan	Number
.TE
where the 2nd line indicates formatting. Except the last, the following
lines are data to be formatted. $MyName adds capitalised versions for
the format letters for row spans.

EOF
	}
    exit 0;
}

sub About
{
    print STDERR <<EOF;

$MyName converts tbl tables to HTML.

$MyName is authored by Anand Natrajan.
URL: www.anandnatrajan.com.

$MyName is freeware. Please use it as you wish.
Naturally, the author is not liable if it breaks.
Send suggestions, comments and criticism to author.

EOF
	exit 0;
}

# Print only if verbose mode is on.
sub Vprint
{
	foreach my $line (@_) { print STDERR $line if ($opt_v); }
}

# Print only if debug mode is on.
sub Dprint
{
	foreach my $line (@_) { print STDERR $line if ($opt_debug); }
}

# Check if passed argument is defined and non-blank.
sub ispresent
{
	my $var = shift;
	return (defined($var) and $var ne "");
}

# Get a suitable colour if given an index and the max of the index.
sub colour
{
	my $index = shift; my $max = shift;
	my $redmax = 0xff; my $redmin = 0x77;
	my $greenmax = 0xff; my $greenmin = 0x77;
	my $bluemax = 0xff; my $bluemin = 0x77;
	my $redval = $redmin + ($redmax - $redmin) * $index / $max;
	my $greenval = $greenmin + ($greenmax - $greenmin) * $index / $max;
	my $blueval = $bluemin + ($bluemax - $bluemin) * $index / $max;
	return sprintf("#%2x%2x%2x", $redval, $greenval, $blueval);
}

# Average out two colours passed in as " bgcolor=#aaaaaa".
sub avgcolour
{
	my $colour1 = shift; my $colour2 = shift;
	return $colour1 if ($colour2 eq "");
	return $colour2 if ($colour1 eq "");
	$colour1 =~ s/.*#(..)(..)(..)//;
	$red1 = hex($1); $green1 = hex($2); $blue1 = hex($3);
	$colour2 =~ s/.*#(..)(..)(..)//;
	$red2 = hex($1); $green2 = hex($2); $blue2 = hex($3);
	my $redval = ($red1 + $red2) / 2;
	my $greenval = ($green1 + $green2) / 2;
	my $blueval = ($blue1 + $blue2) / 2;
	return sprintf(" bgcolor=#%2x%2x%2x", $redval, $greenval, $blueval);
}

### MAIN ###

&GetOptions("help" => \$opt_help, "about" => \$opt_about, "debug",
	"v|verbose", "border=n", "pad=n", "space=n", "hstripe=n", "vstripe=n",
	"delim=s", "notbl") or &Usage;
&Usage(1) if ($opt_help);
&About if ($opt_about);
$opt_v = 1 if (defined($opt_debug));

@lines = <>; @output = ();

while ($#lines > -1)
{
	if ($lines[0] =~ /^\.TS/ or $opt_notbl)
	{
		shift(@lines) if (!$opt_notbl);
		# shift only if tbl formatting is present
		my $border = (defined($opt_border) and $opt_border !~ /^\s*$/)
			? " border=\"$opt_border\"" : "";
		my $cellpad = (defined($opt_pad) and $opt_pad !~ /^\s*$/)
			? " cellpadding=\"$opt_pad\"" : "";
		my $cellspace = (defined($opt_space) and $opt_space !~ /^\s*$/)
			? " cellspacing=\"$opt_space\"" : "";
		push(@output, "<table$border$cellpad$cellspace>\n");
		push(@output, "<thead>\n");
		my $informs = 1;     # initially in the field specification lines
		my $inheads = 1;     # initially in the heading lines
		my $datarownum = -1; # count of which data row we're in
		my @formats = my @maxbefore = my @maxafter = ();
		my @prevvalues = my @prevstrides = my @strides = ();
		my $stridemark = 0;
		while (($#lines > -1) && (($_ = $lines[0]) !~ /^\.TE/))
		{
			shift(@lines); chomp;
			if ($informs)
			{
				# put a fake format if no tbl format is present
				# else, save the formats
				if ($opt_notbl) { push(@formats, "l."); }
				else { push(@formats, $_); }
				if ($formats[-1] =~ /\./)   # till end-of-formats seen
				{
					chop($formats[-1]); $informs = 0;
					# if tbl format present, skip to actual data
					next if (!$opt_notbl);
				}
			}
			if (!$informs)   # catches the case when tbl formats absent
			{
				# close header rows if we're in the last format line
				if ($#formats == 0 and $inheads)
				{
					push(@output, "</thead>\n");
					push(@output, "<tbody>\n");
					$inheads = 0;
				}
				# assume one row per line and delimiter-separated columns
				@_ = split(/$opt_delim/);
				my @fieldforms = split(/\s+/, $formats[0]);
				die "First column cannot be a span specification.\n"
					if ($fieldforms[0] =~ /^s/);
				my $bgcolour = "";
				# find the background colour for this row
				$bgcolour = " bgcolor=\"" . &colour(++$datarownum
					% $opt_hstripe + 1, $opt_hstripe) . "\""
					if (!$inheads and $opt_hstripe > 0);
				push(@output, "\t<tr$bgcolour>\n");
				for (my $i = 0; $i <= $#_; $i++)
				{
					my $align = ""; my $span = 1;
					my $datacolnum = $i; # count which data column we're in
					if ($fieldforms[0] =~ /^[LRCN]/)  # spanning rows
					{
						if (!defined($prevvalues[$i]) or
							$prevvalues[$i] ne $_[$i])
						{
							# put a temporary mark for later span count
							$align = " rowspan=#$stridemark";
							$prevstrides[$i] = $stridemark++;
							$strides[$prevstrides[$i]] = 1;
							$prevvalues[$i] = $_[$i];
						}
						else
						{
							$strides[$prevstrides[$i]]++;
							shift(@fieldforms) if ($#fieldforms > 0);
							while ($#fieldforms >= 0 and $fieldforms[0] =~ /^s/)
								{ shift(@fieldforms); }
							next;
						}
					}
					if ($fieldforms[0] =~ /^[lL]/) { $align .= " align=\"left\""; }
					elsif ($fieldforms[0] =~ /^[rR]/) { $align .= " align=\"right\""; }
					elsif ($fieldforms[0] =~ /^[cC]/) { $align .= " align=\"center\""; }
					elsif ($fieldforms[0] =~ /^[nN]/)
					{
						$_[$i] = 0 if ($_[$i] =~ /^\s*$/);
						# numbers have to be aligned by padding with spaces
						my $precount = length(int(abs($number = $_[$i])));
						$maxbefore[$i] = 0 if (!defined($maxbefore[$i]));
						$maxafter[$i] = 0 if (!defined($maxafter[$i]));
						$maxbefore[$i] = $precount
							if ($precount > $maxbefore[$i]);
						my $decdigits = (($pos = index($number, ".")) > -1)
							? substr($number, $pos + 1) : "";
						# if exponent used, expand it
						$decdigits =~ s/[eE].*$//; $decdigits =~ s/0*$//;
						my $postcount = length($decdigits)
							- ((($pos = index(lc($number), "e")) > -1)
							? substr($number, $pos + 1) : 0);
						$postcount = 0 if ($postcount < 0);
						$maxafter[$i] = $postcount
							if ($postcount > $maxafter[$i]);
						# save the field number, number of digits before
						# decimal and number of digits after decimal
						$align .= " align=numeric$i.$precount.$postcount";
					}
					shift(@fieldforms) if ($#fieldforms > 0);
					while ($#fieldforms >= 0 and $fieldforms[0] =~ /^s/)
						{ $span++; shift(@fieldforms); }
					$span = ($span > 1) ? " colspan=\"" . $span . "\"" : "";
					# find the background colour for this column
					my $bgcolour = "";
					$bgcolour = " bgcolor=" . &colour($datacolnum
						% $opt_vstripe + 1, $opt_vstripe)
						if ($opt_vstripe > 0);
					# if a horizontal stripe is also demanded, then do
					# something fancy to simulate both
					my $bgcolour2 = "";
					$bgcolour2 = " bgcolor=\"" . &colour($datarownum
						% $opt_hstripe + 1, $opt_hstripe) . "\""
						if ($opt_hstripe > 0 and $opt_vstripe > 0);
					$bgcolour = &avgcolour($bgcolour, $bgcolour2);
					# if we're in the headers, take advantage of that
					my $elem = $inheads ? "th" : "td";
					push(@output, "\t\t<$elem$bgcolour$span$align>$_[$i]</$elem>\n");
					# push(@output, "\t\t<!-- ($datarownum, $datacolnum) -->\n");
				}
				push(@output, "\t</tr>\n");
				shift(@formats) if ($#formats > 0);
			}
		}
		push(@output, "</tbody>\n");
		push(@output, "<tfoot>\n");
		# Currently, we don't have anything to add here
		push(@output, "</tfoot>\n");
		push(@output, "</table>\n");
		foreach (@output)
		{
			if ($_ =~ /align=numeric/)
			{
				# align numbers to right and pad end with spaces
				s/align=numeric(\d*).(\d*)\.(\d*)/align="right"/;
				my $numform = sprintf("%%.%df", $postcount = $3);
				if ($maxafter[$i = $1] > 0)
				{
					my $padding = $maxafter[$i] - $postcount;
					$padding++ if ($postcount == 0);
					while ($padding > 0) { $padding--; $numform .= "&nbsp;"; }
				}
				$number =  substr($_, $firstdigit = index($_, ">") + 1,
					index($_, "</") - $firstdigit);
				# need fixed-width font for numbers
				substr($_, $firstdigit) = "<font face=\"Courier\">"
					. sprintf($numform, $number) . "</font></td>\n";
			}
			if ($_ =~ /rowspan=#/)
			{
				# replace row span marks with actual counts
				/rowspan=#(\d*)/;
				if ($strides[$stridemark = $1] == 1) { s/ rowspan=#\d*//; }
				else { s/rowspan=#\d*/rowspan="$strides[$stridemark]"/; }
			}
		}
		shift(@lines);  # shift even if tbl headers are present and notbl set
	}
	else
		{ push(@output, $lines[0]); shift(@lines); }
}
print @output;