#!/usr/bin/perl
# mlf2praat.pl: Mark Hasegawa-Johnson, 12/2/2003
# Illinois Speech and Language Engineering (ISLE group)
#
# Usage text (printed if mlf2praat.pl is called with any arguments):
$USAGE=<<ENDUSAGE;

mlf2praat.pl: Convert HTK master label file to Praat TextGrid files.

Usage: mlf2praat.pl SCP_file input.mlf
 SCP_file: text file, in format useful to HCopy
 input.mlf: input HTK-format master label file

Each line in SCP_file is assumed to contain one output filename and
one input filename.  MLF2PRAAT ignores the extensions of both files;
the output file extension is replaced with "TextGrid," and the input
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 through input.mlf for an entry headed by
"*/t1u1.lab"; this entry will be converted to a TextGrid, and written
out to c:/database/talker1/utt1.TextGrid.  The output directory must
already exist.

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 MLF entry and write as a TextGrid file
#
# Syntax: mlf2textgrid($outfile, $data)
#
# "$outfile.TextGrid" is name of the output file; directory must exist
# $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 mlf2textgrid {
  # Get rid of any file extension
  my($filename) = $_[0];
  $filename =~ s/(\.\S*)//;
  my($data) = $_[1];
  my($tier) = [];

  # Open the TEXTGRID file
  open(TEXTGRID, ">${filename}.TextGrid") ||
    die "Unable to write to ${filename}.TextGrid: $!";

  # Get start, end, and numlevels of MLF
  my(@stats) = mlfnumlevels($data);

  # Print the TEXTGRID header
  print TEXTGRID 'File type = "ooTextFile"',"\n";
  print TEXTGRID 'Object class = "TextGrid"',"\n\n";
  print TEXTGRID 'xmin = ', $stats[1], "\n";
  print TEXTGRID 'xmax = ', $stats[2], "\n";
  print TEXTGRID 'tiers? <exists>',"\n";
  print TEXTGRID 'size = ', $stats[0], "\n";
  print TEXTGRID 'item []: ',"\n";

  for($j=1; $j <= $stats[0]; $j++) {
    $tier = extract_layer($data, $j);
    print TEXTGRID sprint_textgrid_tier($tier, $j, $stats[1], $stats[2]);
  }
  close(TEXTGRID);
}

###################################################
# Subroutine to read MLF entry
#
# Syntax: $data = read_MLF_entry(\*MLF_FILE)
#
# Returned value $data is an arrayref of arrayrefs
# $$tran[0][0] is first seg start time, $$tran[0][1] is end time,
# @$$tran[0][2..$#{$$tran[0]}] is the sequence of labels at first time.
#
sub read_MLF_entry {
  my($fh) = $_[0];
  my(@tran) = ();
  my(@labels) = ();
  
  # Read all continuous lines that begin with a char other than period
  for($l = <$fh>; $l !~ /^\./; $l = <$fh>) {
    # Option 1: line is in "time time labels" format
    if ($l=~/(\d+)\s+(\d+)\s+(.*)/ ) {
      @labels = split(/\s+/,$3);
      push(@tran, [ $1 * $MLFPERIOD, $2 * $MLFPERIOD, @labels ] );
    }
    # Option 2: line contains any non-whitespace labels, but no times
    elsif ($l =~ /\S/) {
      @labels = split(/\s+/,$l);
      push(@tran, [ 0, 0, @labels ] );
    }
  }
  return(\@tran);
}

###################################################
# @stats = mlfnumlevels($data)
#   $data is an MLF entry = arrayref of arrayrefs
#   @stats = ( numlevels, start time, end time )
#
sub mlfnumlevels {
  my($data) = $_[0];

  my(@stats) = ($#{$$data[0]}, $$data[0][0], $$data[0][1]);

  foreach $w (@$data) {
    if($#$w > $stats[0]) { $stats[0] = $#$w; }
    if($$w[0] < $stats[1]) { $stats[1] = $$w[0]; }
    if($$w[1] > $stats[2]) { $stats[2] = $$w[1]; }
  }
  $stats[0]--;
  return(@stats);
}

###################################################
# Print a TextGrid tier
#
# Syntax: sprint_textgrid_tier(\@data, $number, $starttime, $endtime)
#
sub sprint_textgrid_tier {
  my($phndata) = $_[0];
  my($number) = $_[1];
  my($starttime) = $_[2];
  my($endtime) = $_[3];

  # Start with "item [$number]"
  my($output) = "    item [$number]:\n";
  $output .= "        class = \"IntervalTier\"\n"; 
  $output .= "        name = \"tier${number}\"\n"; 
  $output .= "        xmin = $starttime\n";
  $output .= "        xmax = $endtime\n";
  $output .= sprintf("        intervals: size = %d\n", $#$phndata + 1);

  # Print out the converted data 
  foreach $nt (0..$#$phndata) {
    $output .= sprintf("        intervals [%d]:\n",$nt+1);
    $output .= "            xmin = $$phndata[$nt][0]\n";
    $output .= "            xmax = $$phndata[$nt][1]\n";
    $output .= "            text = \"$$phndata[$nt][2]\"\n";
  }
  return($output);
}

###################################################
# Extract the $n'th layer from a multi-layer MLF entry
#
# Syntax: $t0 = extract_layer($t1, $n)
#
# $t1 and $t0 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.
#
# $n specifies the layer number to be extracted from $t1 to $t0.
#   The first layer is layer number 1.
#
sub extract_layer {
  my($t1) = $_[0];
  my($n) = $_[1];
  my(@t0) = ();
  my($r) = [];

  foreach $w (@$t1) {
    # If layer $n has an element, write previous @r, and start new one
    if (exists($$w[$n+1])) {
      if(@$r > 0) { push(@t0, $r); }
      $r = [ $$w[0], $$w[1], $$w[$n+1] ];
    }
    # Otherwise, if a record has been started, increase its end time
    elsif (@$r > 0) { $$r[1] = $$w[1]; }
  }
  # Push the last record
  if(@$r > 0) { push(@t0, $r); }  

  return(\@t0);
}

################################################################
# Main program

if (@ARGV==0) { print STDERR $USAGE; exit; }
if (@ARGV < 2) { die "Usage: mlf2praat.pl scp_file mlf_file\n"; }
 
# Read all MLF entries from STDIN
open(MLF_FILE, $ARGV[1]) || die "Unable to read MLF from $ARGV[1]\n";
while (<MLF_FILE>) {
  # If this line starts a transcription, read it
  if (/\".*\/([^\/\.]+)[^\/]*\"/) {
    my($filename) = $1;
    $IMLF{$filename} = read_MLF_entry(\*MLF_FILE);
  }
  else { print STDERR "Unable to read filename from $_\n"; }
}
close(MLF_FILE);

# Read in the script from argument files
open(SCP_FILE, $ARGV[0]) || die "Unable to read SCP from $ARGV[0]\n";
while (<SCP_FILE>) {
  # If a filename pair found on this line, convert MLF entry to TextGrid
  if (/^\s*([^\s\.]+).*[ \t\/]([^\/\.]+)\./) {
    # If the MLF entry exists, convert it to a TextGrid
    if(exists($IMLF{$2})) { 
      print STDERR "$2.lab -> $1.TextGrid\n";
      mlf2textgrid($1,$IMLF{$2}); 
    }
    else {
      print STDERR "MLF entry $2 does not seem to exist, input line: $_\n";
      }
  }
  else {
    printf STDERR "Unable to find two filenames on this line: $_\n";
  }
}
close(SCP);
