--- /dev/null
+#! /usr/bin/perl -w
+
+sub usage {
+ print <<EoF;
+Read the apt.dat (or apt.dat.gz) file.
+Remap airport names to remove ugly abbreviations.
+Print airport names, one per line.
+
+Remapping is done by reference to the atis_remap.hxx file.
+
+Typical usage:
+ FG_ROOT=whatever ATIS_ONLY=yes ./list-airports.pl | words_per_line.sh > atis.list
+EoF
+}
+
+use strict;
+use Symbol;
+my $noparen = 1;
+
+ my $verbose = 0;
+ my $apt_name = '';
+ my $lat;
+ my $lon;
+ my $atis;
+ my $country = '';
+ my $elev;
+ my $tower;
+ my $bldgs;
+ my $apt_id;
+ my $shapefile;
+ my $namer = 'NAME';
+ my $skipping = 0;
+ my $tot_apts = 0;
+
+ my %states = ();
+ my %short_country = ();
+
+
+ my $fgroot = $ENV{'FG_ROOT'} || '.';
+ my $atis_only = $ENV{'ATIS_ONLY'} || 0;
+
+sub process_apt {
+ if ($atis_only && ! $atis) {
+ return;
+ }
+ my $str .= $apt_name;
+
+ $str =~ s' *$''; ## remove trailing spaces
+ if ($noparen) {
+ $str =~ s/[(][^)]*[)]?//g;
+ }
+ print "$str\n";
+ $tot_apts++;
+}
+
+my %remap = ();
+
+sub get_remap {
+
+# Note: in this context, GKI probably stands for Gereja Kristen Indonesia
+# I guess the church builds lots of airports.
+
+ my $mapfn = "$fgroot/../fgs/src/ATCDCL/atis_remap.hxx";
+ my $mapch = Symbol::gensym;
+ if (!open($mapch, '<', $mapfn)) {
+ print STDERR "Could not open abbreviation file '$mapfn'\n";
+ print STDERR "Maybe you need to set FG_ROOT\n";
+ exit(1);
+ }
+ while (my $line = <$mapch>) {
+ chomp $line;
+ if ($line =~ s/[ \t]*REMAP[(]//) {
+ $line =~ s/[)][ \t]*$//;
+ my @stuff = split(',', $line, 2);
+ my $from = $stuff[0];
+ my $to = $stuff[1];
+ $to =~ s/^[ \t]*//;
+ if ($to eq 'NIL') {
+ $to = '';
+ }
+ $remap{$from} = $to;
+ }
+ }
+}
+
+main: {
+
+ get_remap;
+
+ my $delim = '-';
+ my $incmd = 'zcat /games/sport/fgd/Airports/apt.dat.gz';
+ my $inch = Symbol::gensym;
+ open ($inch, '-|', $incmd)
+ || die "Couldn't open pipe from '$incmd'\n";
+
+
+ my $junk = <$inch>;
+ $junk = <$inch>;
+ liner: while (my $line = <$inch>) {
+ chomp $line;
+ my @stuff = split(' ', $line);
+ my $type = shift @stuff || 0;
+### print "..$type ... $line ...\n";
+
+ if ($type == 1) {
+## Here if new airport.
+##
+## First, print results of previous work, i.e. airport
+## stanzas already seen ... since the apt.dat file
+## doesn't have a clear way of signaling the end of a stanza.
+ if ($apt_name) {
+ process_apt();
+ }
+ $apt_name = '';
+ $atis = '';
+ $lat = 0;
+ $lon = 0;
+ $country = '';
+
+ $elev = shift @stuff;
+ $tower = shift @stuff;
+ $bldgs = shift @stuff;
+ $apt_id = shift @stuff;
+ my $name = join $delim, @stuff;
+
+ for my $from (keys %remap) {
+ my $to = $remap{$from};
+ $name =~ s/\b$from\b/$to/gi;
+ }
+
+## option for plain words, not hyphenated phrases
+ if (1) {
+ $name =~ s/$delim/ /g;
+ }
+
+ $apt_name = "$name";
+ }
+
+ if ($type == 10) {
+ $lat = $stuff[0];
+ $lon = $stuff[1];
+ }
+
+ if ($type == 50) {
+ $atis = join(' ', @stuff);
+ }
+ }
+ process_apt(); ## flush out the very last one
+ print STDERR "Total airports: $tot_apts\n";
+}
--- /dev/null
+#! /usr/bin/perl -w
+
+use strict;
+use Symbol;
+use Audio::Wav;
+
+sub usage {
+ print <<EoF;
+Run a bunch of words through the speech synthesizer
+and collect the results.
+Typical usage:
+ ./synth.pl [options] sport.vlist sport.vce sport.wav
+
+ Options include:
+ -skip # skip a line from the .vlist file;
+ -one # take only the first word from each line
+
+Note: -skip -one is useful if the .vlist file is actually in .vce format.
+
+Other usages:
+ ./synth.pl -dump foo.wav # dump headers 'foo.wav'
+ ./synth.pl -help # print this message
+
+where sport.vlist is a file containing a list of words, we use the
+first word on each line and ignore anything else on that line
+(which means a .vce file is acceptable as input, using -skip -one).
+
+Note that "atis-lex.pl" and "list-airports.pl" are useful for
+creating the .vlist file.
+
+Note that you may also need to:
+ cpan Audio::Wav
+ apt-get install festival mbrola sox festlex-oald
+ cd \$tars
+ wget http://tcts.fpms.ac.be/synthesis/mbrola/dba/en1/en1-980910.zip
+ wget http://www.cstr.ed.ac.uk/downloads/festival/1.95/festvox_en1.tar.gz
+ cd /usr/share/festival/voices/english
+ mkdir en1_mbrola
+ cd en1_mbrola
+ unzip \$tars/en1-980910.zip
+ cd /usr/share/festival
+ mkdir lib
+ cd lib
+ ln -s ../voices ./
+ cd /usr/share
+ tar -xpzvf \$tars/festvox_en1.tar.gz
+
+You may also need to scrounge a non-buggy version of
+ /usr/local/share/perl/5.10.1/Audio/Wav/Read.pm
+EoF
+}
+
+my $proto = <<EoF;
+ (voice_en1_mbrola) ;; best voice I know of
+ (setq voice_rab_diphone voice_en1_mbrola)
+ (setq voice_en1 voice_en1_mbrola)
+ (setq voice_el_diphone voice_en1_mbrola)
+ (setq voice_ked_diphone voice_en1_mbrola)
+ (utt.save.wave (utt.synth (Utterance Text "XXX")) "YYY" 'riff)
+EoF
+
+my %list;
+my %count;
+
+sub doit {
+ my ($word) = @_;
+ if (exists $list{lc $word}
+ && $list{lc $word} =~ m'^[A-Z][a-z]') {
+ ; # tasteful capitalization; leave as is
+ } else {
+ $list{lc $word} = $word;
+ }
+ $count{lc $word}++;
+}
+
+## This is an ugly way to fix festival's bad guess as to
+## pronunciation in special cases.
+## In the case of wind (windh versus wynd),
+## nominally there are ways of tagging parts-of-speech,
+## i.e. noun versus verb,
+## but they don't seem to be reliable.
+my %fixup = (
+ 'wind' => 'windh',
+ 'romeo' => 'Rome E O',
+ 'xray' => 'X ray',
+);
+
+main: {
+
+ my $skip = 0;
+ my $oneword = 0;
+ my $gripe = 0;
+ my $out_bits_sample = 8; ## this is what FGFS expects
+ my @plain_args = ();
+ argx: while (@ARGV) {
+ my $arg = shift @ARGV;
+ $arg =~ s/^--/-/;
+ if ($arg eq '-help' || $arg eq '-h') {
+ usage;
+ exit(0);
+ }
+ if ($arg eq '-dump') {
+ my $ifn = shift @ARGV || 'foo.wav';
+ my $wav = new Audio::Wav;
+ print "About to open '$ifn' ...\n";
+ my $waver = $wav -> read( $ifn );
+ print "xxxxxxxxxxxxxxxx\n";
+ for my $detail (keys %{$waver->details()}) {
+ printf("%-20s %s\n", $detail, ${$waver->details()}{$detail});
+ }
+ exit(0);
+ }
+ if ($arg eq '-skip') {
+ $skip++;
+ next argx;
+ }
+ if ($arg eq '-gripe') {
+ $gripe++;
+ next argx;
+ }
+ if ($arg eq '-one' || $arg eq '-1') {
+ $oneword++;
+ next argx;
+ }
+ if ($arg =~ '^-') {
+ die "Unrecognized option '$arg'\n";
+ }
+ push @plain_args, $arg;
+ }
+
+ my $nargs = @plain_args;
+ if ($nargs != 3) {
+ die "Wrong number of arguments ($nargs); for help try:\n $0 -help\n";
+ }
+ my @todo = ();
+ my ($ifn, $indexfn, $out_wav) = @plain_args;
+
+ my $inch = Symbol::gensym;
+ open ($inch, '<', $ifn)
+ || die "Couldn't open input file '$ifn'\n";
+
+# Skip some lines from the input list, as requested:
+ for (my $ii = 0; $ii < $skip; $ii++) {
+ my $ignore = <$inch>;
+ }
+
+# Read the rest of the input file:
+ while (my $line = <$inch>) {
+ chomp($line);
+ if ($oneword) {
+ my @stuff = split(' ', $line, 2);
+ doit($stuff[0]);
+ } else {
+ for my $word (split(' ', $line)) {
+ doit($word);
+ }
+ }
+ }
+ close $inch;
+
+# Optionally print a list of things that the input file
+# requested more than once.
+ if ($gripe) {
+ foreach my $thing (sort keys %count) {
+ if ($count{$thing} > 1) {
+ printf("%4d %s\n", $count{$thing}, $list{$thing});
+ }
+ }
+ }
+ my $nsnip = (keys %list);
+
+ if (0 && $nsnip > 10) {
+ $nsnip = 10;
+ }
+ print STDERR "nsnip: $nsnip\n";
+
+ my $index = Symbol::gensym;
+ open ($index, '>', $indexfn)
+ || die "Couldn't write index file '$indexfn'\n";
+
+ print $index "$nsnip\n";
+ if (! -d 'snip') {
+ mkdir('snip')
+ || die "Could not create directory 'snip' : $!\n";
+ }
+
+############## system "/bin/cp nothing.wav t1.wav";
+ my $where = 0;
+ my $sample_rate = -1;
+ my $channels = -1;
+ my $bits_sample = -1;
+ my $ii = 0;
+ snipper: for my $thing (sort keys %list) {
+ $ii++;
+ my $iix = sprintf('%05d', $ii);
+ my $xfn = "./snip/x$iix";
+
+ my $fraise = lc($thing);
+ if (exists $fixup{$fraise}) {
+ #xxxx print "fixing $fraise\n";
+ $fraise = $fixup{$fraise};
+ }
+
+## This turns dashes and other funny stuff into spaces
+## in the phrase to be processed:
+ $fraise =~ s%[^a-z']+% %gi;
+ if ($thing eq '/' || $thing eq '/_') {
+ system("/bin/cp quiet0.500.wav $xfn.wav");
+ } else {
+ my $script = $proto;
+ $script =~ s/XXX/$fraise/;
+ $script =~ s|YYY|$xfn.wav|;
+ #xxxx print "$fraise ... $script\n";
+
+ my $cmd = '/usr/bin/festival';
+ my $pipe = Symbol::gensym;
+ open ($pipe, '|-', $cmd)
+ || die "Couldn't open pipe to '$cmd'\n";
+ print $pipe $script;
+ close $pipe;
+ if ($? != 0){
+ print STDERR "Error in festival script: '$script'\n";
+ next snipper;
+ }
+ }
+
+ my $wav = new Audio::Wav;
+ my $waver = $wav -> read("$xfn.wav");
+ if ($sample_rate < 0) {
+ $sample_rate = ${$waver->details()}{'sample_rate'};
+ $channels = ${$waver->details()}{'channels'};
+ $bits_sample = ${$waver->details()}{'bits_sample'};
+ } else {
+ $sample_rate == ${$waver->details()}{'sample_rate'}
+ && $channels == ${$waver->details()}{'channels'}
+ && $bits_sample == ${$waver->details()}{'bits_sample'}
+ || die "audio format not the same: $xfn.wav";
+ }
+
+ my $statcmd = "2>&1 sox $xfn.wav -n stat";
+ my $stat = Symbol::gensym;
+ open ($stat, '-|', $statcmd)
+ || die "Couldn't open pipe from '$statcmd'\n";
+ my $vol = 0;
+ my $size = 0;
+
+ my $lastline;
+ while (my $line = <$stat>) {
+ chomp $line;
+ $lastline = $line;
+ my @stuff = split ':', $line;
+ my $nw = @stuff;
+ #### print STDERR "$nw +++ $line\n";
+ if ($nw == 2) {
+ if ($stuff[0] eq 'Volume adjustment') {
+ $vol = 0+$stuff[1];
+ }
+ elsif ($stuff[0] eq 'Samples read') {
+ $size = 0+$stuff[1];
+ }
+ }
+ }
+ my $status = close $stat;
+ if ($?) {
+ print STDERR "Stat command failed: $statcmd\n" . ": $lastline \n";
+ next snipper;
+ }
+ if ($size == 0) {
+ print STDERR "?Warning! Zero-size audio file for $iix '$thing'\n";
+ }
+ printf("%s %6.3f %6d '%s'\n", $iix, $vol, $size, $thing);
+ my $subsize = int($size/2);
+ printf $index ("%-45s %10d %10d\n", $thing, $where, $subsize);
+ $where += $subsize;
+
+
+ my $volume_cmd = sprintf("sox -v %6.3f %s.wav %s.raw",
+ $vol*0.9, $xfn, $xfn);
+ ########## print "+ $volume_cmd\n";
+ if (1) {
+ my $vol_handle = Symbol::gensym;
+ open ($vol_handle, '|-', $volume_cmd)
+ || die "Couldn't open pipe to command '$volume_cmd'\n";
+
+ close $vol_handle;
+ if ($?) {
+ die "Volume command failed: $statcmd\n" . ": $lastline";
+ }
+ }
+ push @todo, "$xfn.raw";
+ }
+ close $index;
+
+ my $cat_cmd = "cat " . join(' ', @todo) . " > ./snip/everything.raw";
+ my $cat_handle = Symbol::gensym;
+ open ($cat_handle, '|-', $cat_cmd)
+ || die "Couldn't open pipe to command '$cat_cmd'\n";
+ close $cat_handle;
+ if ($?) {
+ die "Cat command failed: $cat_cmd";
+ }
+
+ my $wav_cmd = "sox --rate $sample_rate --bits $bits_sample"
+ . " --encoding signed-integer"
+ . " ./snip/everything.raw --rate 8000 --bits $out_bits_sample $out_wav";
+
+ my $wav_handle = Symbol::gensym;
+ open ($wav_handle, '|-', $wav_cmd)
+ || die "Couldn't open pipe to command '$wav_cmd'\n";
+ close $wav_handle;
+ if ($?) {
+ die ".wav command failed: $wav_cmd";
+ }
+}
projects / flightgear.git / commitdiff