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