/[mbrola]/trunk/mbrola.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /trunk/mbrola.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5 - (hide annotations)
Tue Aug 8 15:06:33 2006 UTC (14 years, 4 months ago) by dpavlin
File MIME type: text/plain
File size: 10167 byte(s)
support file as first argument. Lots of fun!
Minor tweaks to search engine: upper and lower case letters now work,
correct translation of x to ks (and other duphones which might came handy later),
all unknown characters (including digits and number which will be implemented)
are now skipped, input file can contain xml markup which will be stripped.
1 dpavlin 1 #!/usr/bin/perl -w
2    
3     # mbrola.pl
4     #
5     # 08/04/2006 07:54:54 PM CEST Dobrica Pavlinusic <dpavlin@rot13.org>
6    
7     use strict;
8     use Data::Dump qw/dump/;
9     use Term::ReadLine;
10 dpavlin 5 use File::Slurp;
11 dpavlin 1
12     my $letters = {
13     'a' => [['a'],
14     [[170,]]],
15     'A' => [['a'],
16     [[170,]]],
17     'b' => [['b', 'e', 'b', 'e',],
18     [[90,], [15,], [1,], [150,]]],
19     'B' => [['b', 'e', 'b', 'e',],
20     [[90,], [15,], [1,], [150,]]],
21     'c' => [['ts', 'a'],
22     [[30,], [100,]]],
23     'C' => [['ts', 'a'],
24     [[30,], [100,]]],
25     'è' => [['tS', 'a'],
26     [[30,], [100,]]],
27     'È' => [['tS', 'a'],
28     [[30,], [100,]]],
29     'æ' => [['tS\'', 'a'],
30     [[30,], [100,]]],
31     'Æ' => [['tS\'', 'a'],
32     [[30,], [100,]]],
33     'd' => [['d', 'e', 'd', 'e'],
34     [[70,], [15,], [60,], [1, 90, 100]]],
35     'D' => [['d', 'e', 'd', 'e'],
36     [[70,], [15,], [60,], [1, 90, 100]]],
37     'ð'=> [['dZ\'', 'a'],
38     [[100,], [110,]]],
39     'Ð'=> [['dZ\'', 'a'],
40     [[100,], [110,]]],
41     'e' => [['e', 'x', 'e'],
42     [[150, 10, 100], [1,], [50, 50, 90]]],
43     'E' => [['e', 'x', 'e'],
44     [[150, 10, 100], [1,], [50, 50, 90]]],
45     'f' => [['f', 'e'],
46     [[100, 10, 100], [100,]]],
47     'F' => [['f', 'e'],
48     [[100, 10, 100], [100,]]],
49     'g' => [['g', 'a'],
50     [[70,], [150,]]],
51     'G' => [['g', 'a'],
52     [[70,], [150,]]],
53     #'h' => [['x', 'r', 'a'],
54     # [[120,], [1,], [170,]]],
55     'h' => [['x', 'a', 'x', 'a'],
56     [[150,], [170,], [1,], [170,]]],
57     'H' => [['x', 'a', 'x', 'a'],
58     [[150,], [170,], [1,], [170,]]],
59     'i' => [['i'],
60     [[150,]]],
61     'I' => [['i'],
62     [[150,]]],
63     'j' => [['j', 'a', 'r'],
64     [[60,], [10,], [50,]]],
65     'J' => [['j', 'a', 'r'],
66     [[60,], [10,], [50,]]],
67     'k' => [['k', 'a'],
68     [[70,], [150,]]],
69     'K' => [['k', 'a'],
70     [[70,], [150,]]],
71     #'l' => [['l', 'e'],
72     # [[100, 10, 100], [100,]]],
73     'l' => [['e', 'l'],
74     [[100,], [100,10, 100]]],
75     'L' => [['e', 'l'],
76     [[100,], [100,10, 100]]],
77     #'m' => [['m', 'e'],
78     # [[90,], [50,]]],
79     'm' => [['e', 'm'],
80     [[50,], [90,]]],
81     'M' => [['e', 'm'],
82     [[50,], [90,]]],
83     #'n' => [['n', 'e'],
84     # [[90,], [50,]]],
85     'n' => [['e', 'n'],
86     [[50,], [90,]]],
87     'N' => [['e', 'n'],
88     [[50,], [90,]]],
89     'o' => [['o', 'x'],
90     [[71,], [70,]]],
91     'O' => [['o', 'x'],
92     [[71,], [70,]]],
93     #'p' => [['p', 'a'],
94     # [[70,], [150,]]],
95     'p' => [['p', 'e'],
96     [[90,], [120,]]],
97     'P' => [['p', 'e'],
98     [[90,], [120,]]],
99     #'r' => [['r', 'x'],
100     # [[90,], [110,]]],
101     'r' => [['e', 'r', 'x'],
102     [[150,10,100], [90,], [110,]]],
103     'R' => [['e', 'r', 'x'],
104     [[150,10,100], [90,], [110,]]],
105     's' => [['s', 'a'],
106     [[90,], [110,]]],
107     'S' => [['s', 'a'],
108     [[90,], [110,]]],
109     '¹' => [['S', 'a'],
110     [[70,], [110,]]],
111     '©' => [['S', 'a'],
112     [[70,], [110,]]],
113     #'t' => [['t', 'a'],
114     # [[90,], [120,]]],
115     't' => [['t', 'e'],
116     [[90,], [150,]]],
117     'T' => [['t', 'e'],
118     [[90,], [150,]]],
119     'u' => [['u'],
120     [[170,]]],
121     'U' => [['u'],
122     [[170,]]],
123     'v' => [['v', 'a'],
124     [[100,], [120,]]],
125     'V' => [['v', 'a'],
126     [[100,], [120,]]],
127     'z' => [['z', 'a'],
128     [[100,], [110,]]],
129     'Z' => [['z', 'a'],
130     [[100,], [110,]]],
131     '¾' => [['Z', 'a'],
132     [[100,], [110,]]],
133     '®' => [['Z', 'a'],
134     [[100,], [110,]]],
135     'x' => [['i', 'k', 's'],
136     [[60,], [60,], [50,]]],
137     'X' => [['i', 'k', 's'],
138     [[60,], [60,], [50,]]],
139     'y' => [['i', 'p', 's', 'i', 'l', 'o', 'n', 'e'],
140     [[60, 10, 90, 70, 110],
141     [70, 10, 100],
142     [50,], [40,], [60,], [70,], [70,], [10,]]],
143     'Y' => [['i', 'p', 's', 'i', 'l', 'o', 'n', 'e'],
144     [[60, 10, 90, 70, 110],
145     [70, 10, 100],
146     [50,], [40,], [60,], [70,], [70,], [10,]]],
147     'q' => [['k', 'u', 'x'],
148     [[70,], [110,], [1,]]],
149     'Q' => [['k', 'u', 'x'],
150     [[70,], [110,], [1,]]],
151     'w' => [['d', 'u', 'p', 'l', 'o', '_', 'v', 'e'],
152     [[54, 50, 100], [50, 50, 110], [85, 10, 100], [35,],
153     [54, 90, 95], [10,], [100, 90, 110], [120, 20, 95]]],
154     'W' => [['d', 'u', 'p', 'l', 'o', '_', 'v', 'e'],
155     [[54, 50, 100], [50, 50, 110], [85, 10, 100], [35,],
156     [54, 90, 95], [10,], [100, 90, 110], [120, 20, 95]]]}
157     ;
158    
159     my $phonemes = {
160     'a' => 'a', 'b' => 'b', 'c' => 'ts', 'è' => 'tS', 'æ' => 'tS\'', 'd' => 'd',
161     'd¾' => 'dZ', 'ð'=> 'dZ\'', 'e' => 'e', 'f' => 'f', 'g' => 'g', 'h' => 'x',
162     'i' => 'i', 'j' => 'j', 'k' => 'k', 'l' => 'l', 'lj'=> 'L', 'm' => 'm',
163     'n' => 'n', 'nj'=> 'J', 'o' => 'o', 'p' => 'p', 'r' => 'r', 's' => 's',
164     '¹' => 'S', 't' => 't', 'u' => 'u', 'v' => 'v', 'z' => 'z', '¾' => 'Z'
165     };
166    
167     my $durations = {
168     'a' => 61, 'b' => 65, 'ts' => 113, 'tS' => 90, 'tS\''=> 98, 'd' => 54,
169     'dZ' => 56, 'dZ\''=> 61, 'e' => 53, 'f' => 86, 'g' => 56, 'x' => 68,
170     'i' => 49, 'j' => 53, 'k' => 81, 'l' => 35, 'L' => 59, 'm' => 56,
171     'n' => 45, 'J' => 60, 'o' => 54, 'p' => 85, 'r' => 25, 's' => 91,
172     'S' => 99, 't' => 76, 'u' => 50, 'v' => 40, 'z' => 68, 'Z' => 74,
173     # pause
174     '_' => 150 }
175     ;
176    
177     my $token_to_grapheme = {
178     'x' => 'ks',
179     'q' => 'k',
180     'w' => 'v',
181     'y' => 'j',
182     };
183    
184     my $silence = {
185     'word' => 40,
186     'sent' => 100,
187     'comma' => 180,
188     'hard' => 100,
189     'spell' => 150
190     };
191    
192     my $recovery;
193 dpavlin 5 foreach my $df (qw/bp oo uks/) {
194 dpavlin 1 $recovery->{$df}++;
195     }
196    
197     sub speak_hr {
198    
199     my $text = shift @_ || 'ovo je na¹a difonska sinteza govora. kako vam se sviða? mo¾da èak i radi!';
200    
201     my $first = 1;
202     my $zarez = 0;
203    
204     my $speed = 1.2;
205    
206     # FIXME: lj, nj, d¾
207     my @chars = split(//, $text);
208    
209 dpavlin 3 my @pho = ({ char => '_', dur => [ $silence->{word} ] });
210 dpavlin 1
211     my ($g,$f) = ('','');
212    
213 dpavlin 2 my $last_c = '';
214    
215 dpavlin 5 my $i = 0;
216     while (@chars) {
217     my $c = shift @chars;
218 dpavlin 1
219     $g .= $c;
220    
221 dpavlin 5 if (defined( $phonemes->{ lc($c) } )) {
222     $c = $phonemes->{ lc($c) };
223     } elsif (defined( $token_to_grapheme->{ lc($c) } )) {
224     my $tmp = $token_to_grapheme->{ lc($c) };
225     if (length($tmp) > 1) {
226     my @tmp_c = split(//, $tmp);
227     warn "### $c --> $tmp\n";
228     $c = shift @tmp_c;
229     unshift @chars, ( @tmp_c );
230     } else {
231     $c = $tmp;
232     }
233 dpavlin 1 }
234    
235 dpavlin 5 my $d = $durations->{$c} || $durations->{ lc($c) };
236 dpavlin 1
237 dpavlin 5 if (! $d) {
238     next if ($c =~ m/\s/);
239     warn "### skipped: $c\n";
240     $c = '_';
241     $d = $silence->{word};
242     }
243    
244 dpavlin 1 my @dur = ( $d );
245    
246 dpavlin 3 if ($last_c =~ m/[,\.!\? _]/) {
247 dpavlin 1
248     my $from = $#{ $pho[ $i - 1 ]->{dur} };
249     $from = 3 if ($from > 3);
250    
251     my $tmpr = 80;
252    
253     foreach my $j ( -($from) .. 0 ) {
254     $pho[ $i - 1 ]->{dur}->[$j] = $tmpr;
255     $tmpr += 30;
256     }
257    
258 dpavlin 3 # begining of sentence
259     push @dur, ( 10, 120 );
260     }
261 dpavlin 1
262 dpavlin 3 if ($c =~ m/\s/) {
263     $pho[ $#pho ]->{dur}->[0] += $silence->{word};
264     $last_c = $c;
265     next;
266     } elsif ($c =~ m/[\.!\?]/) {
267     $pho[ $#pho ]->{dur}->[0] += $silence->{word};
268     push @pho, {
269     char => '_',
270 dpavlin 5 dur => [ $silence->{sent} ],
271 dpavlin 3 };
272     $last_c = $c;
273     next;
274     } elsif ($c =~ m/,/) {
275     push @dur, ( 10, 100 );
276 dpavlin 1 }
277    
278 dpavlin 2 # same last chars? double duration
279     if ($last_c eq $c) {
280     $pho[ $#pho ]->{dur}->[0] *= 2;
281     next;
282     }
283    
284     # fixup sequences that need special handling
285     if (defined($recovery->{ $last_c . $c })) {
286     push @pho, {
287     char => '_',
288 dpavlin 3 dur => [ $silence->{word} ],
289 dpavlin 2 };
290     }
291    
292     $last_c = $c;
293 dpavlin 1 push @pho, {
294     char => $c,
295     dur => \@dur,
296     };
297    
298     $f .= $c;
299     }
300    
301 dpavlin 3 push @pho, { char => '_', dur => [ $silence->{sent} ] };
302 dpavlin 1
303 dpavlin 3 # warn "# pho = ",dump(@pho),$/;
304 dpavlin 1
305     my $out;
306    
307     foreach my $p (@pho) {
308     $out .= $p->{char} . ' ' . join(' ', map { $_ * $speed } @{ $p->{dur} }) . "\n";
309     }
310    
311     return ($out, $g, $f);
312     }
313    
314     my $mbrola = './bin/mbrola-linux-i386 ./cr1/cr1';
315    
316 dpavlin 5 my $term = new Term::ReadLine 'Mbrola croatian speaker';
317     my $OUT = $term->OUT || \*STDOUT;
318 dpavlin 1
319 dpavlin 5 sub play_speak_hr {
320     my $text = shift || return;
321 dpavlin 1
322 dpavlin 5 my ($out,$g,$f) = speak_hr( $text );
323 dpavlin 1
324     open(my $fh, "| $mbrola - tmp.wav") || die "can't open $mbrola: $!";
325    
326 dpavlin 3 print $OUT ">>> $g\n<<< $f\n";
327 dpavlin 1
328     print $fh $out || die "can't pipe to $mbrola";
329     close($fh) || die "error closing pipe to $mbrola";
330    
331 dpavlin 3 $out =~ s/\n/ | /gs;
332     print $OUT "# $out\n";
333    
334 dpavlin 1 system 'play tmp.wav';
335 dpavlin 5 }
336 dpavlin 1
337 dpavlin 5
338     if (my $path = shift @ARGV) {
339     my $text = read_file($path) || die "can't read $path: $!";
340    
341     # strip html
342     $text =~ s!</?[^>]+>! !gs;
343    
344     $text =~ s!\s+! !gs;
345    
346     print "-- $text --";
347    
348     play_speak_hr( $text );
349     exit;
350 dpavlin 1 }
351    
352 dpavlin 5 my $prompt = "Prièaj: ";
353 dpavlin 1
354 dpavlin 5 while ( defined ($_ = $term->readline($prompt)) ) {
355     $term->addhistory( $_ );
356     play_speak_hr( $_ );
357     }
358    
359    
360 dpavlin 1 __END__
361    
362     foreach my $c (split(//, $text)) {
363     warn "# c = $c\n";
364    
365     if (! defined($letters->{$c})) {
366     print "_ 50\n";
367     next;
368     }
369    
370     my $slova = $letters->{$c}->[0];
371     my $param = $letters->{$c}->[1];
372     warn "# ",dump($slova, $param), $/;
373     foreach my $i ( 0 ... $#$slova ) {
374     print $slova->[$i], " ", join(" ",@{ $param->[$i] }), "\n";
375     }
376    
377     }

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26