#! /usr/bin/perl
#
# Read a Praat speech file and create a corresponding Formants file
# with all the formants tracked (smoothened).
#
# CreateFormants.pl SpeakerID [FilePattern]
#
# FilePattern is a RegExp pattern $FileName =~ m@($FilePattern)@
#
###############################################################################
#
# Copyright R.J.J.H. van Son © 2000, 2001
#
# Author Rob van Son
# Institute of Phonetic Sciences & ACLC
# University of Amsterdam
# Herengracht 338
# NL-1016CG Amsterdam, The Netherlands
# Email: Rob.van.Son@hum.uva.nl
#        rob.van.son@workmail.com
# WWW  : http://www.fon.hum.uva.nl/rob/
# mail:  Institute of Phonetic Sciences
#        University of Amsterdam
#        Herengracht 338
#        NL-1016CG Amsterdam
#        The Netherlands
#        tel +31 205252183
#        fax +31 205252197
#
# License for use and disclaimers
#
# 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.
#
#
#######################################################
#

$HomeDir = '..';
require "$HomeDir/Links.pl";

# Use alternate datapaths
if(grep(/\-\-datapath/i, @ARGV))
{
	my $i;
	for($i=0; $i < $#ARGV; ++$i)
	{
		if($ARGV[$i] =~ /\-\-datapath/i)
		{
			$DataPath = $ARGV[$i+1];
			splice(@ARGV, $i, 2);
			
		};
	};
	
};

my $SoundFiles  = "$DataPath/$Sentences";
my $SmoothFormantFiles  = "$DataPath/$SmoothFormants";

sub create_Formantdirectory  # ($ID) -> 1/0 create directory if necessary
{
	my $ID = shift || return 0;
	#
	(mkdir("$SmoothFormantFiles", 0744) || die "$SmoothFormantFiles: $!\n") unless -d "$SmoothFormantFiles";
	(mkdir("$SmoothFormantFiles/fm", 0744) || die "$SmoothFormantFiles/fm: $!\n") unless -d "$SmoothFormantFiles/fm";
	my $DirExists = -d "$SmoothFormantFiles/fm/$ID";
	(mkdir("$SmoothFormantFiles/fm/$ID", 0744) || die "$SmoothFormantFiles/fm/$ID: $!\n") unless $DirExists;
	#
	(mkdir("$SmoothFormantFiles/hm", 0744) || die "$SmoothFormantFiles/hm: $!\n") unless -d "$SmoothFormantFiles/hm";
	$DirExists = -d "$SmoothFormantFiles/hm/$ID";
	(return mkdir("$SmoothFormantFiles/hm/$ID", 0744) || die "$SmoothFormantFiles/hm/$ID: $!\n") unless $DirExists;
	return 0;   # Nothing done
}

# Store the first 3 formants as a Table of Real
# The first column contains the time points, the
# other three contain the formant values
# formant values can be retrieved with:
# ('time' is the point in time for which you want the value
# this does a linear interpolation)
#
# form
#    integer formant_(1..3) 1
#    positive time_(seconds) 0.5 
# endform
#
# # Convert formant to column
# column = 'formant' + 1
#
# # Get the "sampling frequency"
# x1 = Get value... 1 1
# x2 = Get value... 2 1
# dx = 'x2' - 'x1'
#
# # Convert time to row, and get the two nearest rows
# row = ('time' - 'x1')/'dx'
# row1 = floor('row')
# row2 = ceiling('row')
# 
# # Get the surrounding values and interpolate
# value1 = Get value... 'row1' 'Column'
# value2 = Get value... 'row2' 'Column'
# value = 'value1' + ('value2' - 'value1')*('row' - 'row1')
#
# Value is the formant value at time t
# 
#
# Set upper boudaries for male vs female voices
my $MaleUpperBoundary = 5000;
my $FemaleUpperBoundary = 5500;

# The actual script for calculations
my $UpperBoundaryPosition = 2;  # Position of Upper Boundary value in script
@Formantcalculations = (
"Rename... Label\n",
"select Sound Label\n",
"To Formant (burg)... 0.001 5 $FemaleUpperBoundary 0.025 50\n",
"Track... 3 550 1650 2750 3850 4950 1 1 1\n",
"Rename... Formants\n",
"Down to FormantTier\n",
"Down to TableOfReal... yes no\n",
"select TableOfReal Formants\n"
);

sub create_praat_script	# ($ID` [,$Pattern]) -> @PraatScript;
{
	my $ID = shift || return ();
	my $Pattern = shift || ".";

	my @PraatScript = ();

	foreach $Channel ('fm', 'hm')
	{
		my @FileList = glob("$SoundFiles/$Channel/$ID/*");
		foreach $FilePath (@FileList)
		{
			# Check whether this file is wanted (needed when several copies of this script are running)
			next unless $FilePath =~ m@($Pattern)@;
			
			$FilePath =~ m@/([^/]+)/([^/]+)$@;
			
			my $Speaker = $1;
            my $Gender = $Speaker =~ /^M\d+[A-Z]/i ? "M" : "F";
			my $FileName = $2;
			
			create_Formantdirectory($Speaker);
			
			$FileName =~ s/\.[\w]+$//ig;
			die "$FilePath does not contain a filename\n" unless $FileName =~ /\w/;
			
			my $TargetFile = "$SmoothFormantFiles/$Channel/$Speaker/$FileName.SmoothFormants";
			# Skip existing file names
			next if -e $TargetFile;

			# Replace Female with Male upper boundary if necessary
            my @TemporaryScript = @Formantcalculations;
            $TemporaryScript[$UpperBoundaryPosition] =~ 
                s/ $FemaleUpperBoundary / $MaleUpperBoundary /g if $Gender eq 'M';
            
			# The actual script
			push(@PraatScript, "Read from file... $FilePath\n");
			push(@PraatScript, @TemporaryScript);
			push(@PraatScript, "Write to binary file... $TargetFile\n");
			push(@PraatScript, "select all\n");
			push(@PraatScript, "Remove\n");
		};
	};

	return @PraatScript;
};

# Process all if no argument is given
@ARGV = ('F20N', 'F28G', 'F40L', 'F60E', 'M15R', 'M40K', 'M56H', 'M66O') unless scalar(@ARGV);
my $ID;
while($ID = shift(@ARGV))
{
	# -pPattern, --pattern Pattern -> Pattern is used, else use '.'
	my $Pattern = '.';
	if($ARGV[0] =~ /\-(p|\-pattern)/i)
	{
		$Pattern = $';
		$Pattern = shift(@ARGV) unless $Pattern;
	};
	
	my @MasterPraatScript = create_praat_script($ID, $Pattern);

	# Execute Praat script
	if(@MasterPraatScript)
	{
		open(PRAAT, "|praat - |sed 's/Praat > //g'") || die "praat: $!\n";
		foreach $Line (@MasterPraatScript)
		{
			print PRAAT $Line;
		};
		# Close this session
		print PRAAT "Quit\n";
		close(PRAAT);
	};
};
exit;


