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 $fmtcheck = 1;
  92   my $oneword = 0;
  93   my $gripe = 0;
  94   my $out_bits_sample = 8;              ## this is what FGFS expects
  95   my @plain_args = ();
  96   argx: while (@ARGV) {
  97     my $arg = shift @ARGV;
  98     $arg =~ s/^--/-/;
  99     if ($arg eq '-help' || $arg eq '-h') {
 100       usage;
 101       exit(0);
 102     }
 103     if ($arg eq '-dump') {
 104       my $ifn = shift @ARGV || 'foo.wav';
 105       my $wav = new Audio::Wav;
 106       print "About to open '$ifn' ...\n";
 107       my $waver = $wav -> read( $ifn );
 108       print "xxxxxxxxxxxxxxxx\n";
 109       for my $detail (keys %{$waver->details()}) {
 110         printf("%-20s %s\n", $detail, ${$waver->details()}{$detail});
 111       }
 112       exit(0);
 113     }
 114     if ($arg eq '-skip') {
 115       $skip++;
 116       next argx;
 117     }
 118     if ($arg eq '-gripe') {
 119       $gripe++;
 120       next argx;
 121     }
 122     if ($arg eq '-one' || $arg eq '-1') {
 123       $oneword++;
 124       next argx;
 125     }
 126     if ($arg eq '-nocheck') {
 127       $fmtcheck=0;
 128       next argx;
 129     }
 130     if ($arg =~ '^-') {
 131       die "Unrecognized option '$arg'\n";
 132     }
 133     push @plain_args, $arg;
 134   }
 135
 136   my $nargs = @plain_args;
 137   if ($nargs != 3) {
 138     die "Wrong number of arguments ($nargs); for help try:\n $0 -help\n";
 139   }
 140   my @todo = ();
 141   my ($ifn, $indexfn, $out_wav) = @plain_args;
 142
 143   my $inch = Symbol::gensym;
 144   open ($inch, '<', $ifn)
 145         || die "Couldn't open input file '$ifn'\n";
 146
 147 # Skip some lines from the input list, as requested:
 148   for (my $ii = 0; $ii < $skip; $ii++) {
 149     my $ignore = <$inch>;
 150   }
 151
 152 # Read the rest of the input file:
 153   while (my $line = <$inch>) {
 154     chomp($line);
 155     if ($oneword) {
 156       my @stuff = split(' ', $line, 2);
 157       doit($stuff[0]);
 158     } else {
 159       for my $word (split(' ', $line)) {
 160         doit($word);
 161       }
 162     }
 163   }
 164   close $inch;
 165
 166 # Optionally print a list of things that the input file
 167 # requested more than once.
 168   if ($gripe) {
 169     foreach my $thing (sort keys %count) {
 170       if ($count{$thing} > 1) {
 171         printf("%4d  %s\n", $count{$thing}, $list{$thing});
 172       }
 173     }
 174   }
 175   my $nsnip = (keys %list);
 176
 177   if (0 && $nsnip > 10) {
 178     $nsnip = 10;
 179   }
 180   print STDERR "nsnip: $nsnip\n";
 181
 182   my $index = Symbol::gensym;
 183   open ($index, '>', $indexfn)
 184         || die "Couldn't write index file '$indexfn'\n";
 185
 186   print $index "$nsnip\n";
 187   if (! -d 'snip') {
 188     mkdir('snip')
 189       || die "Could not create directory 'snip' : $!\n";
 190   }
 191
 192   my $wav = new Audio::Wav;
 193   my $waver = $wav -> read("quiet0.500.wav");
 194   my $sample_rate = -1;
 195   my $channels = -1;
 196   my $bits_sample = -1;
 197   $sample_rate = ${$waver->details()}{'sample_rate'};
 198   $channels    = ${$waver->details()}{'channels'};
 199   $bits_sample = ${$waver->details()}{'bits_sample'};
 200
 201 ##############  system "/bin/cp nothing.wav t1.wav";
 202   my $where = 0;
 203   my $ii = 0;
 204
 205   snipper: for my $thing (sort keys %list) {
 206     $ii++;
 207     my $iix = sprintf('%05d', $ii);
 208     my $xfn = "./snip/x$iix";
 209     print( "$xfn\n");
 210
 211     my $fraise = lc($thing);
 212     if (exists $fixup{$fraise}) {
 213       #xxxx print "fixing $fraise\n";
 214       $fraise = $fixup{$fraise};
 215     }
 216
 217 ## This turns dashes and other funny stuff into spaces
 218 ## in the phrase to be processed:
 219     $fraise =~ s%[^a-z']+% %gi;
 220     if ($thing eq '/' || $thing eq '/_') {
 221       system("/bin/cp quiet0.500.wav $xfn.wav");
 222     } else {
 223       my $script = $proto;
 224       $script =~ s/XXX/$fraise/;
 225       $script =~ s|YYY|$xfn.wav|;
 226       #xxxx print "$fraise ... $script\n";
 227
 228       my $cmd = '/usr/bin/festival';
 229       my $pipe = Symbol::gensym;
 230       open ($pipe, '|-', $cmd)
 231             || die "Couldn't open pipe to '$cmd'\n";
 232       print $pipe $script;
 233       close $pipe;
 234       if ($? != 0){
 235         print STDERR "Error in festival script: '$script'\n";
 236         next snipper;
 237       }
 238     }
 239   }
 240
 241   $ii = 0;
 242   snipper: for my $thing (sort keys %list) {
 243     $ii++;
 244     my $iix = sprintf('%05d', $ii);
 245     my $xfn = "./snip/x$iix";
 246
 247     if ($fmtcheck == 1) {
 248       my $wav = new Audio::Wav;
 249       my $waver = $wav -> read("$xfn.wav");
 250       if ($sample_rate < 0) {
 251         $sample_rate = ${$waver->details()}{'sample_rate'};
 252         $channels    = ${$waver->details()}{'channels'};
 253         $bits_sample = ${$waver->details()}{'bits_sample'};
 254       } else {
 255            $sample_rate == ${$waver->details()}{'sample_rate'}
 256         && $channels    == ${$waver->details()}{'channels'}
 257         && $bits_sample == ${$waver->details()}{'bits_sample'}
 258         || die "audio format not the same: $xfn.wav";
 259       }
 260     }
 261
 262     my $statcmd = "2>&1 sox $xfn.wav -n stat";
 263     my $stat = Symbol::gensym;
 264     open ($stat, '-|', $statcmd)
 265           || die "Couldn't open pipe from '$statcmd'\n";
 266     my $vol = 0;
 267     my $size = 0;
 268
 269     my $lastline;
 270     while (my $line = <$stat>) {
 271       chomp $line;
 272       $lastline = $line;
 273       my @stuff = split ':', $line;
 274       my $nw = @stuff;
 275       #### print STDERR "$nw +++ $line\n";
 276       if ($nw == 2) {
 277         if ($stuff[0] eq 'Volume adjustment') {
 278           $vol = 0+$stuff[1];
 279         }
 280         elsif ($stuff[0] eq 'Samples read') {
 281           $size = 0+$stuff[1];
 282         }
 283       }
 284     }
 285     my $status = close $stat;
 286     if ($?) {
 287       print STDERR "Stat command failed: $statcmd\n" . ": $lastline \n";
 288       next snipper;
 289     }
 290     if ($size == 0) {
 291       print STDERR "?Warning! Zero-size audio file for $iix '$thing'\n";
 292     }
 293
 294     if ($vol > 20) {
 295       ## unreasonable volume, happens with 'silent' files
 296       $vol = 0;
 297     }
 298     printf("%s %6.3f %6d '%s'\n", $iix, $vol, $size, $thing);
 299     my $subsize = int($size/2);
 300     printf $index ("%-45s %10d %10d\n", $thing, $where, $subsize);
 301     $where += $subsize;
 302
 303     my $volume_cmd = sprintf("sox -v %6.3f %s.wav %s.raw",
 304                 $vol*0.9, $xfn, $xfn);
 305     ########## print "+ $volume_cmd\n";
 306     if (1) {
 307       my $vol_handle = Symbol::gensym;
 308       open ($vol_handle, '|-', $volume_cmd)
 309             || die "Couldn't open pipe to command '$volume_cmd'\n";
 310
 311       close $vol_handle;
 312       if ($?) {
 313         die "Volume command failed: $statcmd\n" . ": $lastline";
 314       }
 315     }
 316     push @todo, "$xfn.raw";
 317   }
 318   close $index;
 319
 320   my $cat_cmd = "cat " . join(' ', @todo) . " > ./snip/everything.raw";
 321   my $cat_handle = Symbol::gensym;
 322   open ($cat_handle, '|-', $cat_cmd)
 323         || die "Couldn't open pipe to command '$cat_cmd'\n";
 324   close $cat_handle;
 325   if ($?) {
 326     die "Cat command failed: $cat_cmd";
 327   }
 328
 329   ## Convert RAW to WAVE format
 330   my $wav_cmd = "sox --rate $sample_rate --bits $bits_sample"
 331    . " --encoding signed-integer"
 332    . " ./snip/everything.raw --rate 8000 --bits $out_bits_sample $out_wav";
 333
 334   my $wav_handle = Symbol::gensym;
 335   open ($wav_handle, '|-', $wav_cmd)
 336         || die "Couldn't open pipe to command '$wav_cmd'\n";
 337   close $wav_handle;
 338   if ($?) {
 339     die ".wav command failed: $wav_cmd";
 340   }
 341
 342   ## Compress WAVE file
 343   my $gz_cmd = "gzip -f $out_wav";
 344   my $gz_handle = Symbol::gensym;
 345   open ($gz_handle, '|-', $gz_cmd)
 346         || die "Couldn't open pipe to command '$gz_cmd'\n";
 347   close $gz_handle;
 348   system("rm snip/*; rmdir snip");
 349 }