1/* Rainforest Escape, by Michael OConnor. */
    2
    3:- dynamic i_am_at/1, at/2, holding/1, i_get_caught/1, is_caught/1.    4:- retractall(at(_, _)), retractall(i_am_at(_)), retractall(alive(_)).    5
    6i_am_at(rfJail).
    7
    8i_get_caught(13).
    9
   10inventory :- holding(X), write(X), nl, fail.
   11inventory :- write('That''s all you got my friend.').
   12
   13move_time(_) :- i_get_caught(X), X = 0, 
   14write('You have been caught by your jailers, and this time they won''t just throw you in a cell...'),
   15die, fail.
   16move_time(_) :- i_get_caught(X), Y is X - 1, retract(i_get_caught(X)), assert(i_get_caught(Y)).
   17
   18is_caught(_) :- i_get_caught(X), X = 0, 
   19write('You have been caught by your jailers, and this time they won''t just throw you in a cell...'),
   20die.
   21
   22/*winning game path*/
   23path(rfJail, n, baseCamp) :- 
   24write('You kick open the cell door and decide to run for freedom.'), nl, nl.
   25
   26path(baseCamp, n, checkPoint).
   27path(checkPoint, s, baseCamp).
   28
   29path(checkPoint, e, stream).
   30path(stream, w, checkPoint).
   31
   32path(stream, s, cougarBed).
   33path(cougarBed, n, stream).
   34
   35path(cougarBed, e, waterfall) :- holding(meat),
   36write('You throw the meat at the cougar. She eats it and lets you continue on.'), nl, nl.
   37path(cougarBed, e, waterfall) :- holding(macheteHilt), 
   38write('You try to hit kill the cougar with the machete hilt and she mauls your leg.  You are now much slower.'), nl, nl,
   39move_time(_), move_time(_), move_time(_), !, fail.
   40path(cougarBed, e, waterfall) :- 
   41write('A cougar is licking her lips and you think better of running by.'), nl, nl, 
   42        !, fail.
   43path(waterfall, w, cougarBed).
   44		
   45path(waterfall, n, clearing) :- 
   46write('You move away from the powerful waterfall full of wonder.'), nl, nl.
   47path(clearing, s,waterfall).
   48
   49path(clearing, e, denseForest) :- 
   50write('From the calm of the clearing you plunge into the darkness and foreboding of the dense forest.'), nl, nl.
   51path(denseForest, w, clearing).
   52
   53path(denseForest, s, cliff) :- holding(macheteHilt), holding(macheteBlade),
   54write('Using your machete you hack your way quickly through the dense forest and make sure not to touch any spiderwebs.'), nl, nl.
   55path(denseForest, s, cliff) :- move_time(_), move_time(_), move_time(_),
   56write('Without a machete it takes you a very long to get out of the dense forest while avoiding spiderwebs.'), nl, nl.
   57path(cliff, n, denseForest) :- write('Fearful of the unknown you back away from the cliff.'), nl, nl.
   58
   59path(cliff, s, freedom) :-
   60write('You leap from the cliff to the abyss below, hoping that where you land is better than where you escaped from.'), nl, nl, finish.
   61path(cliff, e, freedom) :-
   62write('You leap from the cliff to the abyss below, hoping that where you land is better than where you escaped from.'), nl, nl, finish.
   63path(cliff, w, freedom) :-
   64write('You leap from the cliff to the abyss below, hoping that where you land is better than where you escaped from.'), nl, nl, finish.
   65
   66at(meat, baseCamp).
   67at(macheteHilt, checkPoint).
   68at(oddLookingMound, clearing).
   69
   70/* These rules describe how to pick up an object. */
   71
   72take(oddLookingMound) :-
   73        holding(macheteBlade),
   74        write('You''re already dug this up!'),
   75        !, nl.
   76
   77take(oddLookingMound) :-
   78        i_am_at(clearing),
   79        at(X, clearing),
   80        retract(at(X, clearing)),
   81        assert(holding(macheteBlade)),
   82        write('You dug up a machete blade!.'),
   83        !, nl.
   84
   85take(X) :-
   86        holding(X),
   87        write('You''re already holding it!'),
   88        !, nl.
   89
   90take(X) :-
   91        i_am_at(Place),
   92        at(X, Place),
   93        retract(at(X, Place)),
   94        assert(holding(X)),
   95        write('OK.'),
   96        !, nl.
   97
   98take(_) :-
   99        write('I don''t see it here.'),
  100        nl.
  101
  102
  103/* These rules describe how to put down an object. */
  104
  105drop(X) :-
  106        holding(X),
  107        i_am_at(Place),
  108        retract(holding(X)),
  109        assert(at(X, Place)),
  110        write('OK.'),
  111        !, nl.
  112
  113drop(_) :-
  114        write('You aren''t holding it!'),
  115        nl.
  116
  117
  118/* These rules define the direction letters as calls to go/1. */
  119
  120n :- go(n).
  121
  122s :- go(s).
  123
  124e :- go(e).
  125
  126w :- go(w).
  127
  128i :- inventory.
  129
  130
  131/* This rule tells how to move in a given direction. */
  132
  133go(Direction) :-
  134        i_am_at(Here),
  135        path(Here, Direction, There),
  136        retract(i_am_at(Here)),
  137        assert(i_am_at(There)),
  138		move_time(_),		
  139        !, look.
  140
  141go(_) :-
  142        write('You can''t go that way.').
  143
  144
  145/* This rule tells how to look about you. */
  146
  147look :-
  148        i_am_at(Place),
  149        describe(Place),
  150        nl,
  151        notice_objects_at(Place),
  152        nl.
  153
  154
  155/* These rules set up a loop to mention all the objects
  156   in your vicinity. */
  157
  158notice_objects_at(Place) :-
  159        at(X, Place),
  160        write('There is a '), write(X), write(' here.'), nl,
  161        fail.
  162
  163notice_objects_at(_).
  164
  165
  166/* This rule tells how to die. */
  167
  168die :-
  169        finish.
  170
  171
  172/* Under UNIX, the "halt." command quits Prolog but does not
  173   remove the output window. On a PC, however, the window
  174   disappears before the final output can be seen. Hence this
  175   routine requests the user to perform the final "halt." */
  176
  177finish :-
  178        nl,
  179        write('The game is over. Please enter the "halt." command.'),
  180        nl.
  181
  182
  183/* This rule just writes out game instructions. */
  184
  185instructions :-
  186        nl,
  187        write('Enter commands using standard Prolog syntax.'), nl,
  188        write('Available commands are:'), nl,
  189        write('start.             -- to start the game.'), nl,
  190        write('n.  s.  e.  w.     -- to go in that direction.'), nl,
  191        write('take(Object).      -- to pick up an object.'), nl,
  192        write('drop(Object).      -- to put down an object.'), nl,
  193        write('look.              -- to look around you again.'), nl,
  194        write('instructions.      -- to see this message again.'), nl,
  195		write('i.                 -- to see what you are currently holding.'), nl,
  196        write('halt.              -- to end the game and quit.'), nl,
  197        nl.
  198
  199
  200/* This rule prints out instructions and tells where you are. */
  201
  202start :-
  203        instructions,
  204        look.
  205
  206
  207/* These rules describe the various rooms.  Depending on
  208   circumstances, a room may have more than one description. */
  209
  210describe(rfJail) :- write('You are in small iron jail cell somewhere in the rainforest.  You notice that the jail cell door faces north and seems rusted.'), nl.
  211
  212describe(baseCamp) :- write('You are in the jailers basecamp, but it seems they are out doing evil jailer things.'),
  213write(' To your north looks like a checkpoint.  To the east and west is dense forest filled with spiderwebs'),
  214write('The jailers will find you in '), i_get_caught(X), write(X), write(' hours.'), nl.
  215
  216describe(checkPoint) :- write('You have now reached the base entrance checkpoint. To your north and west you see more dense forest and spiderwebs.'),
  217write(' To your east you spy a bubbling stream. '),
  218write('The jailers will find you in '), i_get_caught(X), write(X), write(' hours.'), nl.
  219
  220describe(stream) :- write('You are at a tranquil stream that passes through the forest. You know that if you follow it south you will find a cougar den. '),
  221write('To the north and east you see spooky eyes peering through the dense brush. '),
  222write('The jailers will find you in '), i_get_caught(X), write(X), write(' hours.'), nl.
  223
  224describe(cougarBed) :- write('You are at a cougar den. She is well known in town for mauling all that get to close.'),
  225write(' Behind her to the east is a magnificent waterfall. To the south and west you see vicious monkeys holding guns like in Rise of the Planet of the Apes. '),
  226write('The jailers will find you in '), i_get_caught(X), write(X), write(' hours.'), nl.
  227
  228describe(waterfall) :- write('You are at a towering waterfall.  Looking up and feeling the water spray on your face you feel rejuvinated.'),
  229write(' To your north you think you what looks like light at the end of a tunnel. '),
  230write('You can not head through the waterfall to your easat and the south is covered in spiderwebs. '),
  231write('The jailers will find you in '), i_get_caught(X), write(X), write(' hours.'), nl.
  232
  233describe(clearing) :- write('You are in an immense clearing. You see the destruction your jailers have done to the forest as tree stumps cover the landscape.'),
  234write('You know you have to keep heading east to try and escape and ultimately stop them. '),
  235write('The jailers will find you in '), i_get_caught(X), write(X), write(' hours.'), nl.
  236
  237describe(denseForest) :- write('You are in the dense forest.  The eyes, monkeys, and spiders from before can be behind any tree or leaf.'),
  238write('You know the only way forward is south, otherwise you will get lost'),
  239write('The jailers will find you in '), i_get_caught(X), write(X), write(' hours.'), nl. 
  240
  241describe(cliff) :- write('You are at the edge of a plateau.  Every direction but the way you came leads to an immense abyss too deep to see what lies below.'),
  242write('The jailers will find you in '), i_get_caught(X), write(X), write(' hours.'), nl