#!/usr/bin/perl
# split_waveform.pl: Mark Hasegawa-Johnson, May 2004
# Illinois Speech and Language Engineering (ISLE group)
#
# Usage text (printed if called with no arguments):
$USAGE=<<ENDUSAGE;

SPLIT_WAVEFORM.PL: chop a set of two-channel waveforms into the units 
  specified in a transcription file.  Split into "a" and "b" channels.
  Depends on the existence of 'sox.'
  Assumes that the input is two-channel data, with ONE BYTE per channel,
  in MU-LAW format, as in the Switchboard distribution.

USAGE:
  split_waveform.pl in.mlf in.scp header_length rate

ARGUMENTS:

 in.mlf - master label file specifying chop units.
     Any line whose label section has no content outside [] is ignored.
     Other lines are counted, and output file is set to
     output_directory/input_file-num.wav
     where num is the transcription line number.

 in.scp - script file, with lines in the format of
     input_file  output_directory

     Input_file must have root filename corresponding to an
     entry in in.mlf.   
     Output_directory specifies the name of the directory
     to which chop units from input_file should be written

 header_length - number of bytes to skip at the beginning of
     each input file (e.g., 1024 for NIST SPHERE files).

 rate - sampling rate, in Hertz (e.g., 16000 for TIMIT, 8000 for Switchboard)

ENDUSAGE


####################################################################
# GLOBAL VARIABLES

# Math functions
sub abs { my($x)=shift; ($x>0) ? $x : -$x ; }
sub round { $_[0] =~ /([^\.]*)(.*)/; ($2 >= 0.5) ? $1+1 : $1; }
 
###################################################
# 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, in 100ns units
# $$tran[0][1] is end time, in 100ns units
# $$tran[0][2] is the sequence of labels at first time
#
sub read_MLF_entry {
  my($filename) = $_[0];
  my($fh) = $_[1];
  my(@tran) = ();
  
  # Read all continuous lines that begin with a char other than period
  for($l=<$fh>; $l =~ /^[^\.]/; $l=<$fh>) {
    chomp; chomp;

    # Option 1: line is in "time time labels" format
    if ($l=~/(\d+)\s+(\d+)\s+(.*)/ ) {
      push(@tran, [ $1*1e-7, $2*1e-7, $3 ] );
    }
    # Option 2: line contains any non-whitespace labels, but no times
    elsif ($l =~ /\S/) {
      push(@tran, [ 0, 0, $1 ] );
    }
  }
  return(\@tran);
}

################################################################
# Main program

if (@ARGV==0) { print STDERR $USAGE; exit; }

# Arguments
$MLF=$ARGV[0];
$SCP=$ARGV[1];
$HEADER_LENGTH=$ARGV[2];
$RATE=$ARGV[3];

# Read in all lines from the INPUTFILE
open(MLF,$MLF) || die "Unable to read from $MLF: $!";
%IMLF=();
while (<MLF>) {
  # If this line starts a transcription, read it
  if (/\".*\/([^\/\.]+)[^\/]*\"/) {
    my($filename) = $1;
    # Get the root filename: any string of non-slashes
    #  terminated by a period, and completely lowercased
    $filename =~ /([^\/]+)\./;
    $rootfile=lc($1);
    $IMLF{$rootfile} = read_MLF_entry($filename,\*MLF);
  }
}

#######################
# Main loop: process each file/directory pair in the script
open(F,$SCP) || die "Unable to read from script file $SCP: $!\n";
$script = ''; while (<F>) { $script .= $_; }
close(F);
while($script =~ s/^\s*(\S+)\s+(\S+)//) {
  $filename = $1;
  $outdir = $2;
  
  # If outdir doesn't exist, try to make it
  unless ( -e $outdir ) { mkdir $outdir; }
  
  # Get the root filename: any string of non-slashes
  #  terminated by a period, and completely lowercased
  $filename =~ /([^\/]+)\./;
  $rootfile=lc($1);
  # If $rootfile contains sw0, get rid of the zero
  $rootfile=~s/sw0/sw/i;
  
  # If transcription doesn't exist, skip it
  unless(exists $IMLF{$rootfile."a"} || exists $IMLF{$rootfile."b"})  {
    print STDERR "Unable to find transcription for ", 
      $rootfile."a", " or ", $rootfile."b\n";
    next;
  }
	 
  # If input file doesn't exist, skip this
  unless(open(INFILE,$filename)) {
    print STDERR "Unable to read from file $filename";
    next;
  }
  
  # Now read all of the sub-file definitions
  foreach $chnl ("a","b") {
    # Number of lines read for this channel
    $num_read=0;
  
    foreach $arr (@{$IMLF{$rootfile.$chnl}}) {
      # If this utterance matches [laughter-word], extract the word
      if($$arr[2] =~ /^\s*\[laughter-(.*)\]\s*$/) { $$arr[2] = $1; }
    
      # If this utterance matches [word1/word2], extract word2
      if($$arr[2] =~ /^\s*\[.*\/(.*)\]*$/) { $$arr[2] = $1; }
    
      # Now that those special cases have been taken care of,
      # Skip this one if label matches ^\s*\[.*\]\s*$
      unless($$arr[2] =~ /^\s*\[.*\]\s*$/) {
	# Increment the number of lines read
	$num_read++;
      
	# Figure out where the data segment is
	$start_word = 2*sprintf("%.0f",$$arr[0] * $RATE);
	$end_word = 2*sprintf("%.0f",$$arr[1] * $RATE + 0.9);

	# Read it from INFILE
	seek(INFILE,$start_word+$HEADER_LENGTH,0);
	read(INFILE,$chnldat,$end_word-$start_word);

	# Get rid of every other byte
	if ($chnl eq "a") { $chnldat =~ s/(.)./\1/g; }
	else { $chnldat =~ s/.(.)/\1/g; }

	# Write the output data
	open(OUTFILE,">tmp.raw") || die "Unable to write to tmp.raw: $!";
	print OUTFILE $chnldat;
	close(OUTFILE);

	# Write out the correct data segment, and
	# Use sox to convert it to WAV format
	$cmd="sox -U -b -r $RATE -t raw -c 1 tmp.raw -w -s tmp.wav";
	print STDERR $cmd,"\n";
        `$cmd`;
	
	# Move to outfile
	$outfile=sprintf("%s/%s%s-%4.4d.wav",$outdir,$rootfile,$chnl,$num_read);
	`mv tmp.wav $outfile`;
	print STDERR "mv tmp.wav $outfile\n";
      }
    }
    unlink("tmp.raw");
  }

  
}

