Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

We're Going on a Bear Hunt

by Mr. Muskrat (Canon)
on Jan 18, 2003 at 19:28 UTC ( #228033=sourcecode: print w/replies, xml ) Need Help??
Category: Fun Stuff
Author/Contact Info /msg [Mr. Muskrat]
Description:

An age old children's story/song that has been told many times in many, different ways. I have been looking for as many different versions as possible but so far, I have only found this one and two others (one and two)

And a book by the same name by Michael Rosen but I haven't seen it in stores yet.

I wrote it because my children absolutely love this story and I am getting very tired of reading it three or four times a day! I am going to rewrite it so that it speaks the words of the story out loud so that I don't have too. :) Once is enough for me!

If it looks a bit cryptic or obfuscated in places, that is because I was going to write it as an obfuscation.

#!/usr/bin/perl
use strict;
use warnings;
use Term::ReadKey;

my $r = "\r";

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 pad {
  print "  ";
}

sub e {
  print "@_!\n";
}

sub p {
  print "@_.\n";
}

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

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

sub pause {
  nl();
  print 'Press <SPACE> to continue.';
  ReadMode('cbreak');
  my $key = ReadKey(0);
  ReadMode('normal');
  print $r," "x26,$r;
}

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");
  pause();
  print'Oh-oh!';
  pad();
  e($s1);
  e($s2);
  cantgo('over');
  cantgo('under');
  pause();
  e('Oh, no');
  nl();
  e("We've got to go through it");
  pause();
  for(1..3){
    e($w[1]);
  }
  pause();
}

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

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

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

sub main{
  title();
  for my $bh (@bh) {
    bearhunt(@$bh);
  }
  print "WHAT'S THAT?";
  nl();
  pause();
  for my $br (@br) {
    e($br);
  }
  pause();
  e("IT'S A BEAR!!!");
  pause();
  print 'Quick!';
  pad();
  my @bt = reverse @bh;
  my $ct = 0;
  for my $bt (@bt) {
    $ct++;
    backthrough($ct, @$bt);
  }
  pause();
  for my $gh (@gh) {
    run(@$gh);
  }
  p("We're not going on a bear hunt again");
  nl();
}
Replies are listed 'Best First'.
Read "We're Going on a Bear Hunt" Out Loud
by Mr. Muskrat (Canon) on Jan 21, 2003 at 22:41 UTC
    It may still need some tweaking but here is the version that reads it aloud.

    #!/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; } }
      ++Mr. Muskrat. Very inspiring and a CUFP as well. very nice!

      cheers, -semio

Re: We're Going on a Bear Hunt
by Acolyte (Hermit) on Jan 19, 2003 at 07:38 UTC

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

    Acolyte
    Studying at the feet of the masters

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://228033]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (2)
As of 2020-09-27 10:51 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    If at first I donít succeed, I Ö










    Results (142 votes). Check out past polls.

    Notices?