#!/usr/bin/perl

# Opravit prepis -neho nech nerobi J E h\ O ale n E h\ O

use Getopt::Long;
use g2p_sk::Trans_cod;
use sylseg_sk::Trans_sylseg;
use g2p_sk::Trans_morfems;

$prior=1;
$color=0;
my %optctl = (help => \$help, dl => \$prior, color => \$color, ofile => \$ofile);
&GetOptions(\%optctl,"dl=i","help","color","ofile=s");

$dic_dir="/usr/share/g2p_sk/Exceptions";
$dic_pri="priaeu_iso.ddat";
$dic_gen="general_iso.ddat";
$dic_pri="$dic_dir/$dic_pri";
$dic_gen="$dic_dir/$dic_gen";
 
my $ifile;
my $lword,$mword,$rword,$wpos;
my @stack;
my $alt=0;
my %exceptions;

sylseg_sk::Trans_sylseg::set_debug_level($prior,$color);
g2p_sk::Trans_cod::set_debug_level($prior,$color);
g2p_sk::Trans_morfems::set_debug_level($prior,$color);
printhelp() if($help==1);
process_arguments();
read_exceptions();

local *INPUT,*OUTPUT;
open (INPUT,"< $ifile") or
    die ("Can not open input file $ifile !!!\n");
    
open (OUTPUT,">$ofile") or
    die ("Can not create output file $ofile !!!\n") if($ofile ne "");

mess("Processing ...",1);

while(<INPUT>)
{
  mess("Sentence:\t $_",1);
#  print OUTPUT "$_" if($ofile ne "");
  my $veta=clean_and_lc($_);
  mess("LC:\t $veta",2);
  my @vety = split(";",$veta);
  my $VPR="";
  foreach $sveta (@vety)
    {
      $_=$sveta;
      s/^ //;
      s/ /_/g;
      mess("*******************",2);
      mess("SV:\t $_",2);
      @ncodw=split("_",$_);
      @slova=split("_",$_);
      $lword=""; $mword=""; $rword=""; $sm_sveta="";
      $wpos=0; #Pozicia slova vo vete koli prehladavaniu ...
      while($_=shift @slova)
      {
       s/^[ ]*//; s/[ ]*$//;
       $lword=$mword;
       if($wpos>0)
        { 
	 #unshift @slova,"\." if(@slova==0 and !/\./);
	 $mword=$rword;
	}
	else
	 {
          $_=get_best_parts($_);
          $mword=cod2uni($_);
	  $_="\.";
          $_=shift @slova if(@slova>0);
	  #unshift @slova,"\." if(@slova==0 and !/\./);
	 }
       $_=get_best_parts($_);
       $rword=cod2uni($_);
       mess("P. word: $mword",3); 
       mess("Context: $lword <--> $mword <--> $rword",4); 
       @stack=($mword);
       check_exceptions();
       $msg=join(" || ",@stack); mess("Actual stack: $msg",5);
       prepis_sam();
       $msg=join(" || ",@stack); mess("Actual stack: $msg",5);
       prepis_spol();
       $msg=join(" || ",@stack); mess("Actual stack: $msg",5);
       $aww=join(", ",@stack);
       mess("W: $mword => $aww",1);
       $sm_sveta.="$aww"."   ";
       $wpos++;
      }
      #mess("SLSV:\t $sm_sveta",2);
      #undef @ncodw;
      $VPR.=$sm_sveta." ; ";
    }
  $_=$VPR; s/-/ /g; $VPR=$_;
  mess("Sentence:\t $VPR",1);
  print OUTPUT "$VPR\n" if($ofile ne "");
  mess("---------",1);
}

close(OUTPUT) if($ofile ne "");
close(INPUT);

warn "\n(c) Dodo 2003,2004,2005\n\n";

sub get_best_parts
 {
  my $wrd=$_[0];
  return $wrd if(length($wrd)<3);
  my $syl=get_best_sylab($wrd);
  my $mor=gen_morfemy($wrd);
  mess("Morf. seg: $wrd => $mor",3);
  my @fin;
  my @sch=split //,$syl;
  my @mch=split //,$mor;
  my $ls= @sch;
  my $lm= @mch;
  mess("DS: $ls \t DM: $lm",5);
  mess("SL: $syl",5);
  mess("MF: $mor",5);
  my $max=$ls;
  $max=$lm if($lm>$max);
  for($i=0;$i<$max;$i++)
   {
    my $os=$sch[$i];
    my $om=$mch[$i];
    if($sch[$i] ne $mch[$i])
    {
     if($sch[$i] eq '-' and $mch[$i]=~/[;><]/)
      {
       $fin[$i]=$mch[$i];
       mess("$os\t$om\t$fin[$i]\t- doesn't match, replacing",5);
      }
      elsif($sch[$i] eq '-')
       {
        for($j=$lm;$j>$i;$j--)
	 {$mch[$j]=$mch[$j-1];}
	$mch[$i]=$sch[$i];
        $fin[$i]=$mch[$i];
        mess("$os\t$om\t$fin[$i]\t- doesn't match M, shifting, inserting",5);
	$lm=@mch;
  	$max=$lm if($lm>$max);
       }
       elsif($mch[$i]=~/[;><]/)
        {
         for($j=$ls;$j>$i;$j--)
	  {$sch[$j]=$sch[$j-1];}
	 $sch[$i]=$mch[$i];
         $fin[$i]=$mch[$i];
         mess("$os\t$om\t$fin[$i]\t- doesn't match S, shifting, inserting",5);
	 $ls=@sch; 
  	 $max=$ls if($ls>$max);
	}
    }
    else 
     {
      $fin[$i]=$sch[$i];
      mess("$os\t$om\t$fin[$i]\t- match",5);
     }
   }
  $fin=join "",@fin;
  return $fin;
 }

sub get_best_sylab
 {
  my $w=$_[0];
  my @as=gen_pos_sylabels($w);
  my @finlist=calc_probs(@as);
  my ($g,$sl)=split("::",$finlist[0]);
  mess("Syl. seg: $w => $sl",3);
  return $sl;
 }

