#!/usr/bin/perl
# praat2mlf.pl: Mark Hasegawa-Johnson, 12/3/2003
# Illinois Speech and Language Engineering (ISLE group)
#
# Usage (printed if praat2mlf.pl is called with no arguments):
#
$USAGE=<<ENDUSAGE;

PRAAT2MLF: Convert Praat ASCII TextGrid transcriptions to HTK MLF format
 
Usage:
  praat2mlf.pl n1 n2 n3 < SCP_file > output.mlf
Example: 
  praat2mlf.pl 3 1 2 < TRAIN.scp > TRAIN.mlf
 
 SCP_file: text file, in format useful to HCopy
 output.mlf: output HTK-format master label file

Each line in SCP_file is assumed to contain one input filename and one
output filename.  PRAAT2MLF ignores the extensions of both files; the
input file extension is replaced with "TextGrid," and the output file
extension is replaced with "lab."  For example, if SCP_file contains
the line "c:/database/talker1/utt1.wav data/t1u1.mfc", then PRAAT2MLF
will look for the input file c:/database/talker1/utt1.TextGrid,
convert it to an MLF entry, and head the MLF entry with the line
"*/t1u1.lab".

PRAAT2MLF reads in the tiers in the TextGrid, and arranges them into
an MLF hierarchical transcription in the order given on the command
line, e.g., "3 1 2" means that tier[2] should be level[1], tier[3]
should be level[2], and tier[1] should be level[3].  Each interval
start time or point time in level[n] is rounded to the nearest interval
start time or point time in level[n-1].  Interval end times in level[n],
for n>1, are completely ignored.

Binary-format TextGrids are not supported; use "Save as text" in
Praat.

ENDUSAGE

####################################################################
# GLOBAL VARIABLES

# Conversion rates for various file formats
$MLFPERIOD = 0.0000001;

# Math functions
sub abs { my($x)=shift; ($x>0) ? $x : -$x ; }

