#!/vol/perl/bin/perl
# praat tier generator
# By Thorsten Trippel
# University of Bielefeld
# ttrippel@spectrum.uni-bielefeld.de
# June 2001
#
# This program requires perl 5.6 or higher, 
# tested on perl 5.6.0 build for sun4-solaris
#

# arguments
$tier = $ARGV[0] ; #specified tier number read in from console
$direction = $ARGV[1]; # specifies translation direction 
	               # either from SAMPA to PRAAT or from PRAAT to SAMPA
$name = $ARGV[2] ; #name of file read in from console
$output = $ARGV[3];

if ($tier=~/\D/){
	 print STDERR "
                First argument must be the 
		tiernumber to be translated, but is 
		not a number. Program aborted.\n";
		    exit;
		    }
if ($direction=~ /[^PS]/){
	 print STDERR "
		       Second argument must be P (for 
		       direction PRAAT-IPA to SAMPA) or S 
		       (for direction SAMPA to PRAAT-IPA) 
		       which it is not. Program aborted.\n";
		    exit;
		    }

my $newtiernumber = 0;

# open the file
open(FILE, "<$name") ||
die "Inputfile could not be opened, program aborted.\n";
open(OUT, ">$output") ||
die "Outputfile could not be opened, program aborted.\n
Maybe it was not even specified?\n";


while (<FILE>){
&increase_tiernumber;
&copy_tier;
#print $_;
}

# Function

# Select line 7 with string size = X without the word interval in the string
# and selecting X as an integer, writing it to a variable

sub increase_tiernumber {
  s/(?<!intervals:\s)size =\s*(\d)/sprintf("size = %s",$1+1)/e;
  if($1) {
    $newtiernumber = $1+1;
    if ($1<$tier){
		     print STDERR "
		You specified a tiernumber to be translated 
		that does not exist.\n";
		     &exit_programm}
  }
}    

# Select and copy a tier
# replacing the integer in the item [X] expression by the contend of the 
# variable created by extend_tiernumber

sub copy_tier {
undef $/ ;
$contents = $_ ; #file is read into $contents
#print $_;
#if ($contents =~ m/xmin = (\d+\.?\d*).*\n.*?xmax = (\d+\.?\d*)/g) {	
#if ($contents =~ m/Object class .*/g) {	
	if ($contents =~ m/item *\[\]: *\n*(.+)/s) {
		$cont2 = $1 ; #body of file is stored in $cont
	}
	if ($cont2 =~ m/(item\s*\[$tier\]:.*?\n.+?)item/sg) {
		$cont3 = $1 ; #specified tier is stored in $cont3
	}
	
        print OUT "$contents";

        if ($direction=~/S/){
        convert_fonts_sampa2praat($cont3);
				}
	elsif ($direction=~/P/){
        convert_fonts_praat2sampa($cont3);
				   }


    }


# select each argument of text = " " expressions of a specified tier.
# expressions into PRAAT-IPA using sampa2praat.pl