sub prepis_spol
  {
    mess("Transcription of consonants ...",3);
    my @spol=('!b!','!c!','!C!','!d!','!D!','!f!','!g!','!h!','!j!','!k!','!l!',
              '!ld!','!L!','!m!','!n!','!N!','!p!','!q!','!r!','!rd!','!s!',
	      '!S!','!t!','!T!','!v!','!w!','!x!','!z!','!Z!','!ch!','!dz!','!dZ!');
    my @sam=('a','E','I','O','U','a:','E:','I:','O:','U:');
    my @ksam=('a','E','I','O','U');
    my @samnoI=('a','E','O','U','a:','E:',,'O:','U:');
    my $spol=join('|',@spol);
    my $sam=join('|',@sam);
    my $ksam=join('|',@ksam);
    my $samnoI=join('|',@samnoI);
    my $nez="!p!|!f!|!t!|!s!|!c!|!S!|!C!|!T!|!k!|!ch!";
    my $zne="!b!|!v!|!d!|!z!|!dz!|!Z!|!dZ!|!D!|!g!|!h!";
    my $znep="b|f_v|d|z|dz|Z|dZ|!J\\|g|h|v|m|j";
    my $es=" | - | < | > | ; "; # Ziadna (Empty) alebo Slabicna alebo Morfematicka hranica
    my $ms=" < | > | ; "; # Morfematicka hranica

    mess("Transcription of j and I_^",4);
     rule(\@stack,"- !j! ($sam)","- j \\1","Pronunciation of j");
     rule(\@stack,"($samnoI) !j! -","\\1 I_^ -","Pronunciation of I_^");
     rule(\@stack,"(I|I:) !j! -","\\1 j -::\\1 I_^ -","Pronunciation of j aj I_^");
     rule(\@stack,"- ($spol) !j! ($sam)","- \\1 j \\2::- \\1 I_^ \\2","Pronunciation of j aj I_^");
     rule(\@stack,"!j!","j","Pronunciation of j default");
    mess("Pronunciation of f, f_v",4);
     rule(\@stack,"!f!($es)($sam)","f \\2","Pronunciation of f");
     rule(\@stack,"- !v!($es)(!n!|!N!)","- v \\2::- f_v \\2","Pronunciation of -vn");
     rule(\@stack,"^- !v!($es)!z!($es)($nez)","- f z\\2\\3","Pronunciation of f");
     rule(\@stack,"- !v!($es)($nez)","- f \\2","Pronunciation of f");
     rule(\@stack,"^- !v!($es)!z!","- f_v z","Pronunciation of f_v");
     rule_fv(\@stack);
     rule(\@stack,"- !v!($es)($zne)","- f_v \\2","Pronunciation of f_v");
    mess("Pronunciation of v a U_^",4);
#    rule(\@stack,"^- !v! -\$","- f -","pronunciation of predlozky 'v'");
     rule(\@stack,"- !v! ($ksam|!r!|!rd!|!l!|!ld!|!L!|j)","- v \\1","Pronunciation of v");
     rule(\@stack,"- ($spol) !v! ($ksam|!r!|!rd!|!l!|!ld!|!L!|j)","- \\1 v \\2","Pronunciation of v");
     rule(\@stack,"U !v! -","U v -::U U_^ -","Pronunciation of v aj U_^");
     rule(\@stack,"($ksam|!r!|!rd!|!l!|!ld!) !v! -","\\1 U_^ -","Pronunciation of U_^");
     rule(\@stack,"O U -\$","O U_^ -","Pronunciation of U_^");
     rule(\@stack,"!v!","v::U_^","Pronunciation of v aj U_^");
    mess("Pronunciation of m, F, n, N",4);
     rule(\@stack,"!n!($es)!(k|g)!","N \\2","Pronunciation of N");
     rule(\@stack,"!n!($es)!x!","N k s","Pronunciation of N");
     rule(\@stack,"!n!($es)!([szSZL])!","n \\2","Pronunciation of n skrt");
     rule(\@stack,"!n!($es)!ch!","n x","Pronunciation of n skrt");
     rule(\@stack,"!m!($es)!?(v|f)!?","F \\2","Pronunciation of F");
     rule(\@stack,"!n!($es)!b!","m b","Pronunciation of m");
     rule(\@stack,"!m!","m","Pronunciation of m");
    mess("Consonants compounds",4);
     rule(\@stack,"!n!($es)![td]!($es)!s!($es)!k!","n ts k::n s k","Pronunciation of ntsk, ndsk");
     rule(\@stack,"!s!($es)!t!($es)!s!($es)!t!($es)!v!","s s t v","Pronunciation of ststv");
     rule(\@stack,"!p!($es)!t!($es)!s!($es)!k!","p s k","Pronunciation of ptsk");
     rule(\@stack,"!s!($es)!t!($es)!s!($es)!k!","s s k","Pronunciation of stsk");
     rule(\@stack,"!s!($es)!T!($es)!s!($es)!t!","s s t","Pronunciation of sTst");
     rule(\@stack,"!(t|d|dz)!($es)!s!($es)!k!","ts k","Pronunciation of tsk, dsk, dzsk");
     rule(\@stack,"!d!($es)!s!($es)!t!","ts t","Pronunciation of dst");
     rule(\@stack,"!(t|D)!($es)!s!($es)!t!($es)(!v!|v)","ts t v","Pronunciation of tstv, Dstv");
     rule(\@stack,"!(t|D)!($es)!s!($es)!t!($es)U_\\^","ts t U_^","Pronunciation of tstv, Dstv");
     rule(\@stack,"!z!($es)!s!($es)!k!($es)(I|I:|O) -\$","s k \\4 -","Pronunciation of zsk");
     rule(\@stack,"!z!($es)!S!($es)!t!($es)I($es)!n!($es)a -\$","S c I n a  -","Pronunciation of zST");
     rule(\@stack,"![dt]!($es)!S!($es)!t!","tS c","Pronunciation of dST, tST");
     rule(\@stack,"!p!($es)!t!($es)!C!($es)!n!","p tS J","Pronunciation of ptCN");
     rule(\@stack,"!S!($ms)!s!","S s","Pronunciation of Ss");
     rule(\@stack,"!Z!($ms)!s!","Z s","Pronunciation of Zs");
     rule(\@stack,"!s!($ms)!S!","s S","Pronunciation of sS");
     rule(\@stack,"!z!($ms)!S!","z S","Pronunciation of zS");
     rule(\@stack,"!z!($ms)!Z!","z Z","Pronunciation of zZ");
     rule(\@stack,"!s!($ms)!C!","s tS","Pronunciation of sC");
     rule(\@stack,"!C!($ms)!s!","tS s","Pronunciation of Cs");
     rule(\@stack,"!z!($ms)!C!","z tS","Pronunciation of zC");
    mess("Doubled consonants",4);
     rule_dbl_SP(\@stack);
    mess("Voiced to unvoiced asimilation",4);
     rule_ZN_NZ(\@stack);
    mess("Unvoiced to voiced asimilation",4);
     rule_NZ_ZN(\@stack);
    mess("Asimilation of h, ch",4);
     rule_hch(\@stack);
    mess("Specialities",4);
     rule(\@stack,"^- !d!($es)I($es)!s!($es)($zne|$znep|$sam)","- d I z \\4","Pronunciation of d[iy]s-");
    #Nasledujuce je odflaknute, dokoncit !!!
     rule(\@stack,"^- E($es)!x!($es)($zne|$znep|$sam)","- E g z \\3","Pronunciation of ex-");
     rule(\@stack,"!x!","k s","Pronunciation of x");

    #Tuna prepis secky okrem d,t,n,l,D,T,N,L,l,r
    my @spolr=('!b!','!c!','!C!','!dz!','!dZ!','!f!','!g!','!h!','!ch!','!k!','!ld!','!m!',
    	       '!p!','!rd!','!s!','!S!','!v!','!w!','!x!','!z!','!Z!');
    my %neasimr=('!b!'=>'b','!c!'=>'ts','!C!'=>'tS','!dz!'=>'dz','!dZ!'=>'dZ','!f!'=>'f',
    		 '!g!'=>'g','!h!'=>'h\\','!ch!'=>'x','!k!'=>'k','!ld!'=>'l=:','!m!'=>'m',
		 '!p!'=>'p','!rd!'=>'r=:','!s!'=>'s','!S!'=>'S','!v!'=>'v','!w!'=>'v',
		 '!x!'=>'k s','!z!'=>'z','!Z!'=>'Z');
    my $spolr=join('|',@spolr);
    foreach $_ (@stack)
     {s/($spolr)/$neasimr{$1}/g;}

    mess("Transcription of dtnl",4);
     rule_dtnl(\@stack);
     
    my @sp_prep=('b','ts','tS','d','J\\','dz','dZ','f','g','h\\','x','j','k','l=:','L','m','F','n','J',
                 'N','p','r=:','s','S','t','c','v', 'z','Z');
    my @sp_sum=('b','ts','tS','d','J\\','dz','dZ','f','g','x','j','k','m','F','n','N','p','s','S','t',
                'c','v','z','Z');
    my $sp_prep=join('|',@sp_prep);
    my $sp_sum=join('|',@sp_sum);
    mess("Transcription of r",4);
     rule(\@stack,"- ($sp_prep) !r!($es)($sp_sum)","- \\1 r=\\2\\3","Pronunciation of r=");
     rule(\@stack,"- ($sp_prep) ($sp_prep) !r!($es)($sp_sum)","- \\1 \\2 r=\\3\\4","Pronunciation of r=");
     rule(\@stack,"- ($sp_prep) !r! - ([l|L|$sam])","- \\1 r= - \\2","Pronunciation of r=");
     rule(\@stack,"- ($sp_prep) ($sp_prep) !r! - ([l|L|$sam])","- \\1 \\2 r= - \\3","Pronunciation of r=");
     rule(\@stack,"- ($sp_prep) !l!($es)($sp_sum)","- \\1 l=\\2\\3","Pronunciation of l=");
     rule(\@stack,"- ($sp_prep) ($sp_prep) !l!($es)($sp_sum)","- \\1 \\2 l=\\3\\4","Pronunciation of l=");
     #Default r,l 
     rule(\@stack,"!r!","r","Pronunciation of r");
     rule(\@stack,"!l!","l","Pronunciation of l");
    
    foreach $_ (@stack)
     {s/[-><;]//g; s/[ ]+/ /g;}
  }

sub rule_dtnl
{
  my $stack=@_[0];
  my @lstack=@$stack;
  my @ostack=();
  my $ms=" < | > | ; "; # Morfematicka hranica
  my $es=" | - "; # Ziadna (Empty) alebo Slabicna hranica
  my $as="$es|$ms";
  my @spol=('b','ts','tS','dz','dZ','f','f_v','g','h\\','x','k','l=:','m','F','N',
	    'p','r=:','s','S','v','z','Z');
  my $spol=join('|',@spol);
  my $tdnl="!t!|!d!|!n!|!l!";
  my $TDNL="!T!|!D!|!N!|!L!";
  my %normal=('!t!'=>'t','!d!'=>'d','!n!'=>'n','!l!'=>'l',
              '!T!'=>'c','!D!'=>'J\\','!N!'=>'J','!L!'=>'L');
  my %makko=('!t!'=>'c','!d!'=>'J\\','!n!'=>'J','!l!'=>'L');
  foreach $wrd (@lstack)
   {   
     my $owrd=$wrd;
     mess("Pronunciation of TDNL",5);
     mess("Current status 1: \"$wrd\"",5);
     $wrd=~s/($TDNL)/$normal{$1}/g;
     mess("Current status 2: \"$wrd\"",5);
     mess("Pronunciation of tdnl for aou",5);
     mess("Current status 1: \"$wrd\"",5);
     $wrd=~s/($tdnl)($as)(a|O|U|a:|O:|U:)/$normal{$1} $3/g;
     mess("Current status 2: \"$wrd\"",5);
     mess("Next rules ...",5);
     mess("Current status 1: \"$wrd\"",5);
     $wrd=~s/($tdnl)($as)(a|O|U|a:|O:|U:|E:|U_\^ O|$spol)$/$normal{$1} $3/g;
     $wrd=~s/($tdnl) < (I|E|I:|E:)/$normal{$1} $3/;
     $wrd=~s/($tdnl)($as)I($as)ts($as)k($as)I:$/$normal{$1} I ts k I:/;
     $wrd=~s/($tdnl)($as)I($as)z($as)O($as)v($as)a($as)c$/$normal{$1} I z O v a c/;
     $wrd=~s/($tdnl)($as)I($as)z($as)m($as)U($as)s$/$normal{$1} I z m U s/;
     $wrd=~s/($tdnl)($as)I($as)s($as)t($as)a$/$normal{$1} I s t a/;
     $wrd=~s/($tdnl)($as)E($as)n($as)t$/$normal{$1} E n t/;
     $wrd=~s/($tdnl)($as)E($as)(r|!r!)$/$normal{$1} E r/;
     $wrd=~s/($tdnl)($as)E:($as)(r|!r!)$/$normal{$1} E: r/;
     $wrd=~s/($tdnl)($as)E($as)s$/$normal{$1} E s/;
     my $ttt=$wrd;
     $wrd=~s/($tdnl) > I($as)k/$makko{$1} I k/;
     $wrd=~s/($tdnl) > I:($as)k/$makko{$1} I: k/;
     $ttt=~s/!l! > I($as)k/l I k/;
     $ttt=~s/!l! > I:($as)k/l I: k/;
     mess("Current status 2: \"$wrd\"",5);
     #mess("tdnl pred tdnl ...",5);
     #mess("Current status 1: \"$wrd\"",5);
     #mess("\$wrd=~s/($tdnl) ($tdnl|$TDNL)/\$normal{\$1} \$3/;",5);
     #$wrd=~s/($tdnl) ($tdnl|$TDNL)/$normal{$1} $2/;
     #$ttt=~s/($tdnl) ($tdnl|$TDNL)/$normal{$1} $2/;
     #mess("Current status 2: \"$wrd\"",5);
     $wrd=~s/(!t!|!d!|!n!)($as)(I|E|I:)/$makko{$1} $3/g;
     $ttt=~s/(!t!|!d!|!n!)($as)(I|E|I:)/$makko{$1} $3/g;
     #push @ostack,$ttt if($wrd ne $ttt);
     push @lstack,$ttt if($wrd ne $ttt);

     # l vseobecne
     $ttt=$wrd;
     $wrd=~s/!l!($es)(I|E|I:|E:)/L $2/g;
     $ttt=~s/!l!($es)(I|E|I:|E:)/l $2/g;
     mess("Current status 2: \"$wrd\"",5);
     #Default standard
     mess("Default tdnl ...",5);
     mess("Current status 1: \"$wrd\"",5);
     $wrd=~s/($tdnl|$TDNL)/$normal{$1}/g;
     $ttt=~s/($tdnl|$TDNL)/$normal{$1}/g;
     push @ostack,$ttt if($wrd ne $ttt);
     mess("Current status 2: \"$wrd\"",5);
     mess("Applied rule: pronunciation of dtnl",4) if($owrd ne $wrd);
     push @ostack,$wrd;
   }
  @$stack=@ostack;
}

sub rule_dbl_SP
 {
  my $stack=@_[0];
  my @lstack=@$stack;
  my @ostack=();
  my $zne="!b!|f_v|!d!|!z!|!dz!|!Z!|!dZ!|!D!|!g!|!h!";
  my $nez="!p!|f|!t!|!s!|!c!|!S!|!C!|!T!|!k!";
  my %asim_zn=('!b!'=>'p','f_v'=>'f','!d!'=>'t','!z!'=>'s','!dz!'=>'ts',
               '!Z!'=>'S','!dZ!'=>'tS','!D!'=>'c','!g!'=>'k','!h!'=>'x');
  my %asim_nz=('!p!'=>'!b!','f'=>'f_v','!t!'=>'!d!','!s!'=>'!z!','!c!'=>'!dz!',
               '!S!'=>'!Z!','!C!'=>'!dZ!','!T!'=>'!D!','!k!'=>'!g!');
  my @spol=('!b!','!c!','!C!','!d!','!D!','!f!','!g!','!h!','!k!','!l!',
            '!ld!','!L!','!m!','!n!','!N!','!p!','!q!','!r!','!rd!','!s!',
            '!S!','!t!','!T!','!v!','!w!','!x!','!z!','!Z!','!ch!','!dz!','!dZ!');
  my %neasim=('!b!'=>'b','f_v'=>'f_v','!d!'=>'d','!z!'=>'z','!dz!'=>'dz',
  	      '!Z!'=>'Z','!dZ!'=>'dZ','!D!'=>'J\\','!g!'=>'g','!h!'=>'h\\',
	      '!p!'=>'p','!f!'=>'f','!t!'=>'t','!s!'=>'s','!c!'=>'ts','!S!'=>'S',
	      '!C!'=>'tS','!T!'=>'c','!k!'=>'k','!ch!'=>'x','m'=>'m','v'=>'v');
  my @sam=('a','E','I','O','U','a:','E:','I:','O:','U:');
  my @samnp=('!a!','!e!','!i!','!o!','!u!','!A!','!E!','!I!','!O!','!U!');
  my $spol=join('|',@spol);
  my $sam=join('|',@sam);
  my $samnp=join('|',@samnp);
  my $ms=" < | > | ; "; # Morfematicka hranica
  my $es=" | - "; # Ziadna (Empty) alebo Slabicna hranica
  foreach $wrd (@lstack)
   {   
     my $owrd=$wrd;
     mess("Current status 1: \"$wrd\"",5);
     $wrd=~s/($sam)($es)($spol)($ms)\3($es)($sam)/\1\2$neasim{$3} $neasim{$3}\5\6/;
     #Nefunguje !!!
     $wrd=~s/($sam)($es)($nez)($ms)$nez_p{'\3'}($es)($sam)/\1\2$neasim{$3} $neasim{$3}\5\6/;
     mess("Current status 2: \"$wrd\"",5);
     mess("Current status 1: \"$wrd\"",5);
     $wrd=~s/($sam)($es)(!t!|!d!)($ms)!T!($es)($sam)/\1\2c c\4\5/;
     $wrd=~s/($sam)($es)(!t!|!d!)($ms)!D!($es)($sam)/\1\2J\\ J\\\4\5/;
     $wrd=~s/($sam)($es)(!T!|!D!)($ms)!t!($es)($sam)/\1\2t t\4\5/;
     $wrd=~s/($sam)($es)(!T!|!D!)($ms)!d!($es)($sam)/\1\2d d\4\5/;
     $wrd=~s/($sam)($es)(!j!|!D!)($ms)!d!($es)($sam)/\1\2d d\4\5/;
     $wrd=~s/($sam)($es)!j!($ms)!j!($es)($sam)/\1\2I_^ j\4\5/;
     $wrd=~s/($sam)($es)(!t!|!d!|!T!|!D!)( [>;<] )(!s!|!z!|!c!|!dz!)($es)($sam)/\1\2ts ts\6\7/;
     $wrd=~s/($sam)($es)(!t!|!d!|!T!|!D!)( [>;<] )(!S!|!Z!|!C!|!dZ!)($es)($sam)/\1\2tS tS\6\7/;
     mess("Current status 2: \"$wrd\"",5);
     mess("Pronunciation of doubled consonants on the words boundary",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     if($wrd=~/(!t!|!d!|!T!|!D!)$/ and $rword=~/^(!s!|!z!|!c!|!dz!)/)
      { $wrd=~s/(!t!|!d!|!T!|!D!)$/ts/; $rword=~s/^(!s!|!z!|!c!|!dz!)/ts/; }
     if($wrd=~/(!t!|!d!|!T!|!D!)$/ and $rword=~/^(!S!|!Z!|!C!|!dZ!)/)
      { $wrd=~s/(!t!|!d!|!T!|!D!)$/tS/; $rword=~s/^(!S!|!Z!|!C!|!dZ!)/tS/; }
     if($wrd=~/($sam)($es)($spol)$/ and $rword=~/^$1($es)($sam)/)
      { $wrd=~s/($spol)$/$neasim{$1}/; $rword=~s/^($1)/$neasim{$1}/; }
    # Dalsie nema zmysel, vypliva z cohosi uz ... ;)
    # if($wrd=~/($sam)($es)($nez)$/ and $rword=~/^$nez_p{$1}($es)($sam)/)
    #  { $wrd=~s/($nez)$/$neasim{$1}/; $rword=~s/^($nez_p{$1})/$neasim{$1}/; }
     if($wrd=~/($sam)($es)(!t!|!d!)$/ and $rword=~/^!T!($es)($sam|$samnp)/)
      { $wrd=~s/(!t!|!d!)$/c/; $rword=~s/^(!T!)/c/; }
     if($wrd=~/($sam)($es)(!t!|!d!)$/ and $rword=~/^!D!($es)($sam|$samnp)/)
      { $wrd=~s/(!t!|!d!)$/J\\/; $rword=~s/^(!D!)/J\\/; }
     if($wrd=~/($sam)($es)(!T!|!D!)$/ and $rword=~/^!t!($es)($sam|$samnp)/)
      { $wrd=~s/(!T!|!D!)$/t/; $rword=~s/^(!t!)/t/; }
     if($wrd=~/($sam)($es)(!T!|!D!)$/ and $rword=~/^!d!($es)($sam|$samnp)/)
      { $wrd=~s/(!T!|!D!)$/d/; $rword=~s/^(!d!)/d/; }
     if($wrd=~/($sam)($es)(!h!)$/ and $rword=~/^!h!($es)($sam|$samnp)/)
      { $wrd=~s/(!h!)$/G/; $rword=~s/^(!h!)/h/; }
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);
     mess("Applied rule: pronunciation of doubled consonants",4) if($owrd ne $wrd);
     push @ostack,$wrd;
   }
  @$stack=@ostack;
 }

sub rule_hch
 {
  my $stack=@_[0];
  my @lstack=@$stack;
  my @ostack=();
  my $zne="!b!|!v!|!d!|!z!|!dz!|!Z!|!dZ!|!D!|!g!|!h!|v|f_v|m|b|d|z|dz|Z|dZ|J\\";
  my $nez="!p!|!f!|!t!|!s!|!c!|!S!|!C!|!T!|!k!|!ch!";
  my $sm="!a!|!e!|!i!|!o!|!u!|!A!|!E!|!I!|!O!|!U!|a|E|I|O|U|a:|E:|I:|O:|U:|!r!|!rd!|!l!|!rd!|!L!";
  foreach $wrd (@lstack)
   {   
     my $owrd=$wrd;
     mess("Pronunciation of h,",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     $wrd=~s/!h!$/x/ if($wrd=~/!h!$/ and $rword=~/^[!\.]$/);
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);
     
     mess("Pronunciation of hch || h,",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     if($wrd=~/(!ch!|!h!)$/ and $rword=~/^(!h!)/)
      {
       $wrd=~s/(!ch!|!h!)$/G/;
       $rword=~s/^(!h!)/h\\/;
      }
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);
     
     mess("Pronunciation of hch (NZH)",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     if($wrd=~/(!ch!|!h!)$/ and $rword=~/^($zne|$sm)/)
      {
       my $wb=$wrd;
       $wb=~s/(!ch!|!h!)$/h\\/;
       push @ostack,$wb;
       $wrd=~s/(!ch!|!h!)$/G/;
      }
     my $wb=$wrd;
     $wrd=~s/(!ch!|!h!) ([><;]) ($zne|$sm)/h\\ \2 \3 /;
     $wb=~s/(!ch!|!h!) ([><;]) ($zne|$sm)/G \2 \3 /;
     push @ostack,$wb if($wrd ne $wb);
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);

     mess("Applied rule: pronunciation of ch, h",4) if($owrd ne $wrd);
     push @ostack,$wrd;
   }
  @$stack=@ostack;
 }
 
sub rule_fv
 {
  my $stack=@_[0];
  my @lstack=@$stack;
  my @ostack=();
  my $zne="!b!|f_v|!d!|!z!|!dz!|!Z!|!dZ!|!D!|!g!|!h!|v|m";
  my $nez="!p!|!f!|!t!|!s!|!c!|!S!|!C!|!T!|!k!|!ch!";
  foreach $wrd (@lstack)
   {   
     my $owrd=$wrd;
     mess("Pronunciation of f,",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     $wrd=~s/!f!$/f/ if($wrd=~/!f!$/ and $rword=~/^[!\.]$/);
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);
     mess("Pronunciation of f || (NZ)",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     $wrd=~s/!f!$/f/ if($wrd=~/!f!$/ and $rword=~/^($nez)/);
     $wrd=~s/!f!$/f_v/;
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);
     mess("Pronunciation of v || n",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     if($wrd=~/!v!$/ and $rword=~/^(!n!)/)
      {
       $wrd=~s/!v!$/v/;
       push @ostack,$wrd;
       $wrd=~s/v$/f_v/;
      }
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);
     mess("Pronunciation of v || (NZ)",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     $wrd=~s/!v!$/f/ if($wrd=~/!v!$/ and $rword=~/^($nez)/);
     $wrd=~s/!v!$/f_v/;
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);
     mess("Applied rule: pronunciation of f",4) if($owrd ne $wrd);
     push @ostack,$wrd;
   }
  @$stack=@ostack;
 }
 
sub rule_NZ_ZN
 {
  my $stack=@_[0];
  my @lstack=@$stack;
  my @ostack=();
  my $zne="!b!|f_v|!d!|!z!|!dz!|!Z!|!dZ!|!D!|!g!|!h!|v|m";
  my $nez="!p!|!f!|!t!|!s!|!c!|!S!|!C!|!T!|!k!";
  my %asim_nz=('!p!'=>'b','f'=>'f_v','!t!'=>'d','!s!'=>'z','!c!'=>'dz',
               '!S!'=>'Z','!C!'=>'dZ','!T!'=>'J\\','!k!'=>'g');
  my %neasim=('!b!'=>'b','f_v'=>'f_v','!d!'=>'d','!z!'=>'z','!dz!'=>'dz',
  	      '!Z!'=>'Z','!dZ!'=>'dZ','!D!'=>'J\\','!g!'=>'g','!h!'=>'h\\',
	      '!p!'=>'p','!f!'=>'f','!t!'=>'t','!s!'=>'s','!c!'=>'ts',
	      '!S!'=>'S','!C!'=>'tS','!T!'=>'c','!k!'=>'k','!ch!'=>'x',
	      'm'=>'m','v'=>'v');
  my @sam=('a','E','I','O','U','a:','E:','I:','O:','U:');
  my $sam=join('|',@sam);
  my $es=" | - "; # Ziadna (Empty) alebo Slabicna hranica co je sice blbost ale ....
  foreach $wrd (@lstack)
   {   
     my $owrd=$wrd;
     mess("Assimilation of -kde, -kdy",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     $wrd=~s/($nez)($es)!k!($es)!d!($es)E$/$asim_nz{$1} g J\\ E/;
     $wrd=~s/($sam|!r!|!l!|!rd!|!ld!)($es)!k!($es)!d!($es)E$/$1 g J\\ E/;
     $wrd=~s/($nez)($es)!k!($es)!d!($es)I$/$asim_nz{$1} g d I/;
     $wrd=~s/($sam|!r!|!l!|!rd!|!ld!)($es)!k!($es)!d!($es)I$/$1 g d I/;
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);
     mess("Assimilation of so, ku",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     $wrd=~s/^!s!($es)O$/z O/;
     $wrd=~s/^!k!($es)U$/g U/;
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);
     #Na hranici dvoch slov
     mess("Assimilation of on the words boundarya",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     if($wrd=~/($nez)$/ and $rword=~/^($zne)/)
      { 
       $wrd=~s/($nez)$/$asim_nz{$1}/;
       $rword=~s/^($zne)/$neasim{$1}/;
      }
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);
     #Zlozene slova
     mess("Assimilation in compounded words",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     $wrd=~s/($nez) ; ($zne)/$asim_nz{$1} $neasim{$2}/;
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);
     #Pripony
     mess("Assimilation on the root-suffix boundary",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     $wrd=~s/($nez) > ($zne)/$asim_nz{$1} $neasim{$2}/;
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);
     #Na me!
     mess("Assimilation of 'me!'",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     my $owrd=$wrd;
     if($wrd=~/($nez)($es)m($es)E$/ and $rword eq "!")
      { 
       $wrd=~s/($nez)($es)m($es)E$/$asim_nz{$1} m E/;
      }
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);
     mess("Applied rule: Unvoiced-voiced transcription",4) if($owrd ne $wrd);
     push @ostack,$wrd;
   }
  @$stack=@ostack;
 }
 
sub rule_ZN_NZ
 {
  my $stack=@_[0];
  my @lstack=@$stack;
  my @ostack=();
  my $zne="!b!|f_v|!d!|!z!|!dz!|!Z!|!dZ!|!D!|!g!|!h!";
  my $nez="!p!|!f!|!t!|!s!|!c!|!S!|!C!|!T!|!k!|!ch!";
  my %asim_zn=('!b!'=>'p','f_v'=>'f','!d!'=>'t','!z!'=>'s','!dz!'=>'ts',
               '!Z!'=>'S','!dZ!'=>'tS','!D!'=>'c','!g!'=>'k','!h!'=>'x');
  my %neasim=('!b!'=>'b','f_v'=>'f_v','!d!'=>'d','!z!'=>'z','!dz!'=>'dz',
  	      '!Z!'=>'Z','!dZ!'=>'dZ','!D!'=>'J\\','!g!'=>'g','!h!'=>'h\\',
	      '!p!'=>'p','!f!'=>'f','!t!'=>'t','!s!'=>'s','!c!'=>'ts',
	      '!S!'=>'S','!C!'=>'tS','!T!'=>'c','!k!'=>'k','!ch!'=>'x',
	      'm'=>'m','v'=>'v');
  my $es=" | - "; # Ziadna (Empty) alebo Slabicna hranica co je sice blbost ale ....
  foreach $wrd (@lstack)
   {   
     mess("Assimilation of on the words boundarya",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     my $owrd=$wrd;
     #Na hranici dvoch slov
     if($wrd=~/($zne)$/ and $rword=~/^($nez)/)
      { 
       $wrd=~s/($zne)$/$asim_zn{$1}/;
       $rword=~s/^($nez)/$neasim{$1}/;
      }
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);
     #Predpony
     mess("Assimilation on prefix-root boundary",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     $wrd=~s/($zne) < ($nez)/$asim_zn{$1} $neasim{$2}/;
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);
     #Zlozene slova
     mess("Assimilation in compounded words",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     $wrd=~s/($zne) ; ($nez)/$asim_zn{$1} $neasim{$2}/;
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);
     #Na konci slova
     mess("Assimilation on the end of word",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     $wrd=~s/($zne)($es)($nez)$/$asim_zn{$1} $neasim{$3}/;
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);
     #Pripony
     mess("Assimilation on the root-affix boundary",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     $wrd=~s/($zne) > ($nez)/$asim_zn{$1} $neasim{$2}/;
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);
     #Na konci vety, pred medzerou
     mess("Assimilation on the end of the sentence, before pause",5);
     mess("Current status 1: \"$wrd\" RW: \"$rword\"",5);
     $wrd=~s/($zne)$/$asim_zn{$1}/ if($rword eq ".");
     mess("Current status 2: \"$wrd\" RW: \"$rword\"",5);

     mess("Applied rule: Voiced-unvoiced transcription",4) if($owrd ne $wrd);
     push @ostack,$wrd;
   }
  @$stack=@ostack;
 }


sub rule
 {
  my ($stack,$s1,$s2,$msg)=@_;
  my @lstack=@$stack;
  my @ostack=();
  mess($msg,5);
  my @rls=split("::",$s2);
  foreach $s2 (@rls)
   { mess("Rule: s/$s1/$s2/g",5);}
  foreach $wrd (@lstack)
   {   
     $wrd=~s/^/- /; #Na zaciatku a konci aby hranice slov boli brane 
     $wrd=~s/$/ -/; #aj ako hranice slabik koli implementacii
     mess("Current status 1: \"$wrd\"",5);
     my $owrd=$wrd;
     $s2=$rls[0];
     my $last=$wrd;
     #warn "Skutocne s1: '$s1' a s2: '$s2'\n";
     for($yy=0;$yy<5;$yy++) #znacne neciste, ale teraz neriesim ...
      { 
        $wrd=~s/$s1/$s2/e; 
        my $a=$1; my $b=$2; my $c=$3; my $d=$4;
        $wrd=~s/\\1/$a/g; $wrd=~s/\\2/$b/g; $wrd=~s/\\3/$c/g; $wrd=~s/\\4/$d/g;
      }
     #warn "a: '$a' b: '$b' c: '$c' d: '$d'\n";
     mess("Current status 2: \"$wrd\"",5);
     mess("Applied rule: s/$s1/$s2/g",4) if($owrd ne $wrd);
     $wrd=~s/^- //;
     $wrd=~s/ -$//;
     push @ostack,$wrd;
     if(@rls==2)
      {
        $s2=$rls[1];
     	$last=~s/$s1/$s2/eg;
     	my $a=$1; my $b=$2; my $c=$3;
     	$last=~s/\\1/$a/g; $last=~s/\\2/$b/g; $last=~s/\\3/$c/g;
     	mess("Current status 2: \"$last\"",5);
     	$last=~s/^- //;
     	$last=~s/ -$//;
     	push @ostack,$last if($last ne $wrd);
      }
   }
  @$stack=@ostack;
 }

sub prepis_sam
  {
    mess("Transcription of vowels and diphthongs ...",3);
    my @spol=('!b!','!c!','!C!','!d!','!D!','!f!','!g!','!h!','!j!','!k!',
	     '!l!','!ld!','!L!','!m!','!n!','!N!','!p!','!q!','!r!','!rd!',
	     '!s!','!S!','!t!','!T!','!v!','!w!','!x!','!z!','!Z!','!ch!',
	     '!dz!','!dZ!');
    my %sam=('!a!'=>'a','!e!'=>'E','!i!'=>'I','!o!'=>'O','!u!'=>'U','!y!'=>'I',
	     '!A!'=>'a:','!E!'=>'E:','!I!'=>'I:','!O!'=>'O:','!U!'=>'U:','!Y!'=>'I:');
    my %lc_sam=('!a!'=>'a','!e!'=>'E','!i!'=>'I','!o!'=>'O','!u!'=>'U','!y!'=>'I');
    my %dif=('!i! !a!'=>'I_^a','!i! !e!'=>'I_^E','!i! !u!'=>'I_^U','!uo!'=>'U_^O');
    my %samsk=('!a! !i!'=>'a I','!a! !u!'=>'a U','!o! !i!'=>'O I','!o! !o!'=>'O O',
               '!o! !u!'=>'O U','!i! !i!'=>'I I','!y! !u!'=>'I U','!a! !o!'=>'a O',
	       '!e! !a!'=>'E a','!e! !A!'=>'E a:','!E! !o!'=>'E: O','!i! !E!'=>'I E:',
	       '!i! !o!'=>'I O','!i! !O!'=>'I O:','!o! !e!'=>'O E','!o! !i!'=>'O I',
	       '!o! !o!'=>'O O','!u! !u!'=>'U U','!e! !a! !e!'=>'E a E',
	       '!e! !e! !u!'=>'E E U','!e! !o! !a!'=>'E O a','!e! !o! !i!'=>'E O I',
	       '!o! !i! !o!'=>'O I O');

    my $spol=join('|',@spol);
    $spol .='|-';    #hranica slabiky uvazovana ako spoluhlaska koli impl.
    my $es=" | - ";

    my @samstack;
    my %normal=('!t!'=>'t','!d!'=>'d','!n!'=>'n','!l!'=>'l');
    foreach $wrd (@stack)
     {
      $_=$wrd;
      mess("Current status: \"$_\"",5);
      mess("TDNL tdnl before yY ...",4);
      s/(!t!|!d!|!n!|!l!)($es)!y!/$normal{$1} I/g;
      s/(!t!|!d!|!n!|!l!)($es)!Y!/$normal{$1} I:/g;
      mess("Current status: \"$_\"",5);
      #Tuna je osetrenie predpony pri
      mess("Pronunciation of prefix 'pri' ...",4);
      mess("Current status: \"$_\"",5);
      #pria
      #if(/^!p! !r! !i! !a!/)
      if($ncodw[$wpos]=~m/^pria/)
       {
        my $ori=$_;
	my $rc=check_dic($dic_pri,"^pria",$wpos);
	$_=$ori;
	s/^!p! !r! !i!($es)!a!/p r I_^a/ if($rc==1);
	s/^!p! !r! !i!($es)!a!/p r I a/ if($rc==0);
       }
      #prie
      #if(/^!p! !r! !i! !e!/)
      if($ncodw[$wpos]=~m/^prie/)
       {
        my $ori=$_;
	my $rc=check_dic($dic_pri,"^prie",$wpos);
	$_=$ori;
	s/^!p! !r! !i!($es)!e!/p r I E/ if($rc==1);
	s/^!p! !r! !i!($es)!e!/p r I_^E/ if($rc==0);
       }
      #priu
      #if(/^!p! !r! !i! !u!/)
      if($ncodw[$wpos]=~m/^priu/)
       {
	s/^!p! !r! !i!($es)!u!/p r I U/;
       }
      #Tuna bolo osetrenie predpony pri
      mess("Single vowels ...",4);
      foreach $sc (keys %sam)
       {
	s/^$sc($es)($spol)/$sam{$sc} \2/;            # a na zaciatku slova
	s/($spol)($es)$sc($es)($spol)/\1 $sam{$sc} \4/g;  # a v strede
	s/($spol)($es)$sc($es)($spol)/\1 $sam{$sc} \4/g;  # a v strede
	s/($spol)($es)$sc$/\1 $sam{$sc}/;             # a na konci
       }
      s/!uo!/$dif{"!uo!"}/g;   #prepis ô   DFR
      s/!u! !o!/$sam{"u"} $sam{"o"}/g; #prepis uo
      foreach $sc (keys %sam)
       {
	s/^!v! !y!($es)$sc/v $sam{"i"} $sam{$sc}/;  #prepis vy?- ako vyexpedovat ...
       }
      mess("Current status: \"$_\"",5);

      #Dvojhlasky
      #Dvojhlaska na konci  
      mess("Pronunciation of diphthongs at the end ...",4);
      mess("Current status: \"$_\"",5);
      foreach $sc (keys %lc_sam)
       {
	mess("Testing \"!i! $sc\" ...",5);
       # while(/!i! $sc$/)
	  {
            mess("Current status: \"$_\"",5);
            my $ori=$_;
	    my $rc=check_dic($dic_pri,"iaeu\$",$wpos);
	    $_=$ori;
	    s/($spol)($es| < | > )!i!($es)$sc$/\1 I $sam{$sc}/ if($rc==1);         # diftong na konci
	    s/($spol)($es| < | > )!i!($es)$sc$/\1 $dif{"!i! $sc"}/ if($rc==0);     # diftong na konci
	    s/^!i!($es)$sc$/\1 I $sam{$sc}/ if($rc==1);         # diftong na konci
	    s/^!i!($es)$sc$/\1 $dif{"!i! $sc"}/ if($rc==0 and defined($dif{"!i! $sc"}));     # diftong na konci
	  }
       }
      #V strede a na zaciatku. Tato postupnost nutna koli WB uvazovanom ako spoluhlaske 
      foreach $sc (keys %dif)
       {
	s/($spol)($es)$sc($es)($spol)/\1 $dif{$sc} \4/g;  # diftong v strede
	s/($spol)($es)$sc($es)($spol)/\1 $dif{$sc} \4/g;  # diftong v strede
       }

      #Samohlaskove skupiny
      foreach $sc (keys %samsk)
       {
	s/($spol)($es)$sc($es)($spol)/\1 $samsk{$sc} \4/g;  # a v strede
	s/($spol)($es)$sc($es)($spol)/\1 $samsk{$sc} \4/g;  # a v strede
       }
      
      foreach $sc (keys %sam)
       {
	s/$sc/$sam{$sc}/g; #Vsetky ostatne samohlasky. Kedze len domace slova.
       }
      push @samstack,$_;
     }
     
    @stack=@samstack; 

    if($alt==1) #Generuj kratke samohlasky
    {
     $ori=$_;
     s/a:/a/g; s/E:/E/g; s/I:/I/g; s/O:/O/g; s/U:/U/g;
     push @stack,$_ if($_ ne $ori);
    }
  }

sub check_exceptions
  {
    $_=$ncodw[$wpos];
    mess("Exception check: $_ :: $mword ...",4);
    foreach $k (keys %exceptions)
     {
       mess("Checking $_ <==> $k",5);
       if(/$k/)
        {
          @stack=split(";",$exceptions{$k});
          mess("Found: $_ ==> $exceptions{$k}",4);
	  m/$k/g;
	  my $epos=pos $_; 
	  my $mp=$k; $mp=~s/[\^\$]//g;
	  my $pml=length $mp;
	  my $bpos=$epos-$pml;
	  my $suf=substr $_,$epos;
	  my $pref=substr $_,0,$bpos;
	  $suf=cod2uni($suf);
	  $pref=cod2uni($pref);
	  mess("Position $bpos to $epos of $k in $_ ...",5);
	  foreach $si (@stack)
	   {
	    $si="$pref ".$si." $suf";
	    $si=~s/^ //;
	    $si=~s/ $//;
	    $si=~s/  / /g;
	   }
	  return;
        }
     }
  }

sub check_dic
  {
    my $dic=$_[0];
    my $rule=$_[1];
    my $pos=$_[2];
    my $slovo=$ncodw[$pos];
    my $fit=0;
    my $rc=0;
    open(DIC,"<$dic") or die("Can not open $dic !!!\n");
    mess("Testing word: \"$slovo\" against voc. $dic ...",4);
    while(<DIC>)
     {
        chomp;
        my $ln=$_;
    	my($rl,$wr)=split("::",$ln);
	if($rule eq $rl)
	 {
	   $wr=lc_1($wr);
	   $_=$slovo;
           mess("Comparing $wr and $slovo",5);
	   if(/$wr/)
	    {
	      mess("Applied rule: $ln ",4);
	      $rc=1;
	    }
	 }
     }
    close DIC;
    mess("Test done, returning '$rc' ...",5);
    return $rc;
  }

sub extract_word
  {
    $pos=$_[1];
    $_=substr($_[0],$pos);
    if(/ -/)
     {
      my $xx=index($_," -");
      $_=substr($_,0,$xx);
     }
    mess("Extracted word: $_ ...\n",5);
    return $_;
  }

sub process_arguments
  {
    if(@ARGV==0)
      {
	$ifile="-";
	mess("Reading from standard input ...",1);
      }
    else
      {
	$ifile=$ARGV[0];
      }

    mess("Input:\t $ifile",1);
    mess("Output:\t $ofile",1) if($ofile ne "");
  }

sub read_exceptions
  {
    mess("Reading exceptions ...",4);
    open(FF,$dic_gen) or die("Can not open exceptions file $dic_gen ...\n");
    while(<FF>)
     {
       chomp;
       s/\t/ /g;
       ($k,$rest)=split /\|/,$_;
       $_=$k; s/[ ]*//g; $k=$_;
       $_=$rest; s/[ ]*//g;
       s/(.)/\1 /g;
       s/ :/:/g;
       s/ _ /_/g;
       s/t s/ts/g;
       s/t S/tS/g;
       s/d z/dz/g;
       s/d Z/dZ/g;
       s/ \\/\\/g;
       $exceptions{$k}=$_;
       mess("Red: $k ==> $_",5);
     }
    close FF;
  }

sub printhelp
  {
    print "Automatic phonetic transcription for Slovak language ...\n\n";
    print "Usage: $0 [--dl] [--color] [--help] [ofile <file_name>] [<input_file>]\n";
    print "\t --dl:number \t Debug level [0-5]. Default is 1.\n";
    print "\t --color - Enable color output.\n";
    print "\t --help \t Print this help.\n";
    print "\t --ofile <file_name> - Write output also in to the file.\n";
    print "If no input file is specified, standard input is used ...\n";
    exit(0);
  }
  

END { } 


