#!/usr/bin/perl
#
# ===========
# en1tode2.pl
# ===========

# quick hack to translate en1 (English) on stdin to
# use de1 or de2 (German) voice
# Mike Hamilton (mikeh@hamilton.net.au) January 2000

# Map English phonemes to German

%en1tode2map=(
  "5"  => "l",
  "p"  => "p",   # pat
  "b"  => "b",   # but
  "t"  => "t",   # ten
  "d"  => "t",   # den
  "k"  => "k",   # can
  "m"  => "m",   # man
  "n"  => "n",   # not
  "l"  => "l",   # like
  "r"  => "R",   # run
  "f"  => "f",   # full
  "v"  => "f",   # very
  "s"  => "s",   # some
  "z"  => "s",   # zeal
  "h"  => "h",   # hat
  "w"  => "v",   # went
  "g"  => "g",   # game
  "tS" => "tS",  # chain
  "dZ" => "tS",  # Jane
  "N"  => "N",	 # long
  "T" =>  "ts",  # thin
  "D" =>  "s",   # then
  "S" =>  "S",   # ship
  "Z" =>  "Z",   # measure
  "j" =>  "j",   # yes
  "i:" => "i:",  # bean
  "A:" => "a:",  # barn
  "O:" => "o:",  # born
  "u:" => "u:",  # boon
  "3:" => "2:",  # burn
  "I"  => "I",   # pit
  "e"  => "E",   # pet
  "{"  => "E",   # pat
  "V"  => "a",   # putt
  "Q"  => "O",   # pot
  "U"  => "u:",  # good
  "@"  => "@",	 # about
  "eI" => "e:",  # bay
  "aI" => "aI",  # buy
  "OI" => "OY",  # boy
  "\@U"=> "o:",  # no
  "aU" => "aU",  # now
  "I\@"=> "i:",  # peer
  "e\@"=> "E:",  # pair
  "U\@"=> "u:"   # poor
);

# ------------
# GermanNoElide
# ------------
# These German pairs cannot be elided, but
# can be played if a brief pause is inserted

@GermanNoElide=(
  "2:", "x",
  "@", "@",
  "@", "x",
  "@", "Y",
  "a", "@",
  "aI", "x",
  "b", "b",
  "b", "C",
  "b", "f",
  "b", "k",
  "b", "m",
  "b", "p",
  "b", "pf",
  "b", "S",
  "b", "t",
  "b", "ts",
  "b", "tS",
  "b", "v",
  "b", "x",
  "b", "Z",
  "C", "C",
  "C", "x",
  "C", "Z",
  "E", "2:",
  "E", "@",
  "E", "a:",
  "E", "aI",
  "E", "aU",
  "E", "E",
  "E", "e:",
  "E", "E:",
  "E", "I",
  "E", "i:",
  "E", "OY",
  "E", "U",
  "E", "u:",
  "E", "x",
  "E", "Y",
  "E", "y:",
  "E", "Z",
  "e:", "x",
  "E:", "x",
  "E:", "Z",
  "I", "a:",
  "I", "2:",
  "I", "e:",
  "I", "E:",
  "I", "e:",
  "i", "e:",
  "I", "i:",
  "I", "O",
  "I", "o:",
  "I", "OY",
  "I", "u:",
  "I", "x",
  "I", "Y",
  "I", "y:",
  "i:", "x",
  "l", "x",
  "OY", "x",
  "R", "R",
  "R", "x",
  "U", "2:",
  "U", "C",
  "U", "E",
  "U", "e:",
  "U", "E:",
  "U", "i:",
  "U", "o:",
  "U", "OY",
  "U", "u:",
  "U", "Y",
  "U", "y:",
  "U", "Z",
  "v", "b",
  "v", "C",
  "v", "h",
  "v", "k",
  "v", "m",
  "v", "p",
  "v", "pf",
  "v", "s",
  "v", "S",
  "v", "t",
  "v", "tS",
  "v", "ts",
  "v", "v",
  "v", "x",
  "v", "Z",
  "x", "x",
  "x", "Y",
  "Y", "2:",
  "Y", "a",
  "Y", "a:",
  "Y", "aI",
  "Y", "aU",
  "Y", "E:",
  "Y", "e:",
  "Y", "i:",
  "Y", "o:",
  "Y", "OY",
  "Y", "u:",
  "Y", "x",
  "Y", "Y",
  "Y", "y:",
  "y:", "x",
  "Z", "b",
  "Z", "C",
  "Z", "E:",
  "Z", "f",
  "Z", "k",
  "Z", "l",
  "Z", "n",
  "Z", "o:",
  "Z", "OY",
  "Z", "p",
  "Z", "pf",
  "Z", "R",
  "Z", "S",
  "Z", "s",
  "Z", "t",
  "Z", "ts",
  "Z", "tS",
  "Z", "u:",
  "Z", "v",
  "Z", "x",
  "Z", "Y",
  "Z", "Z"
);

# -----------------
# GermanCheckElision
# -----------------

