1
1
Fork 0
mirror of https://github.com/QB64Official/qb64.git synced 2024-09-04 11:10:15 +00:00
qb64/programs/samples/misc/wumpus.bas
SMcNeill 6e01fc8dce Altered string compare routines (<,<=,>,>=) so they don't give false results with CHR$(0).
Added new _STRCMP and _STRICMP commands for quick string comparisons.
Cleaned up QB64 to finish removing the QUI (quick user insert) code and folders.
Altered UCASE and LCASE routines to be faster in some situations for us.
2014-09-22 08:19:03 -04:00

229 lines
No EOL
5.7 KiB
QBasic

REM *** HUNT THE WUMPUS **
DIM p(5)
PRINT "INSTRUCTIONS (Y-N)";
INPUT i$
i$ = UCASE$(i$)
IF (i$ = "Y") OR (i$ = "YES") THEN GOSUB 375
REM *** SET UP CAVE (DODECAHEDRAL NODE LIST) ***
DIM s(20, 3)
FOR j = 1 TO 20
FOR k = 1 TO 3
READ s(j, k)
NEXT k
NEXT j
DATA 2,5,8,1,3,10,2,4,12,3,5,14,1,4,6
DATA 5,7,15,6,8,17,1,7,9,8,10,18,2,9,11
DATA 10,12,19,3,11,13,12,14,20,4,13,15,6,14,16
DATA 15,17,20,7,16,18,9,17,19,11,18,20,13,16,19
REM *** LOCATE L ARRAY ITEMS ***
REM *** 1-YOU, 2-WUMPUS, 3&4-PITS, 5&6-BATS ***
DIM l(6)
DIM m(6)
170 FOR j = 1 TO 6
l(j) = INT(20 * RND(1)) + 1
m(j) = l(j)
NEXT j
REM *** CHECK FOR CROSSOVERS (IE l(1)=l(2), ETC) ***
FOR j = 1 TO 6
FOR k = 1 TO 6
IF j = k THEN GOTO 215
IF l(j) = l(k) THEN GOTO 170
215 NEXT k
NEXT j
REM *** SET NO. OF ARROWS ***
230 a = 5
l = l(1)
REM *** RUN THE GAME ***
PRINT "HUNT THE WUMPUS"
REM *** HAZARD WARNING AND LOCATION ***
255 GOSUB 585
REM *** MOVE OR SHOOT ***
GOSUB 670
IF o = 1 THEN GOTO 280
IF o = 2 THEN GOTO 300
REM *** SHOOT ***
280 GOSUB 715
IF f = 0 THEN GOTO 255
GOTO 310
REM *** MOVE ***
300 GOSUB 975
IF f = 0 THEN GOTO 255
310 IF f > 0 THEN GOTO 335
REM *** LOSE ***
PRINT "HA HA HA - YOU LOSE!"
GOTO 340
REM *** WIN ***
335 PRINT "HEE HEE HEE - THE WUMPUS'LL GET YOU NEXT TIME!!"
340 FOR j = 1 TO 6
l(j) = m(j)
NEXT j
PRINT "SAME SETUP (Y-N)";
INPUT i$
IF (i$ <> "Y") AND (i$ <> "y") THEN GOTO 170
GOTO 230
375 REM *** INSTRUCTIONS ***
PRINT "WELCOME TO 'HUNT THE WUMPUS'"
PRINT " THE WUMPUS LIVES IN A CAVE OF 20 ROOMS. EACH ROOM"
PRINT "HAS 3 TUNNELS LEADING TO OTHER ROOMS. (LOOK AT A"
PRINT "DODECAHEDRON TO SEE HOW THIS WORKS-IF YOU DON'T KNOW"
PRINT "WHAT A DODECAHEDRON IS, ASK SOMEONE)"
PRINT
PRINT " HAZARDS:"
PRINT " BOTTOMLESS PITS - TWO ROOMS HAVE BOTTOMLESS PITS IN THEM"
PRINT " IF YOU GO THERE, YOU FALL INTO THE PIT (& LOSE!)"
PRINT " SUPER BATS - TWO OTHER ROOMS HAVE SUPER BATS. IF YOU"
PRINT " GO THERE, A BAT GRABS YOU AND TAKES YOU TO SOME OTHER"
PRINT " ROOM AT RANDOM. (WHICH MAY BE TROUBLESOME)"
INPUT "HIT RETURN TO CONTINUE"; a$
PRINT " WUMPUS:"
PRINT " THE WUMPUS IS NOT BOTHERED BY HAZARDS (HE HAS SUCKER"
PRINT " FEET AND IS TOO BIG FOR A BAT TO LIFT). USUALLY"
PRINT " HE IS ASLEEP. TWO THINGS WAKE HIM UP: YOU SHOOTING AN"
PRINT "ARROW OR YOU ENTERING HIS ROOM."
PRINT " IF THE WUMPUS WAKES HE MOVES (P=.75) ONE ROOM"
PRINT " OR STAYS STILL (P=.25). AFTER THAT, IF HE IS WHERE YOU"
PRINT " ARE, HE EATS YOU UP AND YOU LOSE!"
PRINT
PRINT " YOU:"
PRINT " EACH TURN YOU MAY MOVE OR SHOOT A CROOKED ARROW"
PRINT " MOVING: YOU CAN MOVE ONE ROOM (THRU ONE TUNNEL)"
PRINT " ARROWS: YOU HAVE 5 ARROWS. YOU LOSE WHEN YOU RUN OUT"
PRINT " EACH ARROW CAN GO FROM 1 TO 5 ROOMS. YOU AIM BY TELLING"
PRINT " THE COMPUTER THE ROOM#S YOU WANT THE ARROW TO GO TO."
PRINT " IF THE ARROW CAN'T GO THAT WAY (IF NO TUNNEL) IT MOVES"
PRINT " AT RANDOM TO THE NEXT ROOM."
PRINT " IF THE ARROW HITS THE WUMPUS, YOU WIN."
PRINT " IF THE ARROW HITS YOU, YOU LOSE."
INPUT "HIT RETURN TO CONTINUE"; a$
PRINT " WARNINGS:"
PRINT " WHEN YOU ARE ONE ROOM AWAY FROM A WUMPUS OR HAZARD,"
PRINT " THE COMPUTER SAYS:"
PRINT " WUMPUS: 'I SMELL A WUMPUS'"
PRINT " BAT : 'BATS NEARBY'"
PRINT " PIT : 'I FEEL A DRAFT'"
PRINT
RETURN
585 REM *** PRINT LOCATION & HAZARD WARNINGS ***
PRINT
FOR j = 2 TO 6
FOR k = 1 TO 3
IF s(l(1), k) <> l(j) THEN GOTO 640
SELECT CASE j - 1
CASE 1
GOTO 615
CASE 2
GOTO 625
CASE 3
GOTO 625
CASE 4
GOTO 635
CASE 5
GOTO 635
END SELECT
615 PRINT "I SMELL A WUMPUS!"
GOTO 640
625 PRINT "I FEEL A DRAFT"
GOTO 640
635 PRINT "BATS NEARBY!"
640 NEXT k
NEXT j
PRINT "YOU ARE IN ROOM "; l(1)
PRINT "TUNNELS LEAD TO "; s(l, 1); " "; s(l, 2); " "; s(l, 3)
PRINT
RETURN
670 REM *** CHOOSE OPTION ***
675 PRINT "SHOOT OR MOVE (S-M)";
INPUT i$
IF (i$ <> "S") AND (i$ <> "s") THEN GOTO 700
o = 1
RETURN
700 IF (i$ <> "M") AND (i$ <> "m") THEN GOTO 675
o = 2
RETURN
715 REM *** ARROW ROUTINE ***
f = 0
REM *** PATH OF ARROW ***
735 PRINT "NO. OF ROOMS (1-5)";
INPUT j9
IF j9 < 1 THEN GOTO 735
IF j9 > 5 THEN GOTO 735
FOR k = 1 TO j9
760 PRINT "ROOM #";
INPUT p(k)
IF k <= 2 THEN 790
IF p(k) <> p(k - 2) THEN GOTO 790
PRINT "ARROWS AREN'T THAT CROOKED - TRY ANOTHER ROOM"
GOTO 760
790 NEXT k
REM *** SHOOT ARROW ***
l = l(1)
FOR k = 1 TO j9
FOR k1 = 1 TO 3
IF s(l, k1) = p(k) THEN GOTO 895
NEXT k1
REM *** NO TUNNEL FOR ARROW ***
l = s(l, INT(3 * RND(1)) + 1)
GOTO 900
840 NEXT k
PRINT "MISSED"
l = l(1)
REM *** MOVE WUMPUS ***
GOSUB 935
REM *** AMMO CHECK ***
a = a - 1
IF a > 0 THEN 885
880 f = -1
885 RETURN
REM *** SEE IF ARROW IS AT l(1) OR AT l(2)
895 l = p(k)
900 IF l <> l(2) THEN 920
PRINT "AHA! YOU GOT THE WUMPUS!"
f = 1
RETURN
920 IF l <> l(1) THEN GOTO 840
PRINT "OUCH! ARROW GOT YOU!"
GOTO 880
935 REM *** MOVE WUMPUS ROUTINE ***
940 k = INT(4 * RND(1)) + 1
IF k = 4 THEN GOTO 955
l(2) = s(l(2), k)
955 IF l(2) <> l THEN GOTO 970
PRINT "TSK TSK TSK - WUMPUS GOT YOU!"
f = -1
970 RETURN
975 REM *** MOVE ROUTINE ***
f = 0
985 PRINT "WHERE TO";
INPUT l
IF l < 1 THEN GOTO 985
IF l > 20 THEN GOTO 985
FOR k = 1 TO 3
REM *** CHECK IF LEGAL MOVE ***
IF s(l(1), k) = l THEN GOTO 1045
NEXT k
IF l = l(1) THEN GOTO 1045
PRINT "NOT POSSIBLE -";
GOTO 985
REM *** CHECK FOR HAZARDS ***
1045 l(1) = l
REM *** WUMPUS ***
IF l <> l(2) THEN GOTO 1090
PRINT "... OOPS! BUMPED A WUMPUS!"
REM *** MOVE WUMPUS ***
GOSUB 940
IF f = 0 THEN GOTO 1090
RETURN
REM *** PIT ***
1090 IF l = l(3) THEN GOTO 1100
IF l <> l(4) THEN GOTO 1120
1100 PRINT "YYYYIIIIEEEE . . . FELL IN PIT"
f = -1
RETURN
REM *** BATS ***
1120 IF l = l(5) THEN GOTO 1130
IF l <> l(6) THEN GOTO 1145
1130 PRINT "ZAP--SUPER BAT SNATCH! ELSEWHEREVILLE FOR YOU!"
l = INT(20 * RND(1)) + 1
GOTO 1045
1145 RETURN
END