#! /usr/bin/perl
#
# Read a Praat label phoneme file and add POS tags and word and syllable frequencies, 
#
###############################################################################
#
# 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.
#
#
#######################################################
#
use SDBM_File;
use POSIX;

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

push(@INC, '/home/rob/OSS/GTPhconv', "$Scripts");
$DBMconnect = require 'GTPhconvdbm.pl' || die "'GTPhconvdbm.pl' $!\n";

require "$Scripts/TranscribeClass.pl";
require "$Scripts/TranscribeFrequency.pl";
require "$Scripts/TranscribeSyllFreqCGN.pl";

my $DatabaseTables = "$HomeDir/DatabaseFiles";

my $FilesWritten = 0;


# Make sure the target directory exists
sub create_Labeldirectory  # ($ID, $LabelType) -> 1/0 create directory if necessary
{
    my $ID = shift || return 0;
    my $LabelType = shift || return 0;
    #
    my $DirExists = -d "$SentenceLabels/$ID/$LabelType";
    (return mkdir("$SentenceLabels/$ID/$LabelType", 0744) || die "$SentenceLabels/$ID/$LabelType: $!\n") unless $DirExists;
    return 0;   # Nothing done
}

# Read label files
my $Ln2 = log(2);
sub transcribe_phoneme_file      # ($ID, $FileID)
{
    my $ID = shift || die "No speaker ID\n";
    my $FileID = shift || die "No file ID\n";
    
    # Create target directory if necessary
    my $LabelType = "celex";
    create_Labeldirectory($ID, $LabelType);
    
    # Don't change existing files
    my $TargetFile = "$SentenceLabels/$ID/$LabelType/$FileID.$LabelType";
#    return 0 if (-e "$TargetFile");
    
    # read source label file
    my $Label = new SentenceLabel;
    $Label->ReadLabelFile("$SentenceLabels/$ID/phoneme/$FileID.phoneme");
    
    # Add a Part-Of-Speech tier
    $Label->copyTier('POS', 'WORDS');

    # fill it
    $Label->presetItem('POS');
    while($Label->nextItem('POS') > -1)
    {
        my $Text = $Label->currentValue('POS');
        $Text =~ s/[\'\`]+/\'/g;
        my $NewText = 'NULL';
	if($FileID !~ /((FP[AB]\d+)(HVD|VCV|VOW))|[FV]Y/)
	{
	    # Remove '='
	    $Text =~ s/\=//ig;
	    $NewText = ::TranscribeClassString($Text) if $Text =~ /\S/;
	    $NewText = 'NULL' if $NewText =~ /[\*\#]/;
	    chomp($NewText);
	    $NewText =~ s/(\s*[\[\]]\s*)//ig;
	};
    	$Label->currentValue('POS', $NewText);
    };
    
    # Add a WordFrequency tier
    $Label->copyTier('WORDFREQ', 'WORDS');

    # fill it
    $Label->presetItem('WORDFREQ');
    while($Label->nextItem('WORDFREQ') > -1)
    {
        my $Text = $Label->currentValue('WORDFREQ');
        $Text =~ s/[\'\`]+/\'/g;
        my $NewText = 'NULL';
	if($FileID !~ /((FP[AB]\d+)(HVD|VCV|VOW))|[FV]Y/)
	{
	    # Remove '='
	    $Text =~ s/\=//ig;
	    $NewText = ::TranscribeFrequencyString($Text) if $Text =~ /\S/;
	    $NewText = 'NULL' if $NewText =~ /[\*\#]/;
	    chomp($NewText);
	    if($NewText =~ /\[\s*([^\]]+)\s*\]/)
	    {
	    	my @FreqList = split(" ", $1);
		my $SumFreq = 0;
		map {$SumFreq += 2**(- $_);} @FreqList;
	        $NewText = - log($SumFreq) / $Ln2;
	    };
	};
	$NewText = sprintf("%6.3F", $NewText) unless $NewText eq 'NULL';
    	$Label->currentValue('WORDFREQ', $NewText);
    };
    
    # Add a Syllable Frequency tier
    $Label->copyTier('SYLLFREQ', 'SYLLABLES');

    # fill it
    $Label->presetItem('SYLLFREQ');
    while($Label->nextItem('SYLLFREQ') > -1)
    {
        my $Text = $Label->currentValue('SYLLFREQ');
        $Text =~ s/[\'\`]+/\'/g;
        my $NewText = 'NULL';

	# Remove '='
	$Text =~ s/[\=\"]//ig;
	$NewText = ::TranscribeSyllFreqCGNString($Text) if $Text =~ /\S/;
	$NewText = 'NULL' if $NewText =~ /[\*\#]/;
	chomp($NewText);
	$NewText = sprintf("%6.3F", $NewText) unless $NewText eq 'NULL';
    	$Label->currentValue('SYLLFREQ', $NewText);
    };
    
    # Add a Lexical Syllable Frequency tier
    $Label->copyTier('LEXSYLLFREQ', 'LEXSYLL');

    # fill it
    $Label->presetItem('LEXSYLLFREQ');
    while($Label->nextItem('LEXSYLLFREQ') > -1)
    {
        my $Text = $Label->currentValue('LEXSYLLFREQ');
        $Text =~ s/[\'\`]+/\'/g;
        my $NewText = 'NULL';

	# Remove '='
	$Text =~ s/[\=\"]//ig;
	$NewText = ::TranscribeSyllFreqCGNString($Text) if $Text =~ /\S/;
	$NewText = 'NULL' if $NewText =~ /[\*\#]/;
	chomp($NewText);
	$NewText = sprintf("%6.3F", $NewText) unless $NewText eq 'NULL';
    	$Label->currentValue('LEXSYLLFREQ', $NewText);
    };
    
    # Write the result to the destination file
    $Label->FoldedIDcodes('TRANSLIT', 'WORDS', 'CGN', 'POS', 'WORDFREQ', 
    'SYLLABLES', 'SYLLFREQ', 'LEXSYLLFREQ');
    $Label->print($TargetFile, 'TRANSLIT', 'WORDS', 'CGN', 'POS', 'WORDFREQ', 
    'SYLLABLES', 'SYLLFREQ', 'LEXSYLLFREQ');
};

sub Transcribe_All_Sentences # ($ID) -> 0/1;
{
    my $ID = shift || return ();
    
    #
    # Run Fixed transcription list through TranscribeCLASS
    open(TRANSCRIPTION, "<FixedLexemes.txt") || die "FixedLexemes.txt: $!\n";
    while(<TRANSCRIPTION>)
    {
        ::TranscribeClassString($_);
        ::TranscribeFrequencyString($_);
    };
    my @FileList = glob("$SentenceLabels/$ID/phoneme/*.phoneme");
    foreach $FilePath (@FileList)
    {
        $FilePath =~ m@/([^/]+)/phoneme/([^/]+)$@;
        my $Speaker = $1;
        my $FileName = $2;
        $FileName =~ s/\.[\w]+$//ig;
        die "$FilePath does not contain a filename\n" unless $FileName =~ /\w/;
#        next if -e "$SentenceLabels/$ID/$LabelType/$FileName.$LabelType";
        
	transcribe_phoneme_file($Speaker, $FileName);
    };
    return 1;
};

#
my $ID;
while($ID = shift(@ARGV))
{
    Transcribe_All_Sentences($ID);
};

