Initial import of Super Wumpus Land 1.0 revision 2007.1216.
catseye
13 years ago
0 | #!/usr/bin/perl | |
1 | ||
2 | ### BEGIN swl.pl ### | |
3 | ||
4 | # SUPER WUMPUS LAND | |
5 | # v2007.1216 Chris Pressey, Cat's Eye Technologies | |
6 | ||
7 | # Copyright (c)2000-2007, Cat's Eye Technologies. | |
8 | # All rights reserved. | |
9 | # | |
10 | # Redistribution and use in source and binary forms, with or without | |
11 | # modification, are permitted provided that the following conditions | |
12 | # are met: | |
13 | # | |
14 | # 1. Redistributions of source code must retain the above copyright | |
15 | # notices, this list of conditions and the following disclaimer. | |
16 | # 2. Redistributions in binary form must reproduce the above copyright | |
17 | # notices, this list of conditions, and the following disclaimer in | |
18 | # the documentation and/or other materials provided with the | |
19 | # distribution. | |
20 | # 3. Neither the names of the copyright holders nor the names of their | |
21 | # contributors may be used to endorse or promote products derived | |
22 | # from this software without specific prior written permission. | |
23 | # | |
24 | # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS | |
25 | # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT | |
26 | # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS | |
27 | # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE | |
28 | # COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, | |
29 | # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, | |
30 | # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; | |
31 | # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | |
32 | # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | |
33 | # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN | |
34 | # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE | |
35 | # POSSIBILITY OF SUCH DAMAGE. | |
36 | ||
37 | # usage: [perl] swl[.pl] | |
38 | ||
39 | ### PREAMBLE ### | |
40 | ||
41 | use strict qw(vars refs subs); | |
42 | ||
43 | ### GLOBALS ### | |
44 | ||
45 | my @room; | |
46 | my @visited; | |
47 | my @wumpus; | |
48 | my @pit; | |
49 | my @bat; | |
50 | ||
51 | my $name; # Actually, it's the *player's* name... | |
52 | ||
53 | my $room; | |
54 | ||
55 | my $aros; | |
56 | my $hides; | |
57 | my $cans; | |
58 | my $tokens; | |
59 | ||
60 | my $batbgon; | |
61 | my $codliver; | |
62 | my $camo; | |
63 | my $grip; | |
64 | my $ustink; | |
65 | ||
66 | my $subway; | |
67 | ||
68 | my $done; | |
69 | my $skip; | |
70 | my $moved; | |
71 | ||
72 | ### SUBROUTINES ### | |
73 | ||
74 | sub d | |
75 | { | |
76 | my $n = shift; | |
77 | my $s = shift; | |
78 | ||
79 | my $c = 0; | |
80 | while ($n--) { $c += int(rand($s)) + 1; } | |
81 | return $c; | |
82 | } | |
83 | ||
84 | sub cls | |
85 | { | |
86 | # Change following line to clear the screen on your system. | |
87 | printf "%c[2J", 27; # ANSI terminal | |
88 | # printf "%c", 12; # Teletype | |
89 | # system "cls"; # external program | |
90 | } | |
91 | ||
92 | sub pause | |
93 | { | |
94 | print "\n[Press ENTER to continue.] "; | |
95 | my $foo = <STDIN>; | |
96 | } | |
97 | ||
98 | sub splash | |
99 | { | |
100 | cls(); | |
101 | print "*" x 72 . "\n"; | |
102 | for(my $i = 1; $i <= 20; $i++) | |
103 | { | |
104 | if ($i == 6) | |
105 | { | |
106 | print "* S U P E R W U M P U S L A N D *\n"; | |
107 | } | |
108 | elsif ($i == 7) | |
109 | { | |
110 | print "* --------- ----------- ------- *\n"; | |
111 | } | |
112 | elsif ($i == 9) | |
113 | { | |
114 | print "* v 2007.1216 *\n"; | |
115 | } | |
116 | elsif ($i == 14) | |
117 | { | |
118 | print "* by Chris Pressey, Cat's Eye Technologies *\n"; | |
119 | } | |
120 | elsif ($i == 16) | |
121 | { | |
122 | print "* Based on an original game by Gregory Yob *\n"; | |
123 | } else | |
124 | { | |
125 | print "*" . ' ' x 70 . "*\n"; | |
126 | } | |
127 | } | |
128 | print "*" x 72 . "\n"; | |
129 | pause(); | |
130 | } | |
131 | ||
132 | sub score | |
133 | { | |
134 | cls(); | |
135 | print "Scorecard for $name\n"; | |
136 | print "==============" . "=" x length($name) . "\n\n"; | |
137 | ||
138 | my $h1 = sprintf("%3d", $hides); | |
139 | my $s1 = sprintf("%9d", $hides * 25); | |
140 | print "Wumpus Hides $h1 x 25 = $s1\n"; | |
141 | ||
142 | my $h2 = sprintf("%3d", $aros); | |
143 | my $s2 = sprintf("%9d", $aros * 2); | |
144 | print "Arrows Remaining $h2 x 2 = $s2\n"; | |
145 | ||
146 | my $h4 = sprintf("%3d", $cans); | |
147 | my $s4 = sprintf("%9d", $cans * 3); | |
148 | print "Aerosol Cans $h4 x 3 = $s4\n"; | |
149 | ||
150 | my $h5 = sprintf("%3d", $tokens); | |
151 | my $s5 = sprintf("%9d", $tokens * 5); | |
152 | print "Subway Tokens $h5 x 5 = $s5\n"; | |
153 | ||
154 | my $h3 = 0; | |
155 | for (my $i = 1; $i <= 100; $i++) | |
156 | { | |
157 | $h3++ if $visited[$i]; | |
158 | } | |
159 | $h3 = sprintf("%3d", $h3); | |
160 | my $s3 = sprintf("%9d", $h3); | |
161 | print "Locations Visited $h3 x 1 = $s3\n"; | |
162 | ||
163 | my $tot = sprintf("%9d", $s1 + $s2 + $s3 + $s4 + $s5); | |
164 | print " ---------\n"; | |
165 | print "Total $tot\n\n"; | |
166 | ||
167 | } | |
168 | ||
169 | sub show | |
170 | { | |
171 | my $q = $room[$room]; | |
172 | my $desc = $room . '. ' . $q->[0]; | |
173 | ||
174 | cls(); | |
175 | ||
176 | $visited[$room] = 1; | |
177 | ||
178 | print $desc . "\n"; | |
179 | print "-" x length($desc) . "\n\n"; | |
180 | ||
181 | if ($room[$room]->[4] == 1) | |
182 | { | |
183 | print "There is an arrow lying here.\n"; | |
184 | } | |
185 | elsif ($room[$room]->[4] > 0) | |
186 | { | |
187 | print "There are $room[$room]->[4] arrows lying here.\n"; | |
188 | } | |
189 | ||
190 | if ($room[$room]->[5] == 1) | |
191 | { | |
192 | print "There is a dead Wumpus carcass here.\n"; | |
193 | } | |
194 | elsif ($room[$room]->[5] > 0) | |
195 | { | |
196 | print "There are $room[$room]->[5] dead carcasses of ex-Wumpi here.\n"; | |
197 | } | |
198 | ||
199 | if ($room[$room]->[6] == 1) | |
200 | { | |
201 | print "There is an unlabelled aerosol can here.\n"; | |
202 | } | |
203 | elsif ($room[$room]->[6] > 0) | |
204 | { | |
205 | print "There are $room[$room]->[6] unlabelled aerosol cans here.\n"; | |
206 | } | |
207 | ||
208 | if ($room[$room]->[7] == 1) | |
209 | { | |
210 | print "A subway token lies on the ground here.\n"; | |
211 | } | |
212 | elsif ($room[$room]->[7] > 0) | |
213 | { | |
214 | print "$room[$room]->[7] subway tokens lie on the ground here.\n"; | |
215 | } | |
216 | ||
217 | if ($room[$room]->[8] > 0) | |
218 | { | |
219 | print "\nThere is a "; | |
220 | if ($room[$room]->[8] == 1) { print "small"; } | |
221 | elsif ($room[$room]->[8] == 2) { print "sizable"; } | |
222 | elsif ($room[$room]->[8] == 3) { print "large"; } | |
223 | elsif ($room[$room]->[8] == 4) { print "huge"; } | |
224 | elsif ($room[$room]->[8] == 5) { print "gigantic"; } | |
225 | else | |
226 | { | |
227 | print "super " x ($room[$room]->[8] - 5) . "big"; | |
228 | } | |
229 | print " pile of Wumpus dung here.\n"; | |
230 | } | |
231 | ||
232 | print "\n"; | |
233 | ||
234 | for(my $i = 0; $i < 20; $i++) | |
235 | { | |
236 | if ($wumpus[$i]->[0] == $room) | |
237 | { | |
238 | if ($wumpus[$i]->[1] != 0) | |
239 | { | |
240 | if ($subway) | |
241 | { | |
242 | print "* Right outside the train window is a Wumpus!\n"; | |
243 | } | |
244 | elsif ($camo) | |
245 | { | |
246 | print "* Good thing the Wumpus here can't see you.\n"; | |
247 | } else | |
248 | { | |
249 | print "* Oh No, $name! A Wumpus ATE YOU UP!!!\n"; | |
250 | if ($codliver) | |
251 | { | |
252 | print " ...and immediately BARFED YOU BACK OUT!!!!\n"; | |
253 | } else | |
254 | { | |
255 | pause(); | |
256 | $done = 1; | |
257 | return; | |
258 | } | |
259 | } | |
260 | } else | |
261 | { | |
262 | print "* There's a Wumpus asleep RIGHT IN FRONT OF YOU!!\n"; | |
263 | } | |
264 | } | |
265 | if ( ($room[$room]->[1] == $wumpus[$i]->[0]) || | |
266 | ($room[$room]->[2] == $wumpus[$i]->[0]) || | |
267 | ($room[$room]->[3] == $wumpus[$i]->[0]) ) | |
268 | { | |
269 | print "* I smell a Wumpus!\n" if not $ustink; | |
270 | } | |
271 | ||
272 | if ($bat[$i] == $room) | |
273 | { | |
274 | if ($subway) | |
275 | { | |
276 | print "* Super Bats flutter out of the path of the subway train.\n"; | |
277 | } | |
278 | elsif ($batbgon) | |
279 | { | |
280 | print "* Super Bats in this location stay well away from your awful stench!\n"; | |
281 | } else | |
282 | { | |
283 | print "* Zap! Super Bat Snatch! Elsewheresville for you!\n"; | |
284 | pause(); | |
285 | $room = d(1,100); | |
286 | $skip = 1; | |
287 | return; | |
288 | } | |
289 | } | |
290 | if ( ($room[$room]->[1] == $bat[$i]) || | |
291 | ($room[$room]->[2] == $bat[$i]) || | |
292 | ($room[$room]->[3] == $bat[$i]) ) | |
293 | { | |
294 | print "* Bats nearby!\n"; | |
295 | } | |
296 | ||
297 | if ($pit[$i] == $room) | |
298 | { | |
299 | if ($subway) | |
300 | { | |
301 | print "* The subway rails take a curving path around a bottomless pit here.\n"; | |
302 | } | |
303 | elsif ($grip) | |
304 | { | |
305 | print "* You deftly stick to the edge of the bottomless pit!\n"; | |
306 | } else | |
307 | { | |
308 | print "* Yiiiieeee!!! Fell in a pit!\n"; | |
309 | pause(); | |
310 | $done = 1; | |
311 | return; | |
312 | } | |
313 | } | |
314 | if ( ($room[$room]->[1] == $pit[$i]) || | |
315 | ($room[$room]->[2] == $pit[$i]) || | |
316 | ($room[$room]->[3] == $pit[$i]) ) | |
317 | { | |
318 | print "* I feel a draft...\n"; | |
319 | } | |
320 | } | |
321 | ||
322 | print "\nFrom here you can make passage to\n"; | |
323 | for(my $i = 1; $i <= 3; $i++) | |
324 | { | |
325 | print " \[$q->[$i]\] "; | |
326 | if ($visited[$q->[$i]]) | |
327 | { | |
328 | print "$room[$q->[$i]]->[0]"; | |
329 | for(my $j = 0; $j < 20; $j++) { if ($bat[$j] == $q->[$i]) { print " (Bats)"; last; } } | |
330 | for(my $j = 0; $j < 20; $j++) { if ($pit[$j] == $q->[$i]) { print " (Pit)"; last; } } | |
331 | print "\n"; | |
332 | } else | |
333 | { | |
334 | print "(not yet visited)\n"; | |
335 | } | |
336 | } | |
337 | print "\n"; | |
338 | ||
339 | } | |
340 | ||
341 | sub ask | |
342 | { | |
343 | if ($aros == 1) | |
344 | { | |
345 | print " [F]ire your crooked arrow\n"; | |
346 | } | |
347 | elsif ($aros > 1) | |
348 | { | |
349 | print " [F]ire one of your $aros crooked arrows\n"; | |
350 | } | |
351 | if ($cans == 1) | |
352 | { | |
353 | print " [A]pply the contents of the aerosol can on yourself\n"; | |
354 | } | |
355 | elsif ($cans > 0) | |
356 | { | |
357 | print " [A]pply one of your $cans aerosol cans on yourself\n"; | |
358 | } | |
359 | if ($tokens == 1) | |
360 | { | |
361 | print " [R]ide the subway with your token\n"; | |
362 | } | |
363 | elsif ($tokens > 0) | |
364 | { | |
365 | print " [R]ide the subway with one of your $tokens tokens\n"; | |
366 | } | |
367 | if ($room[$room]->[4] > 0 or $room[$room]->[6] > 0 or $room[$room]->[7] > 0) | |
368 | { | |
369 | print " [P]ick up the items from this location\n"; | |
370 | } | |
371 | if ($room[$room]->[5] == 1) | |
372 | { | |
373 | print " [S]kin the ex-Wumpus for it's hide\n"; | |
374 | } | |
375 | elsif ($room[$room]->[5] > 1) | |
376 | { | |
377 | print " [S]kin the ex-Wumpi for their hides\n"; | |
378 | } | |
379 | if ($room[$room]->[8] > 0) | |
380 | { | |
381 | print " [D]ig through the Wumpus dung looking for items\n"; | |
382 | } | |
383 | print " [I]nventory and Score\n\n"; | |
384 | print " [Q]uit\n\n"; | |
385 | print "What would you like to do next, $name? "; | |
386 | my $r = <STDIN>; | |
387 | chomp($r); | |
388 | $r = uc $r; | |
389 | ||
390 | if ($r eq 'Q') | |
391 | { | |
392 | $done = 1; | |
393 | } | |
394 | elsif ($r eq 'I') | |
395 | { | |
396 | score(); | |
397 | pause(); | |
398 | } | |
399 | elsif ($r eq 'D' and $room[$room]->[8] > 0) | |
400 | { | |
401 | $ustink += d(3,3); | |
402 | $room[$room]->[8]--; | |
403 | if (d(1,3) == 1) { $room[$room]->[4]++; } | |
404 | if (d(1,6) == 1) { $room[$room]->[6]++; } | |
405 | if (d(1,12) == 1) { $room[$room]->[7]++; } | |
406 | print "\nEw. You now stink so bad that you can't smell anything but yourself.\n"; | |
407 | pause(); | |
408 | } | |
409 | elsif ($r eq 'A') | |
410 | { | |
411 | $cans--; | |
412 | print "\n * * * *** fshhhhhhhhhhfft *** * * *\n\n"; | |
413 | sleep 1; | |
414 | print " Turns out it was ... "; | |
415 | sleep 2; | |
416 | ||
417 | my $c = d(1,7); | |
418 | if ($c == 1) | |
419 | { | |
420 | print "new car smell!\n"; | |
421 | } | |
422 | elsif ($c == 2) | |
423 | { | |
424 | print "\"Bat-B-Gon!\"\n"; | |
425 | $batbgon += d(4,4); | |
426 | } | |
427 | elsif ($c == 3) | |
428 | { | |
429 | print "pepper spray!!!! AIIIGGGGHHHH!!!\n\n"; | |
430 | sleep 1; | |
431 | print " AAAAIIIIIIIIIIIIIIGGGGGGHHHHH!!!\n\n"; | |
432 | sleep 2; | |
433 | print " AAAAAAAIIIIIIIIIIIIIIIIIIIIGGGGGGGGHHHHHH!!!\n\n"; | |
434 | sleep 3; | |
435 | print " AAAAAAAAAAIIIIIIIIIIIIIIIIIIIIIIIIIIGGGGGGGGGGHHHHHHH!!!\n\n"; | |
436 | sleep 4; | |
437 | print "You run around screaming for a while until the burning subsides...\n"; | |
438 | $room = d(1,100); | |
439 | } | |
440 | elsif ($c == 4) | |
441 | { | |
442 | print "\"Super Sticky Grip Goop\"!\n"; | |
443 | $grip += d(4,4); | |
444 | } | |
445 | elsif ($c == 5) | |
446 | { | |
447 | print "cod liver oil!\n"; | |
448 | $codliver += d(4,4); | |
449 | } | |
450 | elsif ($c == 6) | |
451 | { | |
452 | print "camoflage paint!\n"; | |
453 | $camo += d(4,4); | |
454 | } | |
455 | elsif ($c == 7) | |
456 | { | |
457 | print "\"E-Z-F Oven Cleaner!\"\n"; | |
458 | $grip = 1 if $grip; | |
459 | $camo = 1 if $camo; | |
460 | $codliver = 1 if $codliver; | |
461 | $batbgon = 1 if $batbgon; | |
462 | } | |
463 | pause(); | |
464 | } | |
465 | elsif ($r eq 'P' and ($room[$room]->[4] > 0 or $room[$room]->[6] > 0 or $room[$room]->[7] > 0)) | |
466 | { | |
467 | $aros += $room[$room]->[4]; | |
468 | $room[$room]->[4] = 0; | |
469 | $cans += $room[$room]->[6]; | |
470 | $room[$room]->[6] = 0; | |
471 | $tokens += $room[$room]->[7]; | |
472 | $room[$room]->[7] = 0; | |
473 | } | |
474 | elsif ($r eq 'S' and $room[$room]->[5] > 0) | |
475 | { | |
476 | $hides += $room[$room]->[5]; | |
477 | $room[$room]->[5] = 0; | |
478 | } | |
479 | elsif ($r eq 'R' and $tokens > 0) | |
480 | { | |
481 | print "Where do you want to take the subway to? [1-100] "; | |
482 | my $r = <STDIN>; | |
483 | $r = int($r); | |
484 | if ($r >= 1 and $r <= 100) | |
485 | { | |
486 | $tokens--; | |
487 | print "\n \"All aboard!\"\n\n"; | |
488 | sleep 2; | |
489 | for(my $q = 1; $q <= 3; $q++) { print ((' ' x $q) x $q . "...chug chug...\n"); sleep 1; } | |
490 | for(my $i = 1; $i <= 3; $i++) | |
491 | { | |
492 | $room = d(1,100); | |
493 | $subway = 1; | |
494 | show(); | |
495 | for(my $q = 1; $q <= 3; $q++) { print ((' ' x $i) x $q . "...chug chug...\n"); sleep 1; } | |
496 | $subway = 0; | |
497 | } | |
498 | print "\n \"Next stop, $r, $room[$r]->[0]...\""; | |
499 | sleep 3; | |
500 | $room = $r; | |
501 | } else | |
502 | { | |
503 | print "OK, keep your token, if that's the way you feel.\n"; | |
504 | pause(); | |
505 | } | |
506 | } | |
507 | elsif ($r eq 'F' and $aros > 0) | |
508 | { | |
509 | my @it = (); | |
510 | my $d = 1; my $n = 1; | |
511 | while($d) | |
512 | { | |
513 | print "Enter the "; | |
514 | if ($n == 1) { print "first"; } | |
515 | elsif ($n == 2) { print "second"; } | |
516 | elsif ($n == 3) { print "third"; } | |
517 | else { print "${n}th"; } | |
518 | print " location to "; | |
519 | if ($n == 1) { print "fire in"; } | |
520 | else { print "continue "; } | |
521 | print "to, or 0 to commence> "; | |
522 | $d = <STDIN>; | |
523 | chomp($d); $d = int($d); $n++; | |
524 | if ($d > 0) { push @it, $d; } | |
525 | } | |
526 | print "\nTwang!... "; $aros--; | |
527 | my $l = $room; | |
528 | while ($#it >= 0) | |
529 | { | |
530 | $d = shift @it; | |
531 | if (($l == $d) || | |
532 | ($room[$l]->[1] == $d) || | |
533 | ($room[$l]->[2] == $d) || | |
534 | ($room[$l]->[3] == $d)) | |
535 | { | |
536 | $l = $d; | |
537 | ||
538 | for(my $i = 0; $i < 20; $i++) | |
539 | { | |
540 | if ($wumpus[$i]->[0] == $l) | |
541 | { | |
542 | sleep 3; | |
543 | print "...*SPLAK*! Got something!\n"; | |
544 | $wumpus[$i]->[0] = 0; | |
545 | $room[$l]->[5]++; | |
546 | pause(); | |
547 | return; | |
548 | } | |
549 | } | |
550 | ||
551 | if ($room == $l) | |
552 | { | |
553 | sleep 3; | |
554 | print "...*ZOINKS!*\n\nYou shot yourself in the foot, $name!!!\n"; | |
555 | $done = 1; | |
556 | pause(); | |
557 | return; | |
558 | } | |
559 | ||
560 | sleep 1; | |
561 | print "...whoosh... "; | |
562 | ||
563 | } else | |
564 | { | |
565 | sleep 1; | |
566 | print "...*clang*\n\n"; | |
567 | @it = (); | |
568 | $room[$l]->[4]++ if d(1,3) == 1; | |
569 | pause(); | |
570 | return; | |
571 | } | |
572 | } | |
573 | ||
574 | my $flag = 0; | |
575 | for(my $i = 0; $i < 20; $i++) | |
576 | { | |
577 | $flag = 1 if $pit[$i] == $l; | |
578 | } | |
579 | ||
580 | if (not $flag) | |
581 | { | |
582 | sleep 1; | |
583 | print "...*thud*"; | |
584 | $room[$l]->[4]++; | |
585 | }; | |
586 | ||
587 | sleep 1; print "\n"; | |
588 | pause(); | |
589 | } | |
590 | elsif (int($r) > 0) | |
591 | { | |
592 | if ( ($room[$room]->[1] == int($r)) || | |
593 | ($room[$room]->[2] == int($r)) || | |
594 | ($room[$room]->[3] == int($r)) ) | |
595 | { | |
596 | $room = int($r); | |
597 | $moved = 1; | |
598 | } | |
599 | } | |
600 | } | |
601 | ||
602 | sub move_wumpi | |
603 | { | |
604 | my $i; | |
605 | for($i = 0; $i < 20; $i++) | |
606 | { | |
607 | if ($wumpus[$i]->[0] != 0) | |
608 | { | |
609 | if ($wumpus[$i]->[1] == 0) | |
610 | { | |
611 | if (d(1,4) == 1) | |
612 | { | |
613 | $wumpus[$i]->[1] = 1; # wake up | |
614 | $room[$wumpus[$i]->[0]]->[8]++ unless d(1,5)==1; | |
615 | } | |
616 | } else | |
617 | { | |
618 | if (d(1,3) == 1) | |
619 | { | |
620 | my $q = $room[$wumpus[$i]->[0]]->[d(1,3)]; | |
621 | if ($q != $room or not $moved) | |
622 | { | |
623 | $wumpus[$i]->[0] = $q; | |
624 | if ($q == $room) | |
625 | { | |
626 | print "From around a corner, a hungry-looking Wumpus appears!!\n"; | |
627 | pause(); | |
628 | } | |
629 | } | |
630 | } | |
631 | if (d(1,8) == 1) { $wumpus[$i]->[1] = 0; } # sleep | |
632 | if (d(1,8) == 1) { $room[$wumpus[$i]->[0]]->[8]++; } # crap | |
633 | } | |
634 | } | |
635 | } | |
636 | # restart dead wumpi | |
637 | for($i = 0; $i < 5; $i++) | |
638 | { | |
639 | if ($wumpus[$i]->[0] == 0 and d(1,5) == 1) | |
640 | { | |
641 | $wumpus[$i]->[0] = d(1,100); | |
642 | while ($wumpus[$i]->[0] == $room) { $wumpus[$i]->[0] = d(1,100); } | |
643 | $wumpus[$i]->[1] = 1; | |
644 | } | |
645 | } | |
646 | } | |
647 | ||
648 | sub entropy | |
649 | { | |
650 | if ($batbgon) | |
651 | { | |
652 | if (--$batbgon == 1) { print "Your \"Bat-B-Gon\" is wearing off.\n"; pause(); } | |
653 | if ($batbgon == 0) { print "Your \"Bat-B-Gon\" has worn off.\n"; pause(); } | |
654 | } | |
655 | if ($codliver) | |
656 | { | |
657 | if (--$codliver == 1) { print "The cod liver oil seems to be wearing off.\n"; pause(); } | |
658 | if ($codliver == 0) { print "The cod liver oil seems to have all worn off.\n"; pause(); } | |
659 | } | |
660 | if ($camo) | |
661 | { | |
662 | if (--$camo == 1) { print "Your camoflage is peeling.\n"; pause(); } | |
663 | if ($camo == 0) { print "Your camoflage is gone.\n"; pause(); } | |
664 | } | |
665 | if ($grip) | |
666 | { | |
667 | if (--$grip == 1) { print "Your hands and feet are starting to feel less sticky.\n"; pause(); } | |
668 | if ($grip == 0) { print "Your hands and feet are no longer sticky.\n"; pause(); } | |
669 | } | |
670 | if ($ustink) | |
671 | { | |
672 | if (--$ustink == 0) { print "Your sense of smell seems to have returned.\n"; pause(); } | |
673 | } | |
674 | } | |
675 | ||
676 | sub mixup | |
677 | { | |
678 | my @a = @_; | |
679 | my @b = (); | |
680 | while ($#a >= 0) | |
681 | { | |
682 | my $i = d(1,$#a+1)-1; | |
683 | push @b, $a[$i]; | |
684 | @a = (@a[0..$i-1], @a[$i+1..$#a]); | |
685 | } | |
686 | return @b; | |
687 | } | |
688 | ||
689 | ### INIT ### | |
690 | ||
691 | srand(); | |
692 | splash(); | |
693 | cls(); | |
694 | ||
695 | print "\n\n\n\n\n\n\n\n\n\n\n What is your name? "; | |
696 | $name = <STDIN>; | |
697 | chomp($name); | |
698 | $name =~ s/^\s*//o; | |
699 | $name =~ s/\s*^//o; | |
700 | ||
701 | if ($name eq '') | |
702 | { | |
703 | my $r = d(1,4); | |
704 | if ($r == 1) { $name = "Cuddles"; } | |
705 | elsif ($r == 2) { $name = "Sweetie-Pie"; } | |
706 | elsif ($r == 3) { $name = "Snookums"; } | |
707 | elsif ($r == 4) { $name = "Honeybunch"; } | |
708 | ||
709 | print " Fine, I'll just call you $name then.\n"; | |
710 | pause(); | |
711 | } | |
712 | ||
713 | ### MAIN ### | |
714 | ||
715 | my $play = 1; | |
716 | while ($play) | |
717 | { | |
718 | my @loc_adj = mixup | |
719 | ( | |
720 | 'Rocky', | |
721 | 'Stony', | |
722 | 'Dusty', | |
723 | 'Scenic', | |
724 | 'Dreary', | |
725 | 'Scorched', | |
726 | 'Ruinous', | |
727 | 'Breezy', | |
728 | 'Humid', | |
729 | 'Depressing' | |
730 | ); | |
731 | ||
732 | my @loc_noun = mixup | |
733 | ( | |
734 | 'Plain', | |
735 | 'Steppes', | |
736 | 'Path', | |
737 | 'Trail', | |
738 | 'Passage', | |
739 | 'Foothills', | |
740 | 'Cave', | |
741 | 'Cavern', | |
742 | 'Ravine', | |
743 | 'Expanse' | |
744 | ); | |
745 | ||
746 | my $i; my $j; | |
747 | ||
748 | for($i = 0; $i < 10; $i++) | |
749 | { | |
750 | for($j = 0; $j < 10; $j++) | |
751 | { | |
752 | my $r = $i * 10 + $j + 1; | |
753 | my $r1 = d(1,100); | |
754 | my $r2 = d(1,100); | |
755 | my $r3 = d(1,100); | |
756 | $room[$r] = | |
757 | [ | |
758 | $loc_adj[$i] . ' ' . $loc_noun[$j], | |
759 | $r1, $r2, $r3, | |
760 | 0, # arrows | |
761 | 0, # hides | |
762 | 0, # aerosol cans | |
763 | 0, # tokens | |
764 | 0, # guano | |
765 | ]; | |
766 | ||
767 | $room[$r1]->[1] = $r; # backlink | |
768 | $room[$r2]->[1] = $r; | |
769 | $room[$r3]->[1] = $r; | |
770 | } | |
771 | } | |
772 | ||
773 | for($i = 0; $i < 42; $i++) | |
774 | { | |
775 | $room[d(1,100)]->[4]++ if $i < 33; | |
776 | $room[d(1,100)]->[6]++ if $i < 15; | |
777 | $room[d(1,100)]->[7]++ if $i < 10; | |
778 | $room[d(1,100)]->[8]++; | |
779 | } | |
780 | ||
781 | for($i = 0; $i < 20; $i++) | |
782 | { | |
783 | $wumpus[$i]->[0] = d(1,100); | |
784 | $wumpus[$i]->[1] = d(1,2)-1; | |
785 | $wumpus[$i]->[0] = 0 if ($i > 4); | |
786 | $bat[$i] = d(1,100); | |
787 | $bat[$i] = 0 if ($i > 10); | |
788 | $pit[$i] = d(1,100); | |
789 | $pit[$i] = 0 if ($i > 6); | |
790 | } | |
791 | ||
792 | @visited = (); | |
793 | ||
794 | $room = d(1,100); | |
795 | $aros = 1; | |
796 | $hides = 0; | |
797 | $cans = 0; | |
798 | $tokens = 0; | |
799 | ||
800 | $batbgon = 0; | |
801 | $codliver = 0; | |
802 | $camo = 0; | |
803 | $grip = 0; | |
804 | $ustink = 0; | |
805 | ||
806 | $done = 0; | |
807 | $skip = 0; | |
808 | ||
809 | while (not $done) | |
810 | { | |
811 | $moved = 0; | |
812 | show(); | |
813 | ask() if not $done and not $skip; | |
814 | move_wumpi(); | |
815 | entropy(); | |
816 | $skip = 0; | |
817 | } | |
818 | ||
819 | score(); | |
820 | print "\nYou want to play again, right, $name? "; | |
821 | my $r = <STDIN>; | |
822 | $play = 0 if $r =~ /^\s*n/i; | |
823 | } | |
824 | ||
825 | cls(); | |
826 | ||
827 | ### END ### |