sub GermanCheckElision
{
  local ($phon1,$phon2)=@_;
  local ($ok,$a,$i,$n,$s1,$s2);
  $n=($#GermanNoElide+1)/2;

  for ($a=0;$a<$n; ++$a) {
    $i=$a*2;
    $s1=$GermanNoElide[$i];
    if ($phon1 eq $s1) {
      $s2=$GermanNoElide[$i+1];
      if ($phon2 eq $s2) {
        return 1; # needs pause
      }
    }
  }

  return 0;  # doesn't need pause
}

# ------
# gCheck
# ------
#  these cannot follow German g,
#  so convert German g to German k

@gCheck = (
   "p",
   "b",
   "t",
   "d",
   "k",
   "f",
   "v",
   "s",
   "z",
   "S",
   "Z",
   "x",
   "C",
   "h",
   "pf",
   "ts",
   "tS",
   "j",
   "9",
   "O"
);

# ----
# gToK
# ----

sub gTok
{
  local ($phon)=@_;
  local ($s);

  foreach $s (@gCheck) {
    if ($s eq $phon) { return 1; }
  }
  return 0;
}

# -------------
# MakeGermanLine
# -------------

sub MakeGermanLine
{
  local ($phon,$line)=@_;
  local ($GermanLine);

  $GermanLine="$phon ";
  @fields=split(" ",$line);
  $nFields=$#fields;

  for ($i=1; $i<=$nFields; ++$i) {
     $GermanLine .= "$fields[$i]";
     $GermanLine .=" " if ($i !=$nFields);
  }
  return $GermanLine;

}

# ----------
# ReadmBrola
# ----------

# read, eating comments

sub ReadmBrola
{
  return -1 if (!($lookAhead=<>));  # eof

  chop ($lookahead);

  while ($lookAhead =~ /^;/) # comment
  {
    last if (!($lookAhead=<>));  # eof
    chop ($lookAhead);
  }

  $lookAhead =~  s/^\s+|\s+$//g; # strip leading/trailing spaces
}

# -----------
# ProcessLine
# -----------

sub ProcessLine
{
   print "\n", return if ($line eq "");   # empty line

   @fields=split(" ",$lookAhead);
   $nextEnglishPhon=$fields[0];
   $nextGermanPhon=$en1tode2map{$nextEnglishPhon};

   @fields=split(" ",$line);
   $EnglishPhon=$fields[0];
   $GermanPhon=$en1tode2map{$EnglishPhon};

   $InsertPhonAfter="";

   # can't say h-j (e.g. English "Hubert")
   # or h-v or h -f
   # so we will add a tiny vowel after the h
   if ( ($GermanPhon eq "h") &&
          (
	   ($nextGermanPhon eq "j")
           || ($nextGermanPhon eq "v")
           || ($nextGermanPhon eq "f")
	  )
          )
      {
        $InsertPhonAfter="a 1";
      }

   # h-@ becomes h-E
   if ( ($GermanPhon eq "E") && ($nextGermanPhon eq "\@") ) {
      $GermanPhon="E";
   }

   # can't say g-p, g-s, g-v, g-f, etc
   # so convert to k-p
   if ( ($GermanPhon eq "g") && (&gTok($nextGermanPhon))) {
      $GermanPhon =  "k";
   }

   # German g at end of word  (e.g. English "big")
   # so convert to k
   if ( ($GermanPhon eq "g") && ($lookAhead =~ /^[_#]/) )
   {
      $GermanPhon="k";
   }


   # can't say u:-N, @-N,a:-N
   # so convert the vowel
   if ( (
         ($GermanPhon eq "u:")
         || ($GermanPhon eq "\@")
         || ($GermanPhon eq "a:")
        )
        && ($nextGermanPhon eq "N")
	) {
      $GermanPhon="E";
   }

   # can't say Z-n (e.g. from English "decision")
   if ( ($GermanPhon eq "Z") && ($nextGermanPhon eq "n") ) {
      $GermanPhon="S";
   }

   # can't say Z-u: (e.g. from English "visual")
   if ( ($GermanPhon eq "Z") && ($nextGermanPhon eq "u:") ) {
      $GermanPhon="S";
   }

   # h-@ becomes h-O
   if ( ($GermanPhon eq "\@") && ($lastOutputLine =~ /^h/) ) {
      $GermanPhon="O";
   }

    if ($line =~ /^[_#]/) {
      print "$line\n";
      $lastLineOutput=$line;
    }
    else {
      $lastOutputLine=&MakeGermanLine($GermanPhon,$line);
      print "$lastOutputLine\n";
    }

    if ($InsertPhonAfter ne "") {
      print "$InsertPhonAfter\n";
      $lastOutputLine=$InsertPhonAfter;
    }

    if ( &GermanCheckElision($GermanPhon,$nextGermanPhon)) {
      $s   ="_ 1";
      print "$s\n";
      $lastOutputLine=$s;
    }

}

# --------
# en1tode2
# --------

sub en1tode2
{
  $lastLineOutput="";

  &ReadmBrola;

  while (1) {
    @fields=split(" ",$lastOutputLine);
    $lastOutputPhon=$fields[0];

    $line=$lookAhead;
    last if (&ReadmBrola == -1); # eof
    &ProcessLine;
  }

  &ProcessLine; # deal with the last line

}

&en1tode2;

1;

