Simulated numbers station using OS X's "say" command

NATO::Synth.pm

=head1 NAME

NATE::Synth - Synthesize a "numbers station" on OS X

=head1 SYNOPSIS

    perl NATO/Synth.pm
    
=head1 DESCRIPION

C<NATO::Synth> uses OS X's "say" command to create a stream of numbers and letters in the NATO phonetic alphabet.

It generates these in a format similar to that used by numbers stations: a series of letters followed by a series
of numbers. I've arbitrarily chosen limits to prevent "too many" letters and numbers in a row. The code caches the
generated strings and occasionally chooses to reuse a previously-generated string instead of creating a new one.

The voices are limited to the ones that sound best to me; you can of course change the list to use whatever ones
you have installed on your machine. I haven't found an easy way to download the non-English voices on a machine set
up for English, but the English ones give enough good options that it's satisfactory.

=cut

use strict;
use warnings;
package NATO::Synth;

# The top set of letters is the 1941 Army-Navy phonetic alphabet; I am used to using the first six of it for
# reading hexadecimal numbers; this seems to have been tradition carried over from the early days of NASA, where
# I learned it. The second set is the current NATO phonetic alphabet, with some dashes added to ensure that the
# synthetic voices properly pronounce the words; they had trouble in particular with "foxtrot", "juliett", and "lima". 
my %letters = (
  1941 => [qw(able baker charlie dog easy fox george how item jig king love mike nan oboe peter Queen roger sail tare uncle victor william x-ray yoke zebra)],
  NATO => [qw(alfa bravo charlie delta echo fox-trot golf hotel india juliet kilo lee-ma mike november oscar papa quebec romeo sierra tango uniform victor whiskey x-ray yankee zulu)],
);

# The voices which I found optimum.
my @voices = qw(Fiona Karen Kathy Moira Samantha Tessa Vicki);

# My choices of the maximum letters and numbers to have in a row; this is actually 2 to N+1.
use constant MAX_LETTERS => 4;
use constant MAX_NUMBERS => 6;

use List::Util qw/shuffle/;

# Choose a random voice for this run.
@voices = shuffle @voices;

# Cached generated strings.
my %said = ();

sub run {
 my $count = shift;
 # shuffle the numbers. We'll take the first few for our string.
 my @numbers = shuffle qw(one two three four five six seven eight niner zero);
  
 # Pick the number of letters and numbers. You might want to tweak this for
 # more randomness.
 my $letters = int(rand() * MAX_LETTERS or 1) + 1;
 my $numbers = int(rand() * MAX_NUMBERS or 1) + 1;
  
 # Arbitrarily picking the NATO alphabet; this could be randomized too.
 my @letters = shuffle @{$letters{NATO}};

 my $s;
 if (rand() < 0.25 and keys %said) {
   # Use a random already-generated string. keys() presents the
   # keys in a random order after each insert; I could have shuffled
   # the keys, but this generated interesting patterns.
   my @saids = keys %said;
   $s = shift @saids;
 } else {
   # We're going to generate a string. Start out by emphasizing the first word.
   $s = "[[emph +]]";
   my $louder = 1;
   for my $i (0..$letters) {
     # Add a word and an appropriate inter-word pause.
     $s .= " [[slnc 250]] ". (shift @letters);
     
     # Turn off emphasis (and leave it off) for the rest of the string.
     $s .= "[[emph \-]]" if $louder;
     $louder = 0;
   }
   
   # Add the requisite number of numbers and end with a period to get
   # the proper end-of-sentence inflection.
   for my $i (0..$numbers) {
     $s .= " [[slnc 250]] ". (shift @numbers);
   }
   $s .=".";
 }
 
 # Show which voice was chosen and how many strings we have left.
 # Pronounce the string and show the words being said.
 print "$voices[0] ($count):\n";
 system qq(say -i -v $voices[0] "$s");
 
 # Add this string to the cache.
 $said{$s}++;
}

# When we run the module as a script. caller() will be false.
# Generate 50 strings, pausing between them.
unless (caller) {
  my $count = 50;
  while ($count > 0) {
    run;
    sleep 4;
  }
}

1;