#!/usr/bin/perl
# extractmlflayer.pl: Mark Hasegawa-Johnson
# Illinois Speech and Language Engineering (ISLE group)
#
# Usage (printed if extractmlflayer.pl is called with no arguments):
#
$USAGE=<<ENDUSAGE;

EXTRACTMLFLAYER.PL: Extract a specified layer from the input MLF

Usage:
 extractmlflayer.pl LAYER1 [LAYER2 ...] < input.mlf > output.mlf
Example:
 extractmlflayer.pl 1 3 < input.mlf > output.mlf

This script extracts the specified layers (positive integers) from
input.mlf.  The lowest layer is layer number 1.  Each symbol in LAYER
is given a span of time that spans its own row in the input MLF, in
addition to all succeeding rows that have no symbol in LAYER.

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
#
# Syntax: $data = read_MLF_entry("filename", \*INPUTFILE);
#
# 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($filename) = $_[0];
  my($fh) = $_[1];
  my(@tran) = ();
  my(@labels) = ();
  
  # Read all continuous lines that begin with a char other than period
  while(($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);
}

###################################################
# Extract the $n'th layer from a multi-layer MLF entry
#
# Syntax: $t0 = extract_layer($t1, $n1, $n2, ...)
#
# $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.
#
# $n1 specifies the level of the first layer to be extracted from $t1 to $t0.
# $n2 specifies the level of the second layer, and so on...
#
sub extract_layer {
  my($t1) = shift;
  my(@layers) = @_;
  my(@t0) = ();
  my($r) = [];
  my($entry_exists);

  foreach $w (@$t1) {
    $entry_exists=0;
    # If layer $n has an element, declare that an entry exists
    foreach $n (@layers) { if(exists($$w[$n+1])) { $entry_exists=1; }}
    # If an entry exists, write previous @r, and start new one
    if ($entry_exists>0) {
      if(@$r > 0) { push(@t0, $r); }
      $r = [ $$w[0], $$w[1] ];
      foreach $n (@layers) { push(@$r, $$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);
}

###################################################
# Print phoneme data to an MLF file
#
# Syntax: print_MLF_entry("root_filename", \@phndata, $filehandleref);
#
# The output filehandle MLF must be globally defined
# and already open.
#
sub print_MLF_entry {
  my($filename) = $_[0];
  my($phndata) = $_[1];
  my($fh) = $_[2];

  # Print the filename to the MLF
  $filename =~ s:.*/::g;
  $filename =~ s/\..*//g;
  print $fh "\"*/$filename\.lab\"\n";

  # Print out the converted data into MLF, and to the label file
  foreach $r (@$phndata) {
    my(@l) = @$r[2..$#$r];
    print $fh sprintf("%d %d ",$$r[0]/$MLFPERIOD,$$r[1]/$MLFPERIOD),"@l\n";
  }
  # Print final period that separates sentences
  print $fh '.',"\n";
}

###########################################
# Main Program

if (@ARGV==0) { print $USAGE; exit; }

@LAYERNUMBERS = @ARGV;

# Print MLF header to STDOUT
print '#!MLF!#', "\n";

# Extract from each input file in turn
while (<STDIN>) {
  # If this line starts a transcription, read it
  if (/\".*\/([^\/\.]+)[^\/]*\"/) {
    my($filename) = $1;
    $itrans = read_MLF_entry($filename,\*STDIN);
    print STDERR "$filename(@LAYERNUMBERS,0..$#$itrans) -> $filename\n";
    $otrans = extract_layer($itrans, @LAYERNUMBERS);
  
    # Print out the final merged MLF
    print_MLF_entry($filename, $otrans, \*STDOUT);
  }
}

