#! /usr/bin/perl
#
# Read a Praat speech file and create a corresponding Intensity file.
#
# CreateIntensity.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 $IntFiles    = "$DataPath/$Intensity";

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

@Intcalculations = (
"Rename... Label\n",
"select Sound Label\n",
"To Intensity... 100 0.001\n",
"Rename... Int\n",
"select Intensity Int\n"
);

sub create_praat_script	# ($ID) -> @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 $FileName = $2;
			
			create_Intdirectory($Speaker);
			
			$FileName =~ s/\.[\w]+$//ig;
			die "$FilePath does not contain a filename\n" unless $FileName =~ /\w/;
			
			my $TargetFile = "$IntFiles/$Channel/$Speaker/$FileName.Intensity";
			# Skip existing file names
			next if -e $TargetFile;

			# The actual script
			push(@PraatScript, "Read from file... $FilePath\n");
			push(@PraatScript, @Intcalculations);
			push(@PraatScript, "Write to binary file... $TargetFile\n");
			push(@PraatScript, "select all\n");
			push(@PraatScript, "Remove\n");
		};
	};

	return @PraatScript;
};
	

my $ID = shift(@ARGV) || exit;
my @DirectoryList = glob("$SoundFiles/fm/$ID");
my $CurrentPath;
foreach $CurrentPath (@DirectoryList)
{
	$CurrentPath =~ m@/([^/]+)$@;
    my $CurrentID = $1;
	create_Intdirectory($CurrentID);
	my @MasterPraatScript = create_praat_script($CurrentID, $Pattern);

	# Execute Praat script
	if(@MasterPraatScript)
	{
		open(PRAAT, "|praat -") || die "praat: $!\n";
		foreach $Line (@MasterPraatScript)
		{
			print PRAAT $Line;
		};
		print PRAAT "Quit\n";
		close(PRAAT);
	};
};

exit;


