/[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

Contents of /trunk/mbrola.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5 - (show annotations)
Tue Aug 8 15:06:33 2006 UTC (14 years, 2 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 #!/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 use File::Slurp;
11
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 foreach my $df (qw/bp oo uks/) {
194 $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 my @pho = ({ char => '_', dur => [ $silence->{word} ] });
210
211 my ($g,$f) = ('','');
212
213 my $last_c = '';
214
215 my $i = 0;
216 while (@chars) {
217 my $c = shift @chars;
218
219 $g .= $c;
220
221 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 }
234
235 my $d = $durations->{$c} || $durations->{ lc($c) };
236
237 if (! $d) {
238 next if ($c =~ m/\s/);
239 warn "### skipped: $c\n";
240 $c = '_';
241 $d = $silence->{word};
242 }
243
244 my @dur = ( $d );
245
246 if ($last_c =~ m/[,\.!\? _]/) {
247
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 # begining of sentence
259 push @dur, ( 10, 120 );
260 }
261
262 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 dur => [ $silence->{sent} ],
271 };
272 $last_c = $c;
273 next;
274 } elsif ($c =~ m/,/) {
275 push @dur, ( 10, 100 );
276 }
277
278 # 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 dur => [ $silence->{word} ],
289 };
290 }
291
292 $last_c = $c;
293 push @pho, {
294 char => $c,
295 dur => \@dur,
296 };
297
298 $f .= $c;
299 }
300
301 push @pho, { char => '_', dur => [ $silence->{sent} ] };
302
303 # warn "# pho = ",dump(@pho),$/;
304
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 my $term = new Term::ReadLine 'Mbrola croatian speaker';
317 my $OUT = $term->OUT || \*STDOUT;
318
319 sub play_speak_hr {
320 my $text = shift || return;
321
322 my ($out,$g,$f) = speak_hr( $text );
323
324 open(my $fh, "| $mbrola - tmp.wav") || die "can't open $mbrola: $!";
325
326 print $OUT ">>> $g\n<<< $f\n";
327
328 print $fh $out || die "can't pipe to $mbrola";
329 close($fh) || die "error closing pipe to $mbrola";
330
331 $out =~ s/\n/ | /gs;
332 print $OUT "# $out\n";
333
334 system 'play tmp.wav';
335 }
336
337
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 }
351
352 my $prompt = "Prièaj: ";
353
354 while ( defined ($_ = $term->readline($prompt)) ) {
355 $term->addhistory( $_ );
356 play_speak_hr( $_ );
357 }
358
359
360 __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