#! /usr/bin/perl
#
# Convert a given text file into a Praat label file.
#
#    Copyright (C) 2000, 2001  R.J.J.H. van Son
# 
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
# 
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
# 
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
push(@INC, "/home/rob/OSS/GTPhconv");
require "NormalText.pl";
require "SplitText.pl";

my $Transcriptions    = "../Transcriptions/";
my $LabelFiles        = "../Labels/chunks/";
my $PunctuationChars = '(^|\s)[\,\:\;\`\'\-\"](\s|$)';

my $ADDPAUSE = 1;

# Make sure the target directory exists
sub create_Labeldirectory  # ($ID) -> 1/0 create directory if necessary
{
	my $ID = shift || return 0;
	#
	my $DirExists = -d "$LabelFiles$ID";
	(return mkdir("$LabelFiles$ID", 0744) || die "$LabelFiles$ID: $!\n") unless $DirExists;
	return 0;   # Nothing done
}

# A routine to construct element ID codes
sub IncreaseIDcode	#	($IDSTRING) -> $NEW_IDSTRING
{
	my $ID = shift || 'A';
	my $Lowest = shift || (($ID =~ /[A-Z]/i) ? 'A' : '0');
	# ID ends in Alphabetic code
	my $Code = "";
	my $Rest = "";
	# Handle the fixed pronunciations
	my @FixedPronunciationLabels = ('ABC', 'NUM', 'VOW', 'HVDA', 'HVDB',
		'VCVA', 'VCVB', 'VCVC', 'VCVD', 'VCVE', 'VCVF', 'VCVG', 'VCVH');
	if($ID =~ /(FP[AB][12])([A-Z]+)$/)
	{
		my $CurrentFPlabel = $2;
		$ID = $`;
		$Code = $1;
		while(@FixedPronunciationLabels && 
              $CurrentFPlabel ne shift(@FixedPronunciationLabels)){};
		$Code .= shift(@FixedPronunciationLabels);
	}
	elsif($ID =~ /[A-Z\-\.\,]+(\_|$)/i)
	{
		$Code = $&;
		$ID = $`;
		$Rest = $';

		if($Code =~ /([A-Z]+)([\.,]*)$/)
		{
			my $Increase = $1;
			++$Increase;
			$Increase =~ s/A/$Lowest/g if $Lowest ne 'A';
			$Code = "$`$Increase$2";
		};
	}
	# ID ends in Numerical code
	elsif($ID =~ /[\d\-\.\,]+(\_|$)/i)
	{
		$Code = $&;
		$ID = $`;
		$Rest = $';
		if($Code =~ /([\d]+)([\.,]*)$/)
		{
			my $Increase = $1;
			++$Increase;
			$Increase =~ s/\0/$Lowest/g if $Lowest ne '0';
			$Code = "$`$Increase$2";
		};
	};
	$ID .= $Code;
	$ID .= "_$Rest" if $Rest;

	return $ID;
};

