#!/usr/bin/perl -w
# "We're Going on a Bear Hunt"
# Speaking version

use strict;
use Win32::OLE;

my $voice;
$voice = Win32::OLE->new("Speech.VoiceText") or die("TTS failed");
$voice->Register("", "$0"); 
$voice->{Enabled} = 1;
$voice->{Speed}=150;

my @bh = (
  ['grass','Swishy swashy','long','wavy'],
  ['river','Splash splosh','deep','cold','A'],
  ['mud','Squelch squerch','thick','oozy'],
  ['forest','Stumble trip','big','dark','A'],
  ['snowstorm','Hoooo woooo','swirling','whirling','A'],
  ['cave','Tiptoe','narrow','gloomy','A'],
);

my @br = (
  'One shiny wet nose',
  'Two big furry ears',
  'Two big goggly eyes',
);

my @gh = (
  ['Get to our front door','Open the door','Up the stairs'],
  ['Oh, no!','We forgot to shut the door','Back downstairs'],
  ['Shut the door','Back upstairs','Into the bedroom'],
  ['Into bed','Under the covers'],
);

main();

exit();

sub nl {
  print $/;
}

sub e {
  talk("@_!");
}

sub p {
  talk("@_.");
}

sub going {
  p("We're going $_[0]");
}

sub cantgo {
  p("We can't go $_[0] it");
}

sub bearhunt{
  my @w = @_;
  my ($s1,$s2);
  if (5 == @w) {
    $s1 = "$w[4] $w[0]";
    $s2 = "$w[4] $w[2]";
  } else {
    $s1 = ucfirst($w[0]);
    $s2 = ucfirst($w[2]);
  }
  $s2 .= ", $w[3] $w[0]";
  going('on a bear hunt');
  going('to catch a big one');
  e('What a beautiful day');
  p("We're not scared");
  nl();
  e('Uh, oh');
  nl();
  e($s1);
  e($s2);
  nl();
  cantgo('over');
  cantgo('under');
  nl();
  e('Oh, no');
  nl();
  e("We've got to go through it");
  nl();
  for(1..3){
    e($w[1]);
  }
  nl();
}

sub backthrough{
  my ($num, $what, $sound) = @_;
  $num = $num % 2 + 2;
  talk('Back through the '.$what.'!  '."$sound!  "x$num);
  nl();
}

sub run {
  my @l = @_;
  for my $l (@l) {
    p($l);
  }
  nl();
}

sub title {
  nl();
  print q("We're Going on a Bear Hunt");
  nl();
  nl();
}

sub main{
  title();
  for my $bh (@bh) {
    bearhunt(@$bh);
  }
  talk("WHAT'S THAT?");
  nl();
  nl();
  for my $br (@br) {
    e($br);
  }
  nl();
  talk("IT'S A BEAR!!!!");
  nl();
  e('Quick');
  my @bt = reverse @bh;
  my $ct = 0;
  for my $bt (@bt) {
    $ct++;
    backthrough($ct, @$bt);
  }
  nl();
  for my $gh (@gh) {
    run(@$gh);
  }
  p("We're not going on a bear hunt again");
}


sub talk{
    my $line = shift;
    print $line,$/;
    $voice->Speak($line,  1);
    while ($voice->IsSpeaking()) {
      sleep 1;
    }
}
[download]

++Mr. Muskrat. Very inspiring and a CUFP as well. very nice!

cheers, -semio

Who says Perl can't be soft and cuddly? :-)