Module Wumpus

Jan Burse, created May 18. 2019
/**
* Simple text based dungeon game in Prolog.
*
* Warranty & Liability
* To the extent permitted by applicable law and unless explicitly
* otherwise agreed upon, XLOG Technologies GmbH makes no warranties
* regarding the provided information. XLOG Technologies GmbH assumes
* no liability that any problems might be solved with the information
* provided by XLOG Technologies GmbH.
*
* Rights & License
* All industrial property rights regarding the information - copyright
* and patent rights in particular - are the sole property of XLOG
* Technologies GmbH. If the company was not the originator of some
* excerpts, XLOG Technologies GmbH has at least obtained the right to
* reproduce, change and translate the information.
*
* Reproduction is restricted to the whole unaltered document. Reproduction
* of the information is only allowed for non-commercial uses. Selling,
* giving away or letting of the execution of the library is prohibited.
* The library can be distributed as part of your applications and libraries
* for execution provided this comment remains unchanged.
*
* Restrictions
* Only to be distributed with programs that add significant and primary
* functionality to the library. Not to be distributed with additional
* software intended to replace any components of the library.
*
* Trademarks
* Jekejeke is a registered trademark of XLOG Technologies GmbH.
*/
/**
* Obtained rights, copyright notice of BASIC version found
* in The Best of Creative Computing Volume 1 (published 1976)
* https://www.atariarchives.org/bcc1/showpage.php?page=247
* and that we translated to Prolog.
*
* 0010 REM- HUNT THE WUMPUS
* 0015 REM: BY GREGORY YOB
*
* Game must have been create before, we assume 1972 since
* the German Wikipedia mentions this date. The Englis Wikipedia
* refers probably to a TI-99/4A version from 1973.
*/
:- module(wumpus, [wumpus/0]).
:- use_module(console).
:- current_prolog_flag(dialect, jekejeke)
-> use_module(library(advanced/arith)); true.
:- current_prolog_flag(dialect, jekejeke)
-> use_module(library(basic/lists)); true.
:- current_prolog_flag(dialect, jekejeke)
-> use_module(library(basic/random)); true.
% wumpus
play(L).
% originally: 0350 REM-SET# ARROWS
% play(+List)
play(L) :-
write('HUNT THE WUMPUS'), nl,
play(L, L, 5).
% 0400 REM-MOVE OR SHOOT
% play(+List, +List, +Integer)
play(M, L, A) :-
( O = 2
-> move(L, H),
check(H, R, F),
B = A
; rooms(N),
path(N, [], P),
shoot(P, L, A, R, B, F)),
result(F, M, R, B).
% result(+Integer, +List, +List, +Integer)
result(0, M, L, A) :- !,
play(M, L, A).
result(F, M, _, _) :-
( F = -1
-> write('HA HA HA - YOU LOSE!'), nl
; write('HEE HEE HEE - THE WUMPUS''LL GETCHA NEXT TIME!!'), nl),
write('SAME SET-UP (Y-N)? '), flush_output,
( I \== 'Y'
; L = M),
play(L).
% originally: 2500 REM-CHOOSE OPTION
% choose(-Integer)
write('SHOOT OR MOVE (S-M)? '), flush_output,
( 'S' = I
-> O = 1
; 'M' = I
-> O = 2; fail), !.
/************************************************************/
/* Move */
/************************************************************/
% originally: 4000 REM- MOVE ROUTINE
% move(+List, -List)
move([X|L], [P|L]) :- repeat,
write('WHERE TO? '), flush_output,
1 =< P,
P =< 20,
( edge(X, P) -> true
; P = X -> true
; write('NOT POSSIBLE - '), fail), !.
% originally: 4120 REM-CHECK FOR HAZARDS
% check(+List, -List, -Integer)
check([X,Y|L], R, F) :-
X = Y, !,
write('...OOPS! BUMPED A WUMPUS!'), nl,
bump([X,Y|L], R, F).
check([X,_,Z,T,_,_], _, -1) :-
( X = Z
; X = T), !,
write('YYYIIIIEEEE . . . FELL IN PIT'), nl.
check([X,Y,Z,T,U,V], L, F) :-
( X = U
; X = V), !,
write('ZAP--SUPER BAT SNATCH! ELSEWHEREVILLE FOR YOU!'), nl,
fna(P),
check([P,Y,Z,T,U,V], L, F).
check(L, L, 0).
% originally: 3370 REM-MOVE WUMPUS ROUTINE
% bump(+List, -List, -Integer)
bump([X,Y|L], [X,P|L], F) :-
fnc(C),
( C = 4
-> P = Y
; findall(P, edge(Y, P), H),
nth1(C, H, P)),
( X = P
-> write('TSK TSK TSK- WUMPUS GOT YOU!'), nl,
F = -1
; F = 0).
/************************************************************/
/* Shoot */
/************************************************************/
% shoot(+List, +List, +Integer, -List, -Integer, -Integer)
shoot(P, [X|L], A, R, B, G) :-
arrow(P, X, [X|L], F),
missed(F, [X|L], A, R, B, G).
% missed(+Integer, +List, +Integer, -List, -Integer, -Integer)
missed(0, L, A, R, B, F) :- !,
write('MISSED'), nl,
bump(L, R, G),
ammo(G, A, B, F).
missed(F, L, A, L, A, F).
% originally: 3250 REM-AMMO CHECK
% ammo(+Integer, +Integer, -Integer, -Integer)
ammo(0, A, B, F) :- !,
B is A-1,
( B = 0
-> F = -1
; F = 0).
ammo(F, A, A, F).
% originally: 3120 REM-SHOOT ARROW
% arrow(+List, +Integer, +List, -Integer)
arrow([], _, _, 0).
arrow([Y|P], X, L, F) :-
follow(X, Y, Z),
hit(Z, L, P, F).
% follow(+Integer, +Integer, -Integer)
follow(X, Y, Z) :-
edge(X, Y), !,
Z = Y.
follow(X, _, Z) :-
fnb(C),
findall(Z, edge(X, Z), H),
nth1(C, H, Z).
% originally: 3290 REM-SEE IF ARROW IS AT L(1) OR L(2)
% hit(+Integer, +List, +List, -Integer)
hit(Z, [_,Y|_], _, 1) :-
Z = Y, !,
write('AHA! YOU GOT THE WUMPUS!'), nl.
hit(Z, [X|_], _, -1) :-
Z = X, !,
write('OUCH! ARROW GOT YOU!'), nl.
hit(Z, L, P, F) :-
arrow(P, Z, L, F).
% originally: 3020 REM-PATH OF ARROW
% rooms(-Integer)
write('NO. OF ROOMS(1-5)? '), flush_output,
1 =< N,
N =< 5, !.
% path(+Integer, +List, -List)
path(0, _, []) :- !.
path(N, L, [P|R]) :- repeat,
write('ROOM #? '), flush_output,
( L = [_,Q|_],
Q = P
-> write('ARROWS AREN''T THAT CROOKED - TRY ANOTHER ROOM'), nl, fail; true), !,
M is N-1,
path(M, [P|L], R).
/************************************************************/
/* Dungeon */
/************************************************************/
% originally: 2000 REM-PRINT LOCATION & HAZARD WARNINGS
% location(+List)
location([X,Y,Z,T,U,V]) :-
( edge(X, Y)
-> write('I SMELL A WUMPUS!'), nl; true),
( ( edge(X, Z)
; edge(X, T))
-> write('I FEEL A DRAFT'), nl; true),
( ( edge(X, U)
; edge(X, V))
-> write('BATS NEARBY'), nl; true),
write('YOU ARE IN ROOM '),
write('TUNNELS LEAD TO'),
( edge(X, R),
write(' '),
% originally: 0200 REM-LOCATE L ARRAY ITEMS
% originally: 0210 REM-1-YOU,2-WUMPUS,3&4-PITS,5&6-BATS
% locate(-List)
\+ ( append(R, [X|_], L),
member(X, R)), !.
% fna(-Integer)
fna(X) :-
X is random(20)+1.
% fnb(-Integer)
fnb(X) :-
X is random(3)+1.
% fnc(-Integer)
fnc(X) :-
X is random(4)+1.
% Originally: 0068 REM- SET UP CAVE (DODECAHEDRAL NODE LIST)
% edge(-Integer, -Integer)
edge(1, 2).
edge(1, 5).
edge(1, 8).
edge(2, 1).
edge(2, 3).
edge(2, 10).
edge(3, 2).
edge(3, 4).
edge(3, 12).
edge(4, 3).
edge(4, 5).
edge(4, 14).
edge(5, 1).
edge(5, 4).
edge(5, 6).
edge(6, 5).
edge(6, 7).
edge(6, 15).
edge(7, 6).
edge(7, 8).
edge(7, 17).
edge(8, 1).
edge(8, 7).
edge(8, 9).
edge(9, 8).
edge(9, 10).
edge(9, 18).
edge(10, 2).
edge(10, 9).
edge(10, 11).
edge(11, 10).
edge(11, 12).
edge(11, 19).
edge(12, 3).
edge(12, 11).
edge(12, 13).
edge(13, 12).
edge(13, 14).
edge(13, 20).
edge(14, 4).
edge(14, 13).
edge(14, 15).
edge(15, 6).
edge(15, 14).
edge(15, 16).
edge(16, 15).
edge(16, 17).
edge(16, 20).
edge(17, 7).
edge(17, 16).
edge(17, 18).
edge(18, 9).
edge(18, 17).
edge(18, 19).
edge(19, 11).
edge(19, 18).
edge(19, 20).
edge(20, 13).
edge(20, 16).
edge(20, 19).
/************************************************************/
/* Instructions */
/************************************************************/
% Originally: 1000 REM-INSTRUCTIONS
% preamble
write('INSTRUCTIONS (Y-N)? '), flush_output,
% instructions
write('WELCOME TO ''HUNT THE WUMPUS'''), nl,
write(' THE WUMPUS LIVES IN A CAVE OF 20 ROOMS. EACH ROOM'), nl,
write('HAS 3 TUNNELS LEADING TO OTHER ROOMS. (LOOK AT A'), nl,
write('DODECAHEDRON TO SEE HOW THIS WORKS-IF YOU DON''T KNOW'), nl,
write('WHAT A DODECAHEDRON IS, ASK SOMEONE)'), nl, nl,
write(' HAZARDS:'), nl,
write(' BOTTOMLESS PITS - TWO ROOMS HAVE BOTTOMLESS PITS IN THEM'), nl,
write(' IF YOU GO THERE, YOU FALL INTO THE PIT (& LOSE!)'), nl,
write(' SUPER BATS - TWO OTHER ROOMS HAVE SUPER BATS. IF YOU'), nl,
write(' GO THERE, A BAT GRABS YOU AND TAKES YOU TO SOME OTHER'), nl,
write(' ROOM AT RANDOM. (WHICH MIGHT BE TROUBLESOME)'), nl, nl,
write(' WUMPUS:'), nl,
write(' THE WUMPUS IS NOT BOTHERED BY THE HAZARDS (HE HAS SUCKER'), nl,
write(' FEET AND IS TOO BIG FOR A BAT TO LIFT). USUALLY'), nl,
write(' HE IS ASLEEP. TWO THINGS WAKE HIM UP: YOUR ENTERING'), nl,
write(' HIS ROOM OR YOUR SHOOTING AN ARROW.'), nl,
write(' IF THE WUMPUS WAKES, HE MOVES (P=.75) ONE ROOM'), nl,
write(' OR STAYS STILL (P=.25). AFTER THAT, IF HE IS WHERE YOU'), nl,
write(' ARE, HE EATS YOU UP (& YOU LOSE!)'), nl, nl,
write(' YOU:'), nl,
write(' EACH TURN YOU MAY MOVE OR SHOOT A CROOKED ARROW'), nl,
write(' MOVING: YOU CAN GO ONE ROOM (THRU ONE TUNNEL)'), nl,
write(' ARROWS: YOU HAVE 5 ARROWS. YOU LOSE WHEN YOU RUN OUT.'), nl,
write(' EACH ARROW CAN GO FROM 1 TO 5 ROOMS. YOU AIM BY TELLING'), nl,
write(' THE COMPUTER THE ROOM#S YOU WANT THE ARROW TO GO TO.'), nl,
write(' IF THE ARROW CAN''T GO THAT WAY (IE NO TUNNEL) IT MOVES'), nl,
write(' AT RAMDOM TO THE NEXT ROOM.'), nl,
write(' IF THE ARROW HITS THE WUMPUS, YOU WIN.'), nl,
write(' IF THE ARROW HITS YOU, YOU LOSE.'), nl, nl,
write(' WARNINGS:'), nl,
write(' WHEN YOU ARE ONE ROOM AWAY FROM WUMPUS OR HAZARD,'), nl,
write(' THE COMPUTER SAYS:'), nl,
write(' WUMPUS- ''I SMELL A WUMPUS'''), nl,
write(' BAT - ''BATS NEARBY'''), nl,
write(' PIT - ''I FEEL A DRAFT'''), nl, nl.

Comments