#!/usr/bin/perl
#######################
# Jesse Lovegren
# lovegren@buffalo.edu
# 3-Jun-2011
#
# script to convert \gll ... \glt 
# environment to a series of tabular items
#
# usage: cat intput.tex | example-table.pl [page width in chars]
#########################3
use strict;

my $pagewidth = shift @ARGV;

my @l1;
my @l2;
my $trans;
my $opened;
my ($i,$j,$k);
		 ###################################################################
sub checklength{ #gets an array in, and checks the total length of all the strings #
		 #inside of it, but it doesn't count whitespace or latex markup	   #
		 ###################################################################
	my ($inpointer,$cutoff) = @_; 	# this means input needs to be a pointer, not an array
	my @sbjarray = @$inpointer;	# $cutoff is the length after which a line break should be	
	my $item;			# issued. the return value should be the recommended cutoff 
	my @countlist;			# positions. returns empty array if no breaks needed.
	################################# ##############################################
	foreach $item (@sbjarray) {
		$item =~ s/\\[a-zA-Z]*//g;
		$item =~ tr/{}//d;
		$item =~ s/\s+//g;
		push @countlist, length $item;
		}
	###########################################
	my $count;
	my @breaks;
	foreach $item ( 0 .. $#countlist ) { #recycle the variable $item
		$count += $countlist[$item];
		if ($count >= $cutoff){
			push @breaks, $item;
			$count = 0;
			}
	}
	return @breaks;
}
##################################################
sub tablewidths { #inputs two pointers to arrays, then outputs an array with suggested table widths
	my ($l2, $gloss, $width) = @_;
	my @bd1 = @$l2;
	my @bd2 = @$gloss;
	my ($l1, $l2) = ($bd1[0],$bd2[0]);
	my @chosen;
	my $i;
	my @widths;
	MAIN:  if (1){
			if ($l1 < $l2) {@chosen = @bd1;
					}
			else {@chosen = @bd2;}
			SUBLOOP : for $i ( 0 .. ($#chosen+1) ){
				($i == 0) 	? push @widths, $chosen[$i] :
				($i <= $#chosen)? push @widths, ($chosen[$i] - $chosen[$i-1]) : 
						push @widths, ($width - $chosen[$i-1]);
			}
		return (\@widths, \@chosen);
		}
		
		else { return (0); } 
}		
###############################################
MAINLOOP: while (<>){
	if ( my ($a) = $_ =~ /^\s*\\gll\s(.*?)\s*\\\\/ ){
		$a =~ s/\s+/ /;
		$a =~ s/(\{[^}]*)\s(?=[^}]*\})/\1%/g;
		@l1 = split / /, $a;
		$opened = 1; # true if the first gll statement has been encountered
		next MAINLOOP;
	}
	elsif ( $opened and (my ($b) = $_ =~ /^\s*(.*?)\s*$/) ){
		$b =~ s/\s+/ /;
		$b =~ s/(\{[^}]*)\s(?=[^}]*\})/\1%/g;
		push @l2 , (split / /, $b);
		if ($b =~ /\\\\/){$opened = 0;} #if line break is found then go to look for \glt
		next MAINLOOP;
	}
	elsif ( my ($c) = $_ =~ /^\s*\\glt\s(.*?)\s*\\par/ ){
		$trans = $c;
		################
		my @bd1 = &checklength(\@l1,$pagewidth); #get breakset for source line
		my @bd2 = &checklength(\@l2,$pagewidth); #get breakset for gloss line	
		my $nrows = @l1;
		my @widths;
		my @lengths;
		my ($x,$y);
		($x,$y) = &tablewidths(\@bd1, \@bd2, $nrows);
		@widths = @$x;
		@lengths = @$y;
		push @lengths, $nrows;
		($widths[0] eq ("")) ? (@widths = ($nrows)) : 1;
		##################
		#print "length: $nrows, widths: <@widths> ($#widths), cutoffs: @lengths\n";
		################				     ###################
		open PIPE, "| perl -e 'while(<>){s/%/ /g;print;}' "; #duke of york
			 					#technique removes %
		#################
		my $start = 0;
		#	print PIPE "#going from $start to $lengths[$i]\n";
	for $i ( 0 .. $#widths ) {
		print PIPE "\\begin{tabular}{" , "l" x $widths[$i] , "}\n";
		for $j ( $start .. ($lengths[$i]-1) ){
			print PIPE "$l1[$j]\t";
			print PIPE "&" if $j != ($lengths[$i]-1);		
			}
		print PIPE "\\\\\n";		
		for $k ( $start .. ($lengths[$i]-1) ){
			print PIPE "$l2[$k]\t";
			print PIPE "&" if $k != ($lengths[$i]-1);		
			}
			print PIPE "\n";	
		if ($i < $#widths) { print PIPE "\\end{tabular}\n\\\\\n"; }
		$start = $lengths[$i];
		}
			print PIPE "\\multicolumn{" , $widths[$#widths] , "}{l}{" , "$trans}" , "\\\\\n";
			print PIPE "\\end{tabular}\n";
			close PIPE;
		@l1 = @l2 = @lengths = @widths = ();
		}
	else {print;}
}