scripts/atis/voice.pl

   1 #! /usr/bin/perl -w
   2
   3 use strict;
   4 use Symbol;
   5
   6 sub usage {
   7   print <<EoF;
   8
   9 EoF
  10 }
  11
  12 my $fgroot = $ENV{'FG_ROOT'} || '.';
  13
  14 my $dir="$fgroot/ATC";
  15 my %start=();
  16 my %len=();
  17
  18 my $str = 'Tucson International airport_information
  19 Ryan automated_weather_observation
  20 zero four one five zulu weather
  21  / Wind one one zero at one five
  22  / Visibility one zero
  23  / sky_condition two thousand four hundred scattered
  24  / Temperature one zero celsius dewpoint five celsius
  25  / Altimeter two niner niner two
  26  / Landing_and_departing_runway one one right
  27  / on_initial_contact_advise_you_have_information zulu ';
  28
  29 main: {
  30   setup();
  31   unlink 'tmp.raw';
  32   $str =~ s/\n/ /g;
  33   ##print "$start{'decimal'} ... $len{'decimal'}\n";
  34   my $didsome = 0;
  35   for my $arg (@ARGV) {
  36     if ($arg ne '-') {
  37       say1($arg);
  38       $didsome++;
  39     } else {
  40       for my $word (split(' ', $str)){
  41         say1($word);
  42         $didsome++;
  43       }
  44     }
  45   }
  46   if ($didsome) {
  47     my $cmd = 'sox -q -r 8000 -t raw -e signed-integer -b 16 tmp.raw'
  48         . ' tmp.wav';
  49 #        . ' -t alsa';
  50     print "$cmd\n";
  51     system $cmd;
  52   }
  53 }
  54
  55
  56
  57 sub say1{
  58   my ($arg) = @_;
  59   $arg = lc($arg);
  60   if (exists $start{$arg}) {
  61     my $cmd = "sox  -q $dir/voice.wav "
  62        . " -t raw -r 8000 -e signed-integer -b 16 - "
  63        .  " trim $start{$arg}s $len{$arg}s"
  64        .  " >> tmp.raw ";
  65     print "$cmd\n";
  66     system $cmd;
  67     my $end = $start{$arg} + $len{$arg};
  68     print "$start{$arg} + $len{$arg} = $end\n";
  69   } else {
  70     print "Can't find '$arg'\n";
  71   }
  72 }
  73
  74
  75 sub setup{
  76   my $inch = Symbol::gensym();
  77   my $file = "$dir/voice.vce";
  78   open($inch, "<$file") || die "Cannot open input file '$file'\n";
  79   my $header = <$inch>;
  80   chomp $header;
  81   my $ii=1;
  82   liner: while (my $line = <$inch>){
  83     chomp $line;
  84     my @word = split(" ", $line);
  85     my $nn = @word;
  86     if ($nn != 3) {
  87       next liner;
  88     }
  89     my $id = lc($word[0]);
  90     my $st = $word[1];
  91     my $ln = $word[2];
  92     if ($ln =~ s/^x//) {
  93       $ln = $ln - $st;
  94       print "$id $st $ln\n";
  95     }
  96     $start{$id} = $st;
  97     $len{$id} = $ln;
  98     ##print "$ii        $nn     '$line'\n";
  99     $ii++;
 100   }
 101   print "(($header)) --> $ii\n";
 102 }