# ==========
# en1tosw.pl
# ==========

# quick hack to translate en1 (English) on stdin to use sw1 (Swedish) voice
# Mike Hamilton (mikeh@hamilton.net.au) January 2000

# Map English phonemes to Swedish

%en1tosw1map=(
  "5"  => "l",
  "p"  => "p",   # pat
  "b"  => "b",   # but
  "t"  => "t",   # ten
  "d"  => "d",   # den
  "k"  => "k",   # can
  "m"  => "m",   # man
  "n"  => "n",   # not
  "l"  => "l",   # like
  "r"  => "r",   # run
  "f"  => "f",   # full
  "v"  => "v",   # very
  "s"  => "s",   # some
  "z"  => "s",   # zeal
  "h"  => "h",   # hat
  "w"  => "v",   # went
  "g"  => "g",   # game
  "tS" => "C" ,  # chain
  "dZ" => "C",   # Jane
  "N"  => "N",	 # long
  "T" =>  "th",   # thin
  "D" =>  "th",   # then
  "S" =>  "S",   # ship
  "Z" =>  "s",   # 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
  "{"  => "a",   # pat      we have { but only before r
  "V"  => "a",   # putt     ?
  "Q"  => "O",   # pot
  "U"  => "U",   # good
  "@"  => "@",	 # about
  "eI" => "I",   # bay
  "aI" => "I",   # buy
  "OI" => "I",   # boy
  "\@U"=> "U",   # no
  "aU" => "U",   # now
  "I\@"=> "\@",  # peer
  "e\@"=> "\@",  # pair
  "U\@"=> "\@"   # poor
);


# ------------
# SwedishNoElide
# ------------

@SwedishNoElide=(
  "th", "b",
  "th", "C",
  "th", "d",
  "th", "f",
  "th", "g",
  "th", "h",
  "th", "j",
  "th", "k",
  "th", "kh",
  "th", "l",
  "th", "m",
  "th", "N",
  "th", "n",
  "th", "p",
  "th", "ph",
  "th", "r",
  "th", "rd",
  "th", "rh",
  "th", "rl",
  "th", "rn",
  "th", "rs",
  "th", "rt",
  "th", "S",
  "th", "s",
  "th", "t",
  "th", "v"
);

# -----------------
# SwedishCheckElision
# -----------------

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


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

  return 0;  # doesn't need pause
}

# -------------
# MakeSwedishLine
# -------------

sub MakeSwedishLine
{
  local ($phon,$line)=@_;
  local ($SwedishLine);

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

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

}

# ----------
# 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];
   $nextSwedishPhon=$en1tosw1map{$nextEnglishPhon};

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

   $InsertPhonAfter="";

   # at end of word
   if ( (
         ($SwedishPhon eq "th")
         )
        && ($lookAhead =~ /^[_#]/) )
	{
        $InsertPhonAfter="@ 10\n";
      }

   # make English aI from a-i
   if ($EnglishPhon eq "aI") {
     print "a 40\n";
   }

   # make English eI from e-I
   if ($EnglishPhon eq "eI") {
     print "e 40\n";
   }

   # make English e@ from e-@
   if ($EnglishPhon eq "e\@") {
     print "e 40\n";
   }

   # make English U@ from U-@
   if ($EnglishPhon eq "U\@") {
     print "U 40\n";
   }

   # make English aU from a-U
   if ($EnglishPhon eq "aU") {
     print "a 40\n";
   }

   # make English I@ from I-@
   if ($EnglishPhon eq "I\@") {
     print "I 40\n";
   }

   # make English OI from O-I
   if ($EnglishPhon eq "OI") {
     print "O 40\n";
   }

   # can't have a-N
   if ( ($SwedishPhon eq "@")
        && ($nextSwedishPhon eq "N")
	)
      {
       $SwedishPhon =  "a";
     }

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

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

    if ( &SwedishCheckElision($SwedishPhon,$nextSwedishPhon)) {
      $s   ="@ 10";
      print "$s\n";
      $lastOutputLine=$s;
    }

}

# --------
# en1tosw1
# --------

sub en1tosw1
{
  $lastLineOutput="";

  &ReadmBrola;

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

    $line=$lookAhead;

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

  &ProcessLine; # deal with the last line

}

&en1tosw1;

1;