0: #!perl -w
1: 
2: ## Animals
3: ## Attempts to guess an animal by yes/no questions, 
4: ## Learns new animals as it goes.
5: ## Based on a game I remember playing on an Apple II
6: 
7: use strict;
8: 
9: my $animalfile = "animals.dat";
10: 
11: ## Open and read in the animal file, or our default data
12: unless (open(ANIMALS, "$animalfile")) {
13:   *ANIMALS = *DATA;
14:   print qq[**WARNING**\nThe file "$animalfile" was not found. ];
15:   print "Using the default list instead.\n";
16: }
17: 
18: my $yesno="ASK";
19: my @q;
20: my $total=0;
21: my $new=0;
22: my ($ark, $answer);
23: my ($animal, $Animal, $beast, $Beast);
24: 
25: ## Read in all the animals
26: while(<ANIMALS>) {
27:   next if /^#/;    ## Allow comments - why not?
28:   last if /^END!/; ## Allow a graceful end if needed
29:   chop;
30:   if ($yesno eq "ASK") {
31:     $q[++$total]->{$yesno}=$_;
32:     $yesno="YES"; next;
33:   }
34:   if (m/^>(\d*)/) { $q[$total]->{$yesno}=\$q[$1]; }
35:   else { $q[$total]->{$yesno}=$_; }
36:   $yesno = $yesno eq "YES" ? "NO" : "ASK";
37: }
38: close(ANIMALS);
39: 
40: ## Begin the game
41: print qq[
42: Welcome to the game of Animals! Just think of an animal, 
43: and I will try and guess what it is.
44: 
45: (I know $total animals!)
46: 
47: --Please answer <Y>es, <N>o, or <Q>uit for each question.--
48: 
49: ];
50: 
51: $ark=\$q[1];
52: while($ark) {
53:   print "\n$$ark->{ASK}\n\n";
54:   $yesno = <STDIN>;
55:   &Quit if $yesno =~ /^Q/i;
56:   if ($yesno =~ s#^([YN]).*#$1=~/Y/i ? "YES" : "NO"#eis) {
57:     $animal = $$ark->{$yesno};
58:     if (ref($animal)) { $ark=$animal; next; }
59:   }
60:   else { print "**Please answer Yes, No, or Quit**\n\n"; next; }
61: 
62:   ## Did we guess the right animal?
63:   ($Animal = $animal) =~ s/^([aeiou])?/$1 ? "an $1" : "a "/ei;
64:   print "\n**It must be $Animal!**\n";
65:   do {
66:     print "\nDid I guess your animal?\n\n";
67:   } while ($answer=<STDIN>) !~ /^[YN]/i;
68: 
69:   if ($answer =~ /^Y/i) {
70:     print "\n**Yay! I win!**\n";
71:     do {
72:       print "\nDo you want to <P>lay again or <Q>uit?\n\n";
73:     } while ($answer=<STDIN>) !~ /^[PQ]/i;
74:     &Quit if $answer =~ /Q/i;
75:     $ark=\$q[1]; next;
76:   }
77: 
78:   print "\nWhat animal were you thinking of?\n\n";
79:   chop($beast=<STDIN>);
80:   ($Beast = $beast) =~ s/^([aeiou])?/$1 ? "an $1" : "a "/ei;
81:   $total++; $new++;
82:   do {
83:     print "\nWhat could I ask to tell the difference between ",
84:           "$Animal and $Beast?\n\n";
85:     chop($q[$total]->{ASK}=<STDIN>);
86:     print "\n\nIf I asked someone:\n\"$q[$total]->{ASK}\"\n\n";
87:     print "Would they answer <Y>es or <N>o for $Animal?\n";
88:     print "(<R> to re-enter your question)\n\n";
89:   } while ($answer = <STDIN>) !~ /^[YN]/i;
90: 
91:   ## Store the animals in the new Yes/No
92:   $q[$total]->{YES} = $answer=~/^Y/i ? $animal : $beast;
93:   $q[$total]->{NO}  = $answer=~/^N/i ? $animal : $beast; 
94: 
95:   ## Make the current yes/no point to the new entry
96:   $$ark->{$yesno} = \$q[$total];
97:       
98:   print "\n\n**Thank you! Now I know about $total animals, ",
99:     "including $Beast!**\n";
100:   do {
101:     print "\nWould you like to <P>lay again or <Q>uit?\n\n";
102:   } while ($answer=<STDIN>) !~ /^[PQ]/i;
103:   &Quit if $answer =~ /^Q/i;
104: 
105:   print "I now know $total animals!\n\n";
106:   $ark=\$q[1]; ## Start over...
107: }
108: 
109: 
110: sub SaveAnimals {
111:   ## Write the list to the file
112:   open(ANIMALS, ">$animalfile") or 
113:     die "Could not open $animalfile: $!\n";
114:   my $oldselect = select(ANIMALS);
115: 
116:   ## Create a quick lookup table
117:   my $y=0; my %LU;
118:   $LU{$q[$y]->{ASK}}=$y while ($q[++$y]);
119: 
120:   ## Write each one in order
121:   $y=1;
122:   while($ark = $q[$y]) {
123:     print "$ark->{ASK}\n";
124:     for $yesno (qw(YES NO)) {
125:       if (ref($ark->{$yesno})) {
126:         printf ">%d\n", $LU{${$ark->{$yesno}}->{ASK}};
127:       }
128:       else { print "$ark->{$yesno}\n"; }
129:     }
130:     $y++;
131:   }
132:   select($oldselect);
133:   close(ANIMALS);
134:   print "\nSaved information on $total animals.\n";
135: } ## end of the sub SaveAnimals
136: 
137: 
138: sub Quit {
139:   if ($new) {
140:     do {
141:       printf "\n**I learned about $new new animal%s!**\n",
142:         $new==1 ? "" : "s";
143:       print "\nDo you want to <S>ave or just <Q>uit?\n\n";
144:     } while ($answer = <STDIN>) !~ /^[SQ]/i;
145:     &SaveAnimals if $answer =~ /^S/i;
146:   }
147:   print "\n**Goodbye! Thanks for playing!**\n";
148:   exit;
149: }
150: __END__
151: ## This is the default list if the data file is not found.
152: Does it live in the water?
153: >2
154: >3
155: Does it have a tail?
156: Whale
157: Starfish
158: Does it have wings?
159: >4
160: >5
161: Can it fly?
162: Eagle
163: Penguin
164: Does it have fur?
165: >6
166: >7
167: Does it have stripes?
168: Tiger
169: Bear
170: Does it have a trunk?
171: Elephant
172: Armadillo
173: END!
174: <Homer>mmmm.....typeglobs</Homer>