#!/usr/bin/perl ############################################ # text2phone: # # David HAUBENSACK, haubensack@cea.fr, 1996 # d'apres un script de Alistair CONKIE require 5.001; use FileHandle; ############################################ # program principal: # # faire "text2phone -h" pour avoir une aide. # debut de configuration: #$olabase = $ENV{"II_OLA_BASE"}; #$text2phonebase = $ENV{"II_OLA_BASE"}; # $olabase = "fr1"; $olabase = "/home/jmv/install/mbrola-fr/fr"; # $text2phonebase = "base"; $text2phonebase = "/home/jmv/install/tts-French/base"; # $mbrola_cmd = "| mbrola $olabase - -.au | audioplay"; $mbrola_cmd = "| mbrola $olabase - -.au > $ARGV[0]-$$.au"; $speed_ratio = 1.0; $tonal_ratio = 1.0; # fin de configuration. $debug = 0; $toprint = 0; $viewrules = 0; $doprosody = 1; while( $opt = $ARGV[0] ) { last if( !($opt =~ /^-/) ); if( $opt =~ /^-h/ ) { usage(); exit( 0 ); } elsif( $opt =~ /^-d/ ) { $debug = 1; } elsif( $opt =~ /^-D/ ) { $debug = 2; } elsif( $opt =~ /^-p/ ) { $toprint = 1; } elsif( $opt =~ /^-r/ ) { $viewrules = 1; } elsif( $opt =~ /^-n/ ) { $doprosody = 0; } elsif( $opt =~ /^-s/ ) { $speed_ratio = $ARGV[0]; $speed_ratio =~ s/^-s//; } elsif( $opt =~ /^-t/ ) { $tonal_ratio = $ARGV[0]; $tonal_ratio =~ s/^-t//; } shift @ARGV; } read_rules( $text2phonebase ); initialisation(); if( $viewrules ) { print_rules(); exit( 0 ); } if( ! $toprint ) { open( MBROLA, $mbrola_cmd ); MBROLA->autoflush( 1 ); } while( $phrase = <> ) { chop( $phrase ); if( $phrase eq "" ) { read_rules( $text2phonebase ); initialisation(); } print "------------------\n" if( $debug ); $phrasefiltered = filter_sentence( $phrase ); $resultat = translator( $phrasefiltered ); if( $toprint ) { print $resultat; } else { if( $debug ) { print "------------------\n"; print $resultat; } # enleve les commentaires et envoie a MBROLA: $resultat =~ s/\s*;.*//g; print MBROLA $resultat; } } close( MBROLA ) if( ! $toprint ); ############################################ # usage: sub usage { print "text2phone -dhprn -sSPEED -tTONAL [file1 file2...]\n"; print " -h: aide.\n"; print " -d: mode debug léger.\n"; print " -D: mode debug lourd.\n"; print " -p: sortie sur stdout (defaut vers MBROLA).\n"; print " -r: liste les règles.\n"; print " -n: pas de prosodie.\n"; print " -s: fixe le ratio de vitesse à SPEED (defaut=1.0).\n"; print " -t: fixe le ratio de tonalité à TONAL (defaut=1.0).\n"; } ############################################ # initialisation: sub initialisation { # frequence offset: $f_offset = -8; # frequence au debut d'une phrase: $f_start = 120; $f_stat += $f_offset; $f_stat *= $tonal_ratio; # frequence pres de la fin d'une phrase: $f_nearend = 85; $f_nearend += $f_offset; $f_nearend *= $tonal_ratio; # frequence a la fin d'une phrase: $f_end = 70; $f_end += $f_offset; $f_end *= $tonal_ratio; # frequence a la fin d'une phrase interrogative: $f_intero = 175; $f_intero += $f_offset; $f_intero *= $tonal_ratio; # frequence pres de la fin d'une phrase interrogative: $f_nearintero = 130; $f_nearintero += $f_offset; $f_nearintero *= $tonal_ratio; # frequence au debut d'une pause courte: $f_startpause = 111; $f_startpause += $f_offset; $f_startpause *= $tonal_ratio; # frequence a la fin d'une pause courte: $f_endpause = 98; $f_endpause += $f_offset; $f_endpause *= $tonal_ratio; # frequence au debut d'une liaison: $f_startlegato = 108; $f_startlegato += $f_offset; $f_startlegato *= $tonal_ratio; # frequence a la fin d'une liaison: $f_endlegato = 102; $f_endlegato += $f_offset; $f_endlegato *= $tonal_ratio; # vitesse (%) normal: $speed_normal = 100; # vitesse (%) apres une pause (.): $speed_startpause = 80; # vitesse (%) avant une pause: $speed_endpause = 130; # vitesse (%) apres une pause courte (_): $speed_startpause = 90; # vitesse (%) apres une liaison (&): $speed_startlegato = 93; # augmentation de vitesse a chaque phoneme: $incspeed = 5; # durees moyennes des phonemes: %durations = ( '<' , 150, # pause normale montante (ponctuation) # jmv '>' , 150, # pause normale descendante (ponctuation) '>' , 700, # pause normale descendante (ponctuation) ':' , 14, # pause forcee entre 2 mots '&' , 0, # pause nul entre deux mots lies '_' , 14, # pause courte entre deux mots non-lies 'p' , 96, 'b' , 74, 't' , 88, 'd' , 68, 'k' , 80, 'g' , 55, 'f' , 122, 'v' , 78, 'S' , 119, 'Z' , 79, 's' , 123, 'z' , 86, 'm' , 76, 'n' , 63, 'N' , 72, 'j' , 61, 'w' , 65, 'R' , 53, 'l' , 49, 'H' , 58, 'i' , 78, 'e' , 85, 'E' , 81, 'a' , 83, 'O' , 94, 'o' , 83, 'u' , 86, 'y' , 74, '2' , 106, '9' , 99, '@' , 75, 'o~' , 104, 'a~' , 111, 'e~' , 95, 'U~' , 102 ); $sampa = "p b t d k g f v S Z s z m n N j w R l H i e E a O o u y 2 9 @ o~ a~ e~ U~"; $sampa_c = "p b t d k g f v S Z s z m n N j w R l H"; $sampa_v = "i e E a O o u y 2 9 @ o~ a~ e~ U~"; $voyelles = $class{'V'}; $consonnes = $class{'C'}; $ponctuations = $class{'P'}; $chiffres = $class{'N'}; @nombres = ( "", " un", " deux", " trois", " quatre", " cinq", " six", " sept", " huit", " neuf", " dix", " onze", " douze", " treize", " quatorze", " quinze", " seize", " disept", " dizuit", " dizneuf", ); @dizaines = ( "", "", " vingt", " trente", " quarante", " cinquante", " soixante", " soixante", " quatrevingt", " quatrevingt", ); @puissances = ( "", " mille", " million", " milliard", ); %lettres = ( "a", "a", "b", "bé", "c", "sé", "d", "dé", "e", "oeu", "f", "èf", "g", "jé", "h", "ach", "i", "i", "j", "ji", "k", "ka", "l", "èl", "m", "èm", "n", "èn", "o", "o", "p", "pé", "q", "ku", "r", "èr", "s", "ès", "t", "té", "u", "u", "v", "vé", "w", "doublevé", "x", "ix", "y", "igrèk", "z", "zèd", ) } ############################################ # read rules: # # load phonetic rules from a file into @rulebase sub read_rules { my $filename = shift; my $n = 0; @rulebase = (); print "RULES\n" if( $debug ); unless( open( RULES, "$filename" ) ) { print STDERR "Impossible d'ouvrir la base de règles: $!\n"; return(1); } # reading rules flag: $reading_rules = 0; while( $in = ) { # supprime la fin de ligne: chop; # supprime les commentaires: $in =~ s/\#.*//; # evite les lignes blanches: if( $in =~ /^\s*$/ ) { next; } if( $in =~ /^RULE[S]?$/ ) { # keyword RULE: # (debut des regles) if( $reading_rules == 0 ) { $reading_rules = 1; next; } else { print STDERR "Trop de RULES\n"; return(1); } } elsif( $in =~ /^CLASS/ ) { # keyword CLASS: # (classes de lettres) if( $reading_rules == 0 ) { @class = split( ' ', $in ); shift( @class ); $classkey = shift( @class ); $class{$classkey} = join( ' ', @class ); next; } else { print STDERR "CLASS seulement avant RULES\n"; return(1); } } elsif( $reading_rules == 1 ) { # lecture des regles: # remplace les classes de lettres par leur liste: $again = 1; while( $again ) { $again = 0; foreach $celem (keys(%class)) { $again += ($in =~ s/$celem(.*)\[\[/$class{$celem}$1\[\[/g); $again += ($in =~ s/\]\](.*)$celem(.*)\-\>/\]\]$1$class{$celem}$2\-\>/g); } } @bits = read_rule( $in ); $n++; # using $headletter cuts down the rules to be searched # (extrait la premiere lettre de la target): if( $bits[0] ne '' ) { $headletter = $bits[0]; $headletter =~ s/^(.).*/$1/; } else { $headletter = ''; } # ajoute la clef @bits a la liste des regles # commencant par $headletter: push( @{$rulebase{$headletter}}, [ @bits ] ); } } $reading_rules = 0; close(RULES); } ############################################ # read_rule: # # load one rule sub read_rule { my $rule = $_[0]; my $lc; my $targ; my $rc; my $out; if( $rule =~ /^\s*((\S+)\s+)?\[\[ (.*) \]\]\s+((\S+)\s+)?\-\>(.*)/ ) { $lc = $2; $targ = $3; $rc = $5; $out = join( ' ', split( ' ', $6 ) ); return( ($targ,$lc,$rc,$out) ); } } ############################################ # print all rules: sub print_rules { my $targ; my $lc; my $rc; my $out; foreach $hl ( sort( keys( %rulebase ) ) ) { print "headletter [$hl]\n"; foreach $key (@{$rulebase{$hl}}) { ($targ,$lc,$rc,$out) = @{$key}; printf " %s / [%s] / %s = %s\n", $lc, $targ, $rc, $out; } } } ############################################ # filter_sentence: # # prepare a sentence for translation sub filter_sentence { my $phrase = shift; my $tmp = ""; # minuscules: $phrase =~ tr/A-Z/a-z/; # transforme les faux accents: $phrase =~ s/e\'/é/g; $phrase =~ s/a\`/à/g; $phrase =~ s/e\`/è/g; $phrase =~ s/u\`/ù/g; $phrase =~ s/a\^/â/g; $phrase =~ s/e\^/ê/g; $phrase =~ s/i\^/î/g; $phrase =~ s/o\^/ô/g; $phrase =~ s/u\^/û/g; $phrase =~ s/i\"/ï/g; $phrase =~ s/o\"/ö/g; $phrase =~ s/u\"/ü/g; $phrase =~ s/c,([a-z])/ç$1/g; # transforme temporairement les apostrophes (eventuellement # suivies d'un espace) en A: $phrase =~ s/\'(\s)*/A/g; # traduit les lettres isolees: $reste = $phrase; $phrase = ""; while( $reste =~ /(^|.*(\W|\d))([a-z])((\W|\d).*|$)/ ) { $tmp = $lettres{ $3 }; $phrase .= $1 . $tmp; $reste = $4; } $phrase .= $reste; # recupere les apostrophes: $phrase =~ s/A/\'/g; # traduit les virgules decimales: $phrase =~ s/(\d)\.(\d)/$1 virgule $2/g; # rajoute un espace entre un chiffre et une lettre: $phrase =~ s/(\d)([a-z])/$1 $2/g; print "->[$phrase]\n" if( $debug ); # traduit les nombres: while( $phrase=~ /(\D*)(\d+)(.*)/ ) { $tmp = translate_number( $2 ); print "$2 = $tmp\n" if( $debug ); $phrase = $1 . $tmp . $3; } # supprime les traits d'union: $phrase =~ s/\-/ /g; # enleve les espaces autour des ponctuations: $phrase =~ s/\s*($ponctuations)\s*/$1/g; # supprime les doubles espaces et les change en _: $phrase =~ s/\s+/_/g; # change une lettre/espace final en un point: $phrase =~ s/(\w)$/$1./; # change une lettre/espace final en un point: $phrase =~ s/_$/./; print "->[$phrase]\n" if( $debug ); $phrase; } ############################################ # translator: # # translate a sentence into MBROLA input. sub translator { my $input = shift; # mot a traduire my $k = $input; my $output = ""; my $resultat = ""; ( $k, $output ) = phonetize( $input ); $output2 = make_legato( $output ); if( $doprosody ) { $resultat = simple_prosody( $output2 ); } else { $resultat = no_prosody( $output2 ); } if( $debug ) { print "------------------\n"; printf "[$k]\n"; printf "->[$output]\n"; printf "->[$output2]\n"; } $resultat; } ############################################ # phonetize: # # traduce a sentence into phonems sub phonetize { my $right = shift; # contient le reste du mot a traduire my $key; # regle/clef courante my $w; # contient le decoupage du mot en cibles my $t; # resultat my $lc; # clef: membre gauche my $targ; # clef: membre central/cible my $rc; # clef: membre droit my $out; # clef: phoneme en sortie my $left = ''; # contient la partie du mot deja resolue print "------------------\n" if( $debug == 2 ); WHLOOP: while( $right ne '' ) { # recupere la premiere lettre du mot: $hl = $right; $hl =~ s/^(.).*/$1/; # on examine les differentes regles commencant par $hl: foreach $key (@{$rulebase{$hl}}) { ($targ,$lc,$rc,$out) = @{$key}; if( ($left =~ /$lc$/) && ($right =~ /^\Q$targ\E($rc.*)/) ) { $left .= $targ; $right = $1; $w = "$w|$targ"; $t = "$t $out"; print "examine ($left/$right) [$targ] $lc:$rc -> $out\n" if( $debug == 2 ); next WHLOOP; } } # on n'a pas trouve de regle correspondante: if( $right =~/^(.)(.*)/ ) { $left .= $1; $right = $2; $w = "$w|$1"; $t = "$t "; next WHLOOP; } } $t =~ s/\s+/ /g; $t =~ s/^ //g; $t =~ s/ $//g; $w =~ s/^\|//g; return( ($w,$t) ); } ############################################ # make_legato: # # change _ into & when a legato can be done. sub make_legato { my $input = shift; my $output = ""; my @sequence = (); my $cur = ""; my $prec = ""; my $cur_v = 2; my $prec_v = 2; my $ante_v = 2; @sequence = split( ' ', $input ); foreach $cur ( @sequence ) { $cur_v = (($sampa_v =~ /$cur/) != 0); if( $prec eq "_" ) { if( $cur_v + $ante_v != 1 ) { $output .= " _"; } else { $output .= " &"; } } else { $output .= " $prec"; } $prec = $cur; $ante_v = $prec_v; $prec_v = $cur_v; } $output .= " $prec"; $output =~ s/\s+/ /g; $output =~ s/^ //g; $output =~ s/ $//g; # retransforme les : en _ $output =~ s/:/_/g; $output; } ############################################ # simple_prosody: # # generate a simple prosody # (durations+frequencies): sub simple_prosody { my $input = shift; my @sequence = (); my $prec = ""; my $pho = ""; my $suiv = ""; my $resultat = ""; @sequence = split( ' ', $input ); $resultat .= "_ 200 0 $f_start\n"; $speed = $speed_startpause; $f_suiv = 0; foreach $suiv ( @sequence ) { $resultat .= calc_duree( $prec, $pho, $suiv ) if( $pho ne "" ); $prec = $pho; $pho = $suiv; } $resultat .= calc_duree( $prec, $pho, "" ); $resultat .= "_ 200 0 $f_end\n"; $resultat .= "#\n"; $resultat; } ############################################ # calc_duree: # # compute the duration of one phonem, # considering the next one sub calc_duree { my $prec = shift; my $pho = shift; my $suiv = shift; my $resultat = ""; my $notend = ($sampa =~ /$suiv/) || ($suiv eq "&"); if( $suiv eq "&" ) { $freq = $f_endlegato; } if( $suiv eq "<" ) { $freq = $f_nearintero; } if( $suiv eq ">" ) { $freq = $f_nearend; } if( $prec eq "&" ) { $freq = $f_startlegato; } if( $pho ne "" ) { $duree = 90; if( exists( $durations{$pho} ) ) { $duree = $durations{$pho}; } $speed = $speed_endpause if( ! $notend ); $duree *= $speed*$speed_ratio/100; $duree = int( $duree ); if( $pho eq "<" ) { $resultat .= "_ $duree 0 $f_intero ; sp=$speed\n"; $freq = $f_start; $speed = $speed_startpause; } elsif( $pho eq ">" ) { $resultat .= "_ $duree 0 $f_end ; sp=$speed\n"; $freq = $f_start; $speed = $speed_startpause; } elsif( $pho eq "_" ) { $resultat .= "_ $duree 0 $f_endpause; sp=$speed\n"; $freq = $f_startpause; $speed = $speed_startpause; } elsif( $pho eq "&" ) { $speed = $speed_startlegato; } else { if( $freq == 0 ) { $resultat .= "$pho $duree ; sp=$speed\n"; } else { $resultat .= "$pho $duree 0 $freq ; sp=$speed\n"; } $freq = 0; if( $speed < $speed_normal ) { $speed += $incspeed; } else { $speed = $speed_normal; } } } $resultat; } ############################################ # no_prosody: # # generate no prosody sub no_prosody { my $input = shift; my @sequence = (); my $pho = ""; my $resultat = ""; @sequence = split( ' ', $input ); $resultat .= "_ 200 0 102\n"; foreach $pho ( @sequence ) { next if( $pho eq "&" ); $pho = "_" if( "<>_" =~ /$pho/ ); $resultat .= "$pho 90\n"; } $resultat .= "_ 200 0 102\n"; $resultat .= "#\n"; $resultat; } ############################################ # translate_number: # # translate a number into words. sub translate_number { my $nombre = shift; my $triplet = ""; my $puissance = 0; my $resultat = ""; my $intro = ""; if( $nombre == 0 ) { return "zéro"; } $nombre =~ s/^(0*)(.*)/$2/; $zeros = length($1); while( $zeros != 0 ) { $intro .= " zéro"; $zeros--; } while( $nombre =~ /(.*)(\d\d\d)/ ) { $triplet = $2; $nombre = $1; $resultat = translate_triplet( $triplet, $puissance ). $resultat; $puissance++; if( $puissance == 4 ) { $puissance = 1; } } $resultat = translate_triplet( $nombre, $puissance ). $resultat; $intro . $resultat; } sub translate_triplet { my $triplet = shift; my $puissance = shift; my $centaine = 0; my $dizaine = 0; my $unite = 0; my $resultat = ""; my $triplet2; $triplet = sprintf( "%3s", $triplet ); $triplet2 = $triplet; $triplet2 =~ s/\s/0/g; $triplet2 =~ /(\d)(\d)(\d)/; $centaine = $1; $dizaine = $2; $unite = $3; if( $triplet == 0 ) { return ""; } if( ($triplet == 1) && ($puissance == 1) ) { return @puissances[1]; } if( $centaine != 0 ) { if( $centaine != 1 ) { $resultat .= translate_chiffre( $centaine ); } $resultat .= " cent"; } if( $dizaine == 0 ) { $resultat .= translate_chiffre( $unite ); } else { $resultat .= @dizaines[$dizaine]; if( ($dizaine == 2) && ($unite != 0) ) { $resultat .= "t"; } if( ($dizaine == 1) || ($dizaine == 7) || ($dizaine == 9)) { if( ($dizaine == 7) && ($unite == 1) ) { $resultat .= " et"; } $resultat .= translate_chiffre( 10 + $unite ); } else { if( $unite == 1 ) { if( $dizaine != 8 ) { $resultat .= " et"; } } if( $unite != 0 ) { $resultat .= translate_chiffre( $unite ); } } } $resultat .= @puissances[$puissance]; $resultat; } sub translate_chiffre { my $chiffre = shift; my $resultat = ""; @nombres[$chiffre]; }