sub convert_fonts_sampa2praat {
$_=$cont3;
s/item \[$tier]/item [$newtiernumber]/;
s/(text\s*=\s*\")(.*)(\")/sprintf("%s%s%s", $1, sampa2praat($2), $3)/eg;
print OUT "$_";
}

sub convert_fonts_praat2sampa {
$_=$cont3;
s/item \[$tier]/item [$newtiernumber]/;
s/(text\s*=\s*\")(.*)(\")/sprintf("%s%s%s", $1, praat2sampa($2), $3)/eg;
print OUT "$_";
}



sub sampa2praat {
# Preprocessing rule needs to replacs X-Sampa J\ by 
# "iotbackslash" due to otherwise multiple-matching substrings
# no other way of expressing regular expressions have been found due to a
# lack of a sufficient delimiting character (i.e. whitespace, etc.)

# For historic reasons the keys of the hashes are PRAAT-representations
# this does not have any consequences as long as the IPA characters exist 
# in both notations. However the PRAAT manual does not specify the following 
# characters (which are existend in the IPA chart with symbols in SAMPA 
# notation):
# O\ |\ !\ =\ |\|\ p_> t_> k_> s_> x\ @\ 3\

# Beginning of translation table

%praat2sampa= (
"\\c\,"   =>   "C", 
"\\l\-"   =>   "K(?!\\\\)",
"\\lz"   =>   "K\\\\",
"\\lc"   =>   "L\\\\",
"\\9\-"   =>   "<\\\\",
"\\9e"   =>   "\\?\\\\",
"\\l\."   =>   "l`",
"\\ab"   =>   "Q",
"\\ae"   =>   "\\{",
"\\as"   =>   "A",
"\\at"   =>   "6",
"\\b\^"   =>   "b_<",
"\\bc"   =>   "B\\\\",
"\\be"   =>   "B",
"\\cc"   =>   "s\\\\",
"\\ct"   =>   "O",
"\\d\."   =>   "d`",
"\\d\^"   =>   "d_<",
"\\dh"   =>   "D",
"\\ep"   =>   "E",
"\\er"   =>   "3",
"\\f\."   =>   "r`",
"\\f2"   =>   "p\\\\",
"\\fh"   =>   "4",
"\\g\^"   =>   "g_<",
"\\gc"   =>   "G\\\\",
"\\h\-"   =>   "X\\\\",
"\\h\^"   =>   "(?<!f)h\\\\(?!h)",
"\\hc"   =>   "H\\\\",
"\\hs"   =>   "U",
"\\ht"   =>   "H",
"\\i\-"   =>   "1",
"\\ic"   =>   "I",
"\\j\^"   =>   "J\\\\_<",
"\\jc"   =>   "j\\\\",
"\\?-"   =>   ">\\\\",
"\\l\~"   =>   "5",
"\\mj"   =>   "F",
"\\ml"   =>   "M\\\\",
"\\mt"   =>   "M",
"\\n\."   =>   "n`",
"\\nc"   =>   "N\\\\",
"\\ng"   =>   "N",
"\\nj"   =>   "J",
"\\o\-"   =>   "8",
"\\oe"   =>   "(?<!\\\\)9(?!\\\\|e)",
"\\r\."   =>   "r\\\\`",
"\\rc"   =>   "R\\\\",
"\\rh"   =>   "7",
"\\ri"   =>   "R",
"\\rl"   =>   "(?<!m)l\\\\",
"\\s\."   =>   "s`",
"\\sh"   =>   "S",
"\\sr"   =>   "`.@`.",
"\\te"   =>   "(?<!\\\\)T",
"\\u\-"   =>   "(?<!_)}",
"\\vs"   =>   "P",
"\\vt"   =>   "V",
"\\wt"   =>   "W",
"\\yc"   =>   "Y",
"\\yt"   =>   "L(?!\\\\)",
"\\z\."   =>   "z`",
"\\zc"   =>   "z\\\\",
"\\zh"   =>   "Z",
"a"   =>   "a",
"b"   =>   "b",
"c"   =>   "c",
"d"   =>   "d",
"d\\cn"   =>   "_}\\(t_}\\)",
"e"   =>   "e",
"f"   =>   "f",
"h"   =>   "h",
"i"   =>   "i",
"j"   =>   "j",
"k"   =>   "k",
"l"   =>   "l",
"m"   =>   "m",
"n"   =>   "n",
"notspecified"   =>   "!\\\\",
"notspecified"   =>   "3\\\\",
"notspecified"   =>   "=\\\\",
"notspecified"   =>   "@\\\\",
"notspecified"   =>   "O\\\\",
"notspecified"   =>   "k_>",
"notspecified"   =>   "p_>",
"notspecified"   =>   "s_>",
"notspecified"   =>   "t_>",
"notspecified"   =>   "x\\\\",
"notspecified"   =>   "\\|\\\\",
"o"   =>   "o",
"o\\T\^"   =>   "_r\\(e_r\\)",
"o\\Tv"    =>   "_oe_o",
"p"   =>   "p",
"q"   =>   "q",
"r"   =>   "r",
"s"   =>   "s",
"t"   =>   "t",
"u"   =>   "u",
"v"   =>   "v",
"w"   =>   "w",
"x"   =>   "x",
"y"   =>   "y",
"z"   =>   "z",
"n\\|v"   =>   "\_=",
"\\G\^"   =>   "G\\_\\<",
"\\?g"   =>   "\\?(?!\-|\\ )",
"\\ci"   =>   "X(?!\\\\)",
"\\ga"   =>   "G(?!\\\\|^|_)",
"\\gs"   =>   "(?<!\\\\|n)g(?!^|_)",
"\\j\-"   =>   "(?<!\\\\)jotbackslash",
"\\rt"   =>   "r\\\\(?!`)",
"\\sw"   =>   "@(?!`)",
"\\t\."   =>   "t`",
"\\o/"   =>   "(?<!f)2",
"k\\lip"   =>   "_(?!`|^|<|r|})",
);
 


# Processing loop 
# This is the major function reading the input and replacing a string from 
# the translation table one at a time
$sam2pravar=shift;
#while (<$sam2pravar>){
$var=$sam2pravar;
$var=~s#J\\#jotbackslash#;
while (($praat,$sampa)= each(%praat2sampa))
	{
	$var=~s#$sampa#$praat#g;
	 };
	# print STDERR "$var \n";
	return $var;
#};
#}

}

#End of sampa2praat



sub praat2sampa {
# This program is a pure font converter, using SAMPA-IPA symbols as input, 
# read from input file, and produces coresponding PRAAT-IPA-notation, 
# which are ASCII combinations, send to STDOUT
#
# Usage: praat2sampa.pl INPUTFILE 
#
# The PRAAT manual does not specify the following 
# characters (which are existend in the IPA chart with 
# symbols in SAMPA notation):
# O\ |\ !\ =\ |\|\ p_> t_> k_> s_> x\ @\ 3\

# Beginning of translation table

%praat2sampa= (
"\\\\c\,"   =>   "C", 
"\\\\l\-"   =>   "K",
"\\\\lz"   =>   "K\\",
"\\\\lc"   =>   "L\\",
"\\\\9\-"   =>   "<\\",
"\\\\9e"   =>   "?\\",
 "\\\\l\\."   =>   "l`",
"\\\\\\?g"   =>   "?",
"\\\\G\\^"   =>   "G\_<",
"\\\\ab"   =>   "Q",
"\\\\ae"   =>   "{",
"\\\\as"   =>   "A",
"\\\\at"   =>   "6",
"\\\\b\\^"   =>   "b_<",
"\\\\bc"   =>   "B\\",
"\\\\be"   =>   "B",
"\\\\cc"   =>   "s\\",
"\\\\ci"   =>   "X",
"\\\\ct"   =>   "O",
"\\\\d\\."   =>   "d`",
"\\\\d\\^"   =>   "d_<",
"\\\\dh"   =>   "D",
"\\\\ep"   =>   "E",
"\\\\er"   =>   "3",
"\\\\f\\."   =>   "r`",
"\\\\f2"   =>   "p\\",
"\\\\fh"   =>   "4",
"\\\\g\\^"   =>   "g_<",
"\\\\ga"   =>   "G",
"\\\\gc"   =>   "G\\",
"\\\\gs"   =>   "g",
"\\\\h\-"   =>   "X\\",
"\\\\h\\^"   =>   "h\\",
"\\\\hc"   =>   "H\\",
"\\\\hs"   =>   "U",
"\\\\ht"   =>   "H",
"\\\\i\-"   =>   "1",
"\\\\ic"   =>   "I",
"\\\\j\-"   =>   "J\\",
"\\\\j\\^"   =>   "J\\_<",
"\\\\jc"   =>   "j\\",
"\\\\\\?\-"   =>   ">\\",
"\\\\l\~"   =>   "5",
"\\\\mj"   =>   "F",
"\\\\ml"   =>   "M\\",
"\\\\mt"   =>   "M",
"\\\\n\\."   =>   "n`",
"\\\\nc"   =>   "N\\",
"\\\\ng"   =>   "N",
"\\\\nj"   =>   "J",
"\\\\o\-"   =>   "8",
"\\\\o/"   =>   "2",
"\\\\oe"   =>   "9",
"\\\\r\\."   =>   "r\\`",
"\\\\rc"   =>   "R\\",
"\\\\rh"   =>   "7",
"\\\\ri"   =>   "R",
"\\\\rl"   =>   "l\\",
"\\\\rt"   =>   "r\\",
"\\\\s\\."   =>   "s`",
"\\\\sh"   =>   "S",
"\\\\sr"   =>   "`(@`)",
"\\\\sw"   =>   "@",
"\\\\t\\."   =>   "t`",
"\\\\te"   =>   "T",
"\\\\u\-"   =>   "}",
"\\\\vs"   =>   "P",
"\\\\vt"   =>   "V",
"\\\\wt"   =>   "W",
"\\\\yc"   =>   "Y",
"\\\\yt"   =>   "L",
"\\\\z\\."   =>   "z`",
"\\\\zc"   =>   "z\\",
"\\\\zh"   =>   "Z",
"a"   =>   "a",
"b"   =>   "b",
"c"   =>   "c",
"d"   =>   "d",
"d\\\\cn"   =>   "_}(t_})",
"e"   =>   "e",
"f"   =>   "f",
"h"   =>   "h",
"i"   =>   "i",
"j"   =>   "j",
"k"   =>   "k",
"k\\\\lip"   =>   "_",
"l"   =>   "l",
"m"   =>   "m",
"n"   =>   "n",
"notspecified"   =>   "!\\",
"notspecified"   =>   "3\\",
"notspecified"   =>   "=\\",
"notspecified"   =>   "@\\",
"notspecified"   =>   "O\\",
"notspecified"   =>   "k_>",
"notspecified"   =>   "p_>",
"notspecified"   =>   "s_>",
"notspecified"   =>   "t_>",
"notspecified"   =>   "x\\",
"notspecified"   =>   "|\\",
"o"   =>   "o",
"o\\\\T\\^"   =>   "_r(e_r)",
"o\\\\Tv"   =>   "_oe_o",
"p"   =>   "p",
"q"   =>   "q",
"r"   =>   "r",
"s"   =>   "s",
"t"   =>   "t",
"u"   =>   "u",
"v"   =>   "v",
"w"   =>   "w",
"x"   =>   "x",
"y"   =>   "y",
"z"   =>   "z",
"n\\\\\\|v"   =>   "\_=",
);


# Processing loop 
# This is the major function reading the input and replacing a string from 
# the translation table one at a time

$sam2pravar=shift;
#while (<$sam2pravar>){
$var=$sam2pravar;
$var=~s#J\\#jotbackslash#;
while (($praat,$sampa)= each(%praat2sampa))
	{
	$var=~s#$praat#$sampa#g;
	 };
	# print STDERR "$var \n";
	return $var;
#}

# End of function praat2sampa
}




sub stripSpaces {
  my $stringref = shift;

  $$stringref =~ s/^\s*//;
  $$stringref =~ s/\s*$//;
  chomp($$stringref);
}
  
sub exit_programm {
print STDERR "
	        You provoked some sort of error. Program exits.\n 
                The output is probably not sufficient. 
                Re-run to get it right, using the correct syntax 
                generatepraattier.pl TIERNUMBER (S or P) FILENAME \n";
#die "The output is probably not sufficient. Re-run to get it right.\n";
exit;
}

# End of function
# EOF