scripts/atis/synth.pl

   1 #! /usr/bin/perl -w
   2
   3 use strict;
   4 use Symbol;
   5 use Audio::Wav;
   6
   7 sub usage {
   8   print <<EoF;
   9 Run a bunch of words through the speech synthesizer
  10 and collect the results.
  11 Typical usage:
  12   ./synth.pl [options] sport.vlist sport.vce sport.wav
  13
  14   Options include:
  15     -skip       # skip a line from the .vlist file;
  16     -one        # take only the first word from each line
  17
  18 Note: -skip -one is useful if the .vlist file is actually in .vce format.
  19
  20 Other usages:
  21   ./synth.pl -dump foo.wav    # dump headers 'foo.wav'
  22   ./synth.pl -help            # print this message
  23
  24 where sport.vlist is a file containing a list of words, we use the
  25 first word on each line and ignore anything else on that line
  26 (which means a .vce file is acceptable as input, using -skip -one).
  27
  28 Note that "atis-lex.pl" and "list-airports.pl" are useful for
  29 creating the .vlist file.
  30
  31 Note that you may also need to:
  32   cpan Audio::Wav
  33   apt-get install festival mbrola sox festlex-oald
  34   cd \$tars
  35     wget http://tcts.fpms.ac.be/synthesis/mbrola/dba/en1/en1-980910.zip
  36     wget http://www.cstr.ed.ac.uk/downloads/festival/1.95/festvox_en1.tar.gz
  37   cd /usr/share/festival/voices/english
  38   mkdir en1_mbrola
  39   cd en1_mbrola
  40   unzip \$tars/en1-980910.zip
  41   cd /usr/share/festival
  42   mkdir lib
  43   cd lib
  44   ln -s ../voices ./
  45   cd /usr/share
  46   tar -xpzvf \$tars/festvox_en1.tar.gz
  47
  48 You may also need to scrounge a non-buggy version of
  49   /usr/local/share/perl/5.10.1/Audio/Wav/Read.pm
  50 EoF
  51 }
  52
  53 my $proto = <<EoF;
  54  (voice_en1_mbrola) ;; best voice I know of
  55  (setq voice_rab_diphone voice_en1_mbrola)
  56  (setq voice_en1 voice_en1_mbrola)
  57  (setq voice_el_diphone voice_en1_mbrola)
  58  (setq voice_ked_diphone voice_en1_mbrola)
  59  (utt.save.wave (utt.synth (Utterance Text "XXX")) "YYY" 'riff)
  60 EoF
  61
  62 my %list;
  63 my %count;
  64
  65 sub doit {
  66     my ($word) = @_;
  67     if (exists $list{lc $word}
  68       && $list{lc $word} =~ m'^[A-Z][a-z]') {
  69         ; # tasteful capitalization; leave as is
  70     } else {
  71       $list{lc $word} = $word;
  72     }
  73     $count{lc $word}++;
  74 }
  75
  76 ## This is an ugly way to fix festival's bad guess as to
  77 ## pronunciation in special cases.
  78 ## In the case of wind (windh versus wynd),
  79 ## nominally there are ways of tagging parts-of-speech,
  80 ## i.e. noun versus verb,
  81 ## but they don't seem to be reliable.
  82 my %fixup = (
  83  'wind'  => 'windh',
  84  'romeo' => 'Rome E O',
  85  'xray'  => 'X ray',
  86 );
  87
  88 main: {
  89
  90   my $skip = 0;
  91   my $oneword = 0;
  92   my $gripe = 0;
  93   my $out_bits_sample = 8;              ## this is what FGFS expects
  94   my @plain_args = ();
  95   argx: while (@ARGV) {
  96     my $arg = shift @ARGV;
  97     $arg =~ s/^--/-/;
  98     if ($arg eq '-help' || $arg eq '-h') {
  99       usage;
 100       exit(0);
 101     }
 102     if ($arg eq '-dump') {
 103       my $ifn = shift @ARGV || 'foo.wav';
 104       my $wav = new Audio::Wav;
 105       print "About to open '$ifn' ...\n";
 106       my $waver = $wav -> read( $ifn );
 107       print "xxxxxxxxxxxxxxxx\n";
 108       for my $detail (keys %{$waver->details()}) {
 109         printf("%-20s %s\n", $detail, ${$waver->details()}{$detail});
 110       }
 111       exit(0);
 112     }
 113     if ($arg eq '-skip') {
 114       $skip++;
 115       next argx;
 116     }
 117     if ($arg eq '-gripe') {
 118       $gripe++;
 119       next argx;
 120     }
 121     if ($arg eq '-one' || $arg eq '-1') {
 122       $oneword++;
 123       next argx;
 124     }
 125     if ($arg =~ '^-') {
 126       die "Unrecognized option '$arg'\n";
 127     }
 128     push @plain_args, $arg;
 129   }
 130
 131   my $nargs = @plain_args;
 132   if ($nargs != 3) {
 133     die "Wrong number of arguments ($nargs); for help try:\n $0 -help\n";
 134   }
 135   my @todo = ();
 136   my ($ifn, $indexfn, $out_wav) = @plain_args;
 137
 138   my $inch = Symbol::gensym;
 139   open ($inch, '<', $ifn)
 140         || die "Couldn't open input file '$ifn'\n";
 141
 142 # Skip some lines from the input list, as requested:
 143   for (my $ii = 0; $ii < $skip; $ii++) {
 144     my $ignore = <$inch>;
 145   }
 146
 147 # Read the rest of the input file:
 148   while (my $line = <$inch>) {
 149     chomp($line);
 150     if ($oneword) {
 151       my @stuff = split(' ', $line, 2);
 152       doit($stuff[0]);
 153     } else {
 154       for my $word (split(' ', $line)) {
 155         doit($word);
 156       }
 157     }
 158   }
 159   close $inch;
 160
 161 # Optionally print a list of things that the input file
 162 # requested more than once.
 163   if ($gripe) {
 164     foreach my $thing (sort keys %count) {
 165       if ($count{$thing} > 1) {
 166         printf("%4d  %s\n", $count{$thing}, $list{$thing});
 167       }
 168     }
 169   }
 170   my $nsnip = (keys %list);
 171
 172   if (0 && $nsnip > 10) {
 173     $nsnip = 10;
 174   }
 175   print STDERR "nsnip: $nsnip\n";
 176
 177   my $index = Symbol::gensym;
 178   open ($index, '>', $indexfn)
 179         || die "Couldn't write index file '$indexfn'\n";
 180
 181   print $index "$nsnip\n";
 182   if (! -d 'snip') {
 183     mkdir('snip')
 184       || die "Could not create directory 'snip' : $!\n";
 185   }
 186
 187 ##############  system "/bin/cp nothing.wav t1.wav";
 188   my $where = 0;
 189   my $sample_rate = -1;
 190   my $channels = -1;
 191   my $bits_sample = -1;
 192   my $ii = 0;
 193   snipper: for my $thing (sort keys %list) {
 194     $ii++;
 195     my $iix = sprintf('%05d', $ii);
 196     my $xfn = "./snip/x$iix";
 197
 198     my $fraise = lc($thing);
 199     if (exists $fixup{$fraise}) {
 200       #xxxx print "fixing $fraise\n";
 201       $fraise = $fixup{$fraise};
 202     }
 203
 204 ## This turns dashes and other funny stuff into spaces
 205 ## in the phrase to be processed:
 206     $fraise =~ s%[^a-z']+% %gi;
 207     if ($thing eq '/' || $thing eq '/_') {
 208       system("/bin/cp quiet0.500.wav $xfn.wav");
 209     } else {
 210       my $script = $proto;
 211       $script =~ s/XXX/$fraise/;
 212       $script =~ s|YYY|$xfn.wav|;
 213       #xxxx print "$fraise ... $script\n";
 214
 215       my $cmd = '/usr/bin/festival';
 216       my $pipe = Symbol::gensym;
 217       open ($pipe, '|-', $cmd)
 218             || die "Couldn't open pipe to '$cmd'\n";
 219       print $pipe $script;
 220       close $pipe;
 221       if ($? != 0){
 222         print STDERR "Error in festival script: '$script'\n";
 223         next snipper;
 224       }
 225     }
 226
 227     my $wav = new Audio::Wav;
 228     my $waver = $wav -> read("$xfn.wav");
 229     if ($sample_rate < 0) {
 230       $sample_rate = ${$waver->details()}{'sample_rate'};
 231       $channels    = ${$waver->details()}{'channels'};
 232       $bits_sample = ${$waver->details()}{'bits_sample'};
 233     } else {
 234          $sample_rate == ${$waver->details()}{'sample_rate'}
 235       && $channels    == ${$waver->details()}{'channels'}
 236       && $bits_sample == ${$waver->details()}{'bits_sample'}
 237       || die "audio format not the same: $xfn.wav";
 238     }
 239
 240     my $statcmd = "2>&1 sox $xfn.wav -n stat";
 241     my $stat = Symbol::gensym;
 242     open ($stat, '-|', $statcmd)
 243           || die "Couldn't open pipe from '$statcmd'\n";
 244     my $vol = 0;
 245     my $size = 0;
 246
 247     my $lastline;
 248     while (my $line = <$stat>) {
 249       chomp $line;
 250       $lastline = $line;
 251       my @stuff = split ':', $line;
 252       my $nw = @stuff;
 253       #### print STDERR "$nw +++ $line\n";
 254       if ($nw == 2) {
 255         if ($stuff[0] eq 'Volume adjustment') {
 256           $vol = 0+$stuff[1];
 257         }
 258         elsif ($stuff[0] eq 'Samples read') {
 259           $size = 0+$stuff[1];
 260         }
 261       }
 262     }
 263     my $status = close $stat;
 264     if ($?) {
 265       print STDERR "Stat command failed: $statcmd\n" . ": $lastline \n";
 266       next snipper;
 267     }
 268     if ($size == 0) {
 269       print STDERR "?Warning! Zero-size audio file for $iix '$thing'\n";
 270     }
 271     printf("%s %6.3f %6d '%s'\n", $iix, $vol, $size, $thing);
 272     my $subsize = int($size/2);
 273     printf $index ("%-45s %10d %10d\n", $thing, $where, $subsize);
 274     $where += $subsize;
 275
 276
 277     my $volume_cmd = sprintf("sox -v %6.3f %s.wav %s.raw",
 278                 $vol*0.9, $xfn, $xfn);
 279     ########## print "+ $volume_cmd\n";
 280     if (1) {
 281       my $vol_handle = Symbol::gensym;
 282       open ($vol_handle, '|-', $volume_cmd)
 283             || die "Couldn't open pipe to command '$volume_cmd'\n";
 284
 285       close $vol_handle;
 286       if ($?) {
 287         die "Volume command failed: $statcmd\n" . ": $lastline";
 288       }
 289     }
 290     push @todo, "$xfn.raw";
 291   }
 292   close $index;
 293
 294   my $cat_cmd = "cat " . join(' ', @todo) . " > ./snip/everything.raw";
 295   my $cat_handle = Symbol::gensym;
 296   open ($cat_handle, '|-', $cat_cmd)
 297         || die "Couldn't open pipe to command '$cat_cmd'\n";
 298   close $cat_handle;
 299   if ($?) {
 300     die "Cat command failed: $cat_cmd";
 301   }
 302
 303   my $wav_cmd = "sox --rate $sample_rate --bits $bits_sample"
 304    . " --encoding signed-integer"
 305    . " ./snip/everything.raw --rate 8000 --bits $out_bits_sample $out_wav";
 306
 307   my $wav_handle = Symbol::gensym;
 308   open ($wav_handle, '|-', $wav_cmd)
 309         || die "Couldn't open pipe to command '$wav_cmd'\n";
 310   close $wav_handle;
 311   if ($?) {
 312     die ".wav command failed: $wav_cmd";
 313   }
 314 }