###################################################
# Subroutine to read TextGrid and convert to MLF format.
#
# Syntax: $mlf_entry = textgrid2mlf($infile, $outfile)
#
sub textgrid2mlf {
  # Get rid of any file extension
  my($filename) = $_[0];
  $filename =~ s/(\.\S*)//;
  my($outfile) = $_[1];
  my($TIER2LEVEL) = $_[2];

  # Read in the TextGrid
  open(TEXTGRID, "${filename}.TextGrid") || die 
    "Unable to read from ${filename}.TextGrid: $!";
  my($hdr) = read_textgrid_header(\*TEXTGRID);

  my(@tiers) = ();
  until(eof(TEXTGRID)) { push(@tiers, read_textgrid_tier(\*TEXTGRID)); }
  close(TEXTGRID);
  
  # Re-arrange tiers to levels
  my(@levels) = ();
  foreach (0..$#{$TIER2LEVEL}) 
    { $levels[$$TIER2LEVEL[$_]-1] = $tiers[$_]; }

  # Merge higher-level transcriptions into lower-level
  for ($j=$#levels; $j > 0; $j--) {
    $levels[$j-1] = merge_transcriptions($levels[$j-1], $levels[$j]);
  }
  
  # Return the MLF entry
  return(sprint_MLF_entry($outfile, $levels[0]));
}  
  
###################################################
# Subroutine to read textgrid header
#
# Usage: $hdr = read_textgrid_header(\*FILE)
#
sub read_textgrid_header {
  my($fh) = $_[0]; my(%hdr) = ();

  # Read until we find a line containing the word "item"
  for ($l = <$fh>; $l !~ /item/; $l = <$fh>) {
    # Create a header struct entry if line has format X = Y
    if($l =~ /(\S+) = (\S+)/) { $hdr{$1} = $2; }
  }
  # Return the header
  return(\%hdr);
}

###################################################
# Subroutine to read textgrid tier
#
# Usage: $data = read_textgrid_tier(\*FILE)
#
# $data is an arrayref of arrayrefs
# $$data[$i][0] is start time of $ith interval, or time of $ith point
# $$data[$i][1] is end time of $ith interval, or time of $ith point
# @$$data[$i][2] is the text of $ith interval or point
#
sub read_textgrid_tier {
  my($fh) = $_[0]; 
  my(@tier) = (); my($tn) = 0;
  # Read past any initial lines containing the word "item"
  for($l = <$fh>; $l =~ /item/; $l = <$fh>) {}
  
  # Now continue until we encounter the start of the next item, or EOF
  while(defined($l) && $l !~ /item/) {
    # If this line starts an interval or point, read the interval number
    if($l =~ /intervals \[(\d+)\]/) { $tn = $1 - 1; }
    if($l =~ /points \[(\d+)\]/) { $tn = $1 - 1; }
    
    # If this line specifies a start time, end time, or point time, read it
    if($l =~ /xmin = (\S+)/) { $tier[$tn][0] = $1; }
    if($l =~ /xmax = (\S+)/) { $tier[$tn][1] = $1; }
    if($l =~ /time = (\S+)/) { $tier[$tn][0] = $1; $tier[$tn][1] = $1; }
    
    # If this line specifies a "text" or "mark" string, read it
    if($l =~ /text = \"(.*)\"/) { $tier[$tn][2] = $1; }
    if($l =~ /mark = \"(.*)\"/) { $tier[$tn][2] = $1; }

    # Read the next line
    $l = <$fh>;
  }
  return(\@tier);
}
  
###################################################
# Merge multi-level transcriptions into a composite transcription
#
# Syntax: $t0 = merge_transcriptions($t1, $t2)
#
# $t1 and $t2 are arrayref arrayrefs.
# $$t1[0][0] is the first start time, $$t1[0][1] is first end time.
# $$t1[0][2..$#{$$t1[0]}] is the sequence of labels at first time.
#
# $t0 is constructed using start times and end times from $t1,
# and label strings consisting of space-interpolated concatenation
# of $t1 and $t2 labels.
# Each $t2 label is concatenated to the end of whichever $t1 label has
# closest start time.
#
sub merge_transcriptions {
  my($t1) = $_[0];
  my($t2) = $_[1];
  my($t0) = [];

  # First, copy $t1
  foreach $r (@$t1) { push(@$t0, [ @$r ]); }

  # Next merge $t2 transcriptions into $t0
  foreach $w (@$t2) {
    # Increment until we find the element of $t0 with closest
    # start time to $w.  This assumes that $t0 is sorted by start time.
    #Restart the counter for each $w to avoid adding phantom mlf entries
    $i = 0;
    for $x (0..$#$t0 - 1){
       if ($$t0[$x+1][0] < $$w[0])  {
          $i++;
       }   
    }
    # Concatenate the labels
    push(@{$$t0[$i]}, @$w[2..$#$w]);
  }

  return($t0);
}

###################################################
# Print phoneme data in MLF format
#
# Syntax: sprint_MLF_entry("root_filename", \@phndata)
#
sub sprint_MLF_entry {
  my($filename) = $_[0];
  my($phndata) = $_[1];
  
  # Start the output string with the output label filename
  $filename =~ s:.*/::g;
  $filename =~ s/\..*//g;
  my($output) = "\"*/$filename\.lab\"\n";

  # Print out the converted data 
  foreach $r (@$phndata) {
    my(@l) = @$r[2..$#$r];
    $output .= sprintf("%d %d ",$$r[0]/$MLFPERIOD,$$r[1]/$MLFPERIOD);
    $output .= "@l\n";
  }
  # Print final period that separates sentences
  $output .= ".\n";
  return($output);
}

###########################################
# Main Program

if (@ARGV==0) { print $USAGE; exit; }

# Set the TIER2LEVEL mapping
@TIER2LEVEL = @ARGV;

# First, read in the script file(s)
foreach (<STDIN>) {
  # Use second filename as key, first filename as value; Ignore extensions
  unless (/^\s*([^\s\.]+)\S*\s+([^\s\.]+)/) {
      printf STDERR "Unable to find two filenames on this line: $_\n";
  }
  $SCP{$2} = $1;
}


# Process input files
foreach $filename (keys %SCP) {
  printf STDERR "$SCP{$filename}.TextGrid -> ${filename}.lab\n";
  printf STDOUT textgrid2mlf($SCP{$filename}, $filename, \@TIER2LEVEL);
}