# Convert text files to lable files
sub convert_text_to_labels      # ($ID, $FileID)
{
my $ID = shift || die "No speaker ID\n";
my $FileID = shift || die "No file ID\n";
my $FORMAT = shift || "";

#
my $DURATION = 1;

# Create target directory if necessary
create_Labeldirectory($ID);

# Do NOT overwrite existing labelfiles
return 0 if -e "$LabelFiles$ID/$ID$FileID.translit";

# open source and target files
open(SOURCE, "<$Transcriptions$ID/$ID$FileID.txt") || die "$Transcriptions$ID/$ID$FileID.txt: $!\n";
open(TARGET, ">$LabelFiles$ID/$ID$FileID.translit") || die "$LabelFiles$ID/$ID$FileID.translit: $!\n";

#
# Read the input
my @AllLines = ();

while(<SOURCE>)
{
	chomp;
	s/[ ][ ]+/ /g;  # Remove multiple spaces
	push(@AllLines, $_);
};

# Normalize and split all text
foreach $Line (@AllLines)
{
	$Line = ::NormalizeLine($Line);
};

# Split sentences, when there is punctuation
if(grep(/\./, @AllLines))
{
	if($FileID !~ /[FVP][SWY]$/)
	{
		my $AllSentences = SplitAllLines(@AllLines);
		@AllLines = @$AllSentences;
	}
	else   # Isolate punctuation
	{
		my $Sentence;
		foreach $Sentence (@AllLines)
		{
			$Sentence =~ s/([\,\.\?\!\:\;]+)/ $1/g;
		};
	};
};

#
# Define all Tiers
my @AllTiers = (SENTENCE, TRANSLIT);
my $IDformat = "IDFOLDED";

my $Tier;
foreach $Tier (@AllTiers)
{
	${$Tier} = $IDformat;
	@{$Tier.'tier'} = ();
	@{$Tier.'IDtier'} = ();
	@{$Tier.'start'} = ();
	@{$Tier.'end'} = ();
};
#

#
# Fill all the TIERS
#
# From a TextGrid (label)
my %TierFromGrid = ();    # Record whether Tier has been read from grid!
my $Line;
my $TopIDcode = ${FileID} =~ /[\d]$/ ? "$ID${FileID}A" : "$ID${FileID}1";
# Handle Fixed pronunciation lists
if($TopIDcode =~ /(FP[AB][12])[A1]$/)
{
	$TopIDcode = "$`${1}ABC";
};	
#
# Start by filling the Sentence Tier
#
$REMOVEEMPTY = 0;
unless(@SENTENCEtier || @TRANSLITtier)
{
	# Make early "segments" longer than late segments
	my $TotalLineCount = scalar(@AllLines) || 1;
	my $LineCount = 0;
	# Start with a pause if needed
	if($ADDPAUSE)
	{
		my $SentenceIDcode = $TopIDcode =~ /\d$/ ? "${TopIDcode}A" : "${TopIDcode}";
		push(@SENTENCEtier, " ");
		$SentenceIDcode =~ /[A-Z]+$/;
		push(@SENTENCEIDtier, "$`-A");
		push(@SENTENCEstart, @SENTENCEend ? $SENTENCEend[-1] : '0');
		push(@SENTENCEend, ($SENTENCEstart[-1]+5*(1.5-$LineCount/$TotalLineCount)));
	};
	# Other sentences
	foreach $Line (@AllLines)
	{
		next if $REMOVEEMPTY && $Line !~ /\S/;
		my $Text = $Line;
		chomp($Text);
		# Manage Sentence ID codes	
        my $SentenceIDcode = $TopIDcode =~ /\d$/ ? "${TopIDcode}A" : "${TopIDcode}";
		# Skip pauses at this point
		if($Text =~ /\S/)
		{
			push(@SENTENCEtier, $Text);
			push(@SENTENCEIDtier, $SentenceIDcode);
			$TopIDcode = IncreaseIDcode($TopIDcode);
			push(@SENTENCEstart, @SENTENCEend ? $SENTENCEend[-1] : '0');
			push(@SENTENCEend, ($SENTENCEstart[-1]+length($Text)*(1.2-$LineCount/(4*$TotalLineCount))));
		};
		#
		# Add a pause if needed (e.g., for an empty line)
		if($ADDPAUSE || $Text =~ /\S/)
		{
			push(@SENTENCEtier, " ");
			push(@SENTENCEIDtier, $SentenceIDcode."-A");
			push(@SENTENCEstart, $#SENTENCEend >= 0 ? $SENTENCEend[-1] : '0');
			push(@SENTENCEend, ($SENTENCEstart[-1]+5*(1.1-$LineCount/(9*$TotalLineCount))));
		};

		++$LineCount;
	};

	#
	# After filling the Sentence Tier, the times have to be scaled to the total duration
	my $DurationScaling = $DURATION / $SENTENCEend[-1] if ($SENTENCEend[-1]);
	for($Line = 0; $Line < scalar(@SENTENCEtier); ++$Line)
	{
		$SENTENCEstart[$Line] *= $DurationScaling;
		$SENTENCEend[$Line] *= $DurationScaling;
	};
}
elsif(@TRANSLITtier)
{
	for($Line=0; $Line < scalar(@TRANSLITtier); ++$Line)
	{
		my $Text = $TRANSLITtier[$Line];
		# 
		# Store Tier
		$SENTENCEtier[$Line] = $Text =~ /\S/ ? $Text : "\#";
		$SENTENCEIDtier[$Line] = $TRANSLITIDtier[$Line];
		$SENTENCEstart[$Line] = $TRANSLITstart[$Line];
		$SENTENCEend[$Line] = $TRANSLITend[$Line];
	};	
};
if(!@SENTENCEIDtier)
{
	my $sentence;
	foreach $sentence (@SENTENCEtier)
	{
		my $SentenceIDcode = $TopIDcode =~ /\d$/ ? "${TopIDcode}A" : "${TopIDcode}";
		push(@SENTENCEIDtier, $SentenceIDcode);
		# Handle pauses
		$SENTENCEIDtier[$#SENTENCEIDtier] .= '-A' unless $sentence =~ /[^\s\#]/;
		$TopIDcode = IncreaseIDcode($TopIDcode) if $sentence =~ /[^\s\#]/;
	};
};

#
# Fill the Tranliterated Tier, this tier will be used to generate the
# transcription. This allows to fill the SENTENCE and TRANSLIT tiers
# from a label file and go on from here.
#
unless(@TRANSLITtier)
{
	for($Line=0; $Line < scalar(@SENTENCEtier); ++$Line)
	{
		my $Text = $SENTENCEtier[$Line];
		#
		# Remove all punctuation
		$Text =~ s/$PunctuationChars/ /g;
		$Text =~ s/\s\s+/ /g;
		# 
		# Store Tier
		$TRANSLITtier[$Line] = $Text =~ /\S/ ? $Text : "\#";
		$TRANSLITIDtier[$Line] = $SENTENCEIDtier[$Line];
		$TRANSLITstart[$Line] = $SENTENCEstart[$Line];
		$TRANSLITend[$Line] = $SENTENCEend[$Line];
	};
}
elsif(!@TRANSLITIDtier)   # Add id numbers (interpolate skipped or inserted pauses)
{
	my $sentence = 0;
	my $translit = 0;
	while($translit < scalar(@TRANSLITtier) && $sentence <= scalar(@SENTENCEtier))
	{
		my $TranslitPause = !($TRANSLITtier[$translit] =~ /[^\s\#]/);
		my $SentencePause = !($SENTENCEtier[$sentence] =~ /[^\s\#]/);
		if(($TranslitPause && $SentencePause) ||
			(!$TranslitPause && !$SentencePause))
		{
			$TRANSLITIDtier[$translit] = $SENTENCEIDtier[$sentence];
			++$translit;
			++$sentence;
		}
		elsif($TranslitPause)
		{
			my $TranslitIDcode = $TRANSLITIDtier[$translit - 1] if $translit > 0;
			$TranslitIDcode = $SENTENCEIDtier[0] unless $translit > 0;
			$TranslitIDcode = IncreaseIDcode($TranslitIDcode);
			$TRANSLITIDtier[$translit] .= $TranslitIDcode.'-A';
			++$translit;
		}
		else
		{
			++$sentence;
		};
	};
};

#
# Make formatted (Praat) output
#
# Get the names of the requested tiers
my @PrintedTiers = grep(/\S/, map {scalar(@{$_."tier"}) ? $_ : "";} @AllTiers);

if($FORMAT eq 'PRETTY')
{
	# 
	# Perform a formatted test print of the output
	#
	my $NextTime = 0;
	my $DoSomething = 1;
	#
	# Align the tiers
	my %Align = ();
	my $Tier;
	foreach $Tier (@PrintedTiers)
	{
		next unless scalar(@{$Tier."tier"});
		my $ItemCode = ${$Tier};
		# 
		my $CurrentTier = \@{$Tier.'tier'};	
		my $CurrentIDTier = \@{$Tier.'IDtier'};
		my $i;
		for($i=0; $i < scalar(@$CurrentTier); ++$i)
		{
			my $CurrentLength = length($$CurrentTier[$i]);
			$Align{$Tier} = $CurrentLength if $CurrentLength > $Align{$Tier};
			if($ItemCode =~ /(ID|IDFOLDED)$/)
			{
				$CurrentLength = length($$CurrentIDTier[$i]);
				$Align{$Tier."ID"} = $CurrentLength if $CurrentLength > $Align{$Tier."ID"};
			};
		};
	};

	# Print all tiers
	while($DoSomething)
	{
		$DoSomething = 0;
		my $ThisTime = -1;
		my $Tier;
		
		foreach $Tier (@PrintedTiers)
		{
		    next unless scalar(@{$Tier."tier"});
		    my $ItemCode = $Tier;
			# Now here an ugly clutch to work around being unable to construct variable names
			my $CurrentTier = \@{$Tier.'tier'};;
			my $CurrentIDTier = \@{$Tier.'IDtier'};
			my $CurrentStart = \@{$Tier.'start'};;
			my $CurrentEnd = \@{$Tier.'end'};;

			# Print the values (the odd offset is added to cure an extremely obscure rounding problem)
			if($$CurrentStart[0] <= ($NextTime + 1e-8))
			{
				my $IDcode = $ItemCode =~ /(ID|IDFOLDED)$/ ? shift(@$CurrentIDTier) : "";
				my $PrintText = shift(@$CurrentTier);
				my $IDalign = $Align{$Tier.'ID'};
				printf("%-${IDalign}s ", $IDcode);
				my $Textalign = $Align{$Tier};
				printf("%-${Textalign}s\t", $PrintText);
				my $TierTime = shift(@$CurrentEnd);
				$ThisTime = $TierTime if ($ThisTime < 0) || ($TierTime < $ThisTime);
				shift(@$CurrentStart);
				$DoSomething = 1 if @$CurrentTier;
			}
			else
			{
				print TARGET ' 'x($Align{$Tier}+$Align{$Tier.'ID'}+1), "\t";
			};
		};
		print TARGET "\n";
		$NextTime = $ThisTime;
	};
}
else
{
	print TARGET << "LABELEND";
File type = "ooTextFile short"
"TextGrid"

0
$DURATION
<exists>
LABELEND

	my $NumberOfTiers = 0;
	my $Tier;

	foreach $Tier (@PrintedTiers) { $NumberOfTiers += ($Tier =~ /ID$/) ? 2 : 1;};
	print TARGET "$NumberOfTiers\n";

	my $Tier;
	foreach $Tier (reverse(@PrintedTiers))
	{
		# 
		my $CurrentTier = \@{$Tier.'tier'};
		my $CurrentIDTier = \@{$Tier.'IDtier'};
		my $CurrentStart = \@{$Tier.'start'};
		my $CurrentEnd = \@{$Tier.'end'};
		my $PrintFoldedIDcode = (${$Tier} =~ /IDFOLDED$/i);
		# The tier with the values
		print TARGET "\"IntervalTier\"\n";
		print TARGET "\"$Tier\"\n";
		print TARGET "0\n";
		print TARGET "$DURATION\n";
		print TARGET scalar(@$CurrentTier), "\n";

		my $Interval;
		for($Inteval=0; $Interval < scalar(@$CurrentTier); ++$Interval)
		{
			print TARGET $$CurrentStart[$Interval] ? $$CurrentStart[$Interval] : '0', "\n";
			print TARGET "$$CurrentEnd[$Interval]\n";
			my $PrintText = "";
			# Fold the ID codes into the tier labels
			$PrintText .= $$CurrentTier[$Interval];
			$PrintText .= '__' . $$CurrentIDTier[$Interval] if $PrintFoldedIDcode;			
			$PrintText =~ s/([\'\"\`])/$1$1/g;
			print TARGET "\"$PrintText\"\n";
		};

		# Skip the item codes unless they are required
		my $ItemCode = eval("\$$Tier;");
		next unless $ItemCode =~ /ID$/;

		# The tier with the IDcodes
		print TARGET "\"IntervalTier\"\n";
		print TARGET "\"${Tier}ID\"\n";
		print TARGET "0\n";
		print TARGET "$DURATION\n";
		print TARGET scalar(@$CurrentIDTier), "\n";

		my $Interval;
		for($Inteval=0; $Interval < scalar(@$CurrentIDTier); ++$Interval)
		{
			print TARGET $$CurrentStart[$Interval] ? $$CurrentStart[$Interval] : '0', "\n";
			print TARGET "$$CurrentEnd[$Interval]\n";
			print TARGET "\"$$CurrentIDTier[$Interval]\"\n";
		};
	};

};
	return 1;
};

my $ID = shift(@ARGV) || die "No speaker ID\n";

# Sentences and lists
foreach $FileType ('1FS', '2VS', '2PS', '1FW', '2VW', '1FY', '2VY', '1FPA1', '1FPA2', '2FPB1', '2FPB2')
{
  my $FileID = "${FileType}";
  my $FORMAT = "";

  convert_text_to_labels($ID, $FileID, $FORMAT);
};

# Chunks
foreach $FileType ('1VI', '1FT', '1FR', '2VT', '2VR')
{
	my $Chunk = 1;
	while(-e "$Transcriptions$ID/$ID$FileType$Chunk.txt")
	{
  		my $FileID = "${FileType}$Chunk";
  		my $FORMAT = "";

  		convert_text_to_labels($ID, $FileID, $FORMAT);
		++$Chunk;
	};
};

