1/* BreakOut -- a sample adventure game, by Varun Gupta.
    2   Consult this file and issue the command:   start.  */
    3
    4:- dynamic at/2, i_am_at/1, alive/1.   /* Needed by SWI-Prolog. */
    5:- retractall(at(_, _)), retractall(i_am_at(_)), retractall(alive(_)).    6
    7/* This defines my current location. */
    8
    9i_am_at(cell).
   10
   11
   12/* These facts describe how the rooms are connected. */
   13
   14path(cell, d, hole).
   15
   16path(hole, u, cell).
   17path(cell, w, hallway) :- at(key, in_hand).
   18path(cell, w, hallway) :-
   19        write('Cell door is locked. Look for a key. '),
   20        !, fail.
   21
   22path(hallway, n, kitchen).
   23path(kitchen, s, hallway).
   24path(hallway, s, rec_room).
   25path(rec_room, n, hallway).
   26path(hallway, w, wardens_office).
   27path(wardens_office, e, hallway).
   28path(rec_room, w, entrance).
   29path(entrance, e, rec_room).
   30path(entrance, w, outside).
   31
   32/* These facts tell where the various objects in the game
   33   are located. */
   34
   35at(gun, rec_room).
   36at(key, hole).
   37at(food, kitchen).
   38at(bullets, wardens_office).
   39at(25, health).
   40
   41
   42/* This fact specifies that the warden is alive. */
   43
   44alive(warden).
   45
   46/* These rules describe how to pick up an object. */
   47
   48take(X) :-
   49        at(X, in_hand),
   50        write('You''re already holding it!'),
   51        nl, !.
   52
   53take(X) :-
   54        i_am_at(wardens_office),
   55        at(gun, in_hand),
   56        retract(at(gun, in_hand)),
   57        retract(at(X, wardens_office)),
   58        assert(at(gun_bullets, in_hand)),
   59        write('loaded your gun with bullets'),
   60        nl, !.
   61
   62take(X) :-
   63        i_am_at(rec_room),
   64        at(bullets, in_hand),
   65        retract(at(X, rec_room)),
   66        retract(at(bullets, in_hand)),
   67        assert(at(gun_bullets, in_hand)),
   68        write('loaded the gun with your bullets'),
   69        nl, !.
   70
   71take(X) :-
   72        i_am_at(kitchen),
   73        retract(at(X, kitchen)),
   74        at(Y, health),
   75        retract(at(Y, health)),
   76        assert(at(100, health)),
   77        write('You found food! You\'re health is back to 100 percent.'),
   78        nl, !.
   79
   80take(X) :-
   81        i_am_at(Place),
   82        at(X, Place),
   83        retract(at(X, Place)),
   84        (  at(Y, in_hand) ->
   85            retract(at(Y, in_hand)),
   86            assert(at(X, in_hand))  
   87        ;
   88            assert(at(X, in_hand))  
   89        ),
   90        write('OK.'),
   91        nl, !.
   92
   93take(_) :-
   94        write('I don''t see it here.'),
   95        nl.
   96
   97
   98/* These rules define the six direction letters as calls to go/1. */
   99
  100n :- go(n).
  101
  102s :- go(s).
  103
  104e :- go(e).
  105
  106w :- go(w).
  107
  108u :- go(u).
  109
  110d :- go(d).
  111
  112/* This rule tells whats in your inventory. */
  113
  114i :- 
  115        nl,
  116        (  at(X, in_hand) ->
  117             write(X)
  118        ;
  119             writeln('Nothing in hand.')
  120        ),
  121        nl.
  122   
  123/* This rule tells your current health */
  124
  125health :-
  126        nl,
  127        at(X, health),
  128        write(X),
  129        nl.
  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        at(X, health),
  138        retract(at(X, health)),
  139        Y is X - 5,
  140        assert(at(Y, health)),
  141
  142        (   Y is 0 ->
  143                write('You passed out from exhaustion and hunger.'),
  144                nl, die
  145        ;
  146                write('Youre health is now '), write(Y), nl,
  147                assert(i_am_at(There)),
  148                look, !
  149        ).
  150
  151go(_) :-
  152        write('You can''t go that way.').
  153
  154
  155/* This rule tells how to look about you. */
  156
  157look :-
  158        i_am_at(Place),
  159        describe(Place),
  160        nl,
  161        notice_objects_at(Place),
  162        nl.
  163
  164
  165/* These rules set up a loop to mention all the objects
  166   in your vicinity. */
  167
  168notice_objects_at(Place) :-
  169        at(X, Place),
  170        write('There is a '), write(X), write(' here.'), nl,
  171        fail.
  172
  173notice_objects_at(_).
  174
  175
  176/* These rules tell how to handle killing the warden. */
  177
  178kill :-
  179        i_am_at(entrance),
  180        at(gun_bullets, in_hand),
  181        retract(alive(warden)),
  182        write('You and the warden both draw'), nl,
  183        write('but you are too quick as you pull out your gun'), nl,
  184        write('and quickly shoot him down.'),
  185        nl, !.
  186
  187kill :-
  188        write('I see nothing to kill here.'), nl.
  189
  190
  191/* This rule tells how to die. */
  192
  193die :-
  194        !, finish.
  195
  196
  197/* Under UNIX, the   halt.  command quits Prolog but does not
  198   remove the output window. On a PC, however, the window
  199   disappears before the final output can be seen. Hence this
  200   routine requests the user to perform the final  halt.  */
  201
  202finish :-
  203        nl,
  204        write('The game is over. Please enter the   halt.   command.'),
  205        nl, !.
  206
  207
  208/* This rule just writes out game instructions. */
  209
  210instructions :-
  211        nl,
  212        write('Enter commands using standard Prolog syntax.'), nl,
  213        write('Available commands are:'), nl,
  214        write('start.                   -- to start the game.'), nl,
  215        write('n.  s.  e.  w.  u.  d.   -- to go in that direction.'), nl,
  216        write('take(Object).            -- to pick up an object.'), nl,
  217        write('kill.                    -- to attack an enemy.'), nl,
  218        write('look.                    -- to look around you again.'), nl,
  219        write('instructions.            -- to see this message again.'), nl,
  220        write('halt.                    -- to end the game and quit.'), nl,
  221        write('health.                  -- to check your health.'), nl,
  222        write('i.                       -- to check your inventory.'), nl,
  223        nl.
  224
  225
  226/* This rule prints out instructions and tells where you are. */
  227
  228start :-
  229        instructions,
  230        look.
  231
  232/* These rules describe the various rooms.  Depending on
  233   circumstances, a room may have more than one description. */
  234
  235describe(cell) :-
  236    at(X, in_hand),
  237    write('The cell door is to the west and locked.'), nl.
  238
  239describe(cell) :-
  240        write('You are a prisoner in a maximum security prison.'), nl,
  241        write('You are currently in your cell.'), nl,
  242        write('Your mission is to escape with your life.'), nl,
  243        write('You are famished as the guards have not fed you for days'), nl,
  244        write('and you will pass out soon.'), nl,
  245        write('The cell door is to the west which leads to the hallway'), nl,
  246        write('There also seems to be a small crawlspace beneath(down) you.'), nl.
  247
  248describe(hole) :-
  249        write('You are in a small crawlspace. Above(up) is your cell.'), nl.
  250
  251describe(hallway) :-
  252        write('You are in a hallway.  To the north is a kitchen'), nl,
  253        write('To the south, there is a rec_room'), nl,
  254        write('Finally, to the west, there is there warden\'s office.'), nl.
  255
  256describe(kitchen) :-
  257        write('You are in the kitchen'), nl.
  258
  259describe(rec_room) :-
  260        write('This is the rec_room.'), nl,
  261        write('The prison entrance is to the west.'), nl.
  262
  263describe(wardens_office) :-
  264        write('You are in the wardens office but he seems to be away.'), nl.
  265
  266describe(entrance) :-
  267        alive(warden),
  268        at(gun_bullets, in_hand),
  269        write('You can see the exit to the west.'), nl,
  270        write('But the warden has spotted you! Protect yourself!'), nl.
  271
  272describe(entrance) :-
  273        alive(warden),
  274        write('You can see the exit to the west.'), nl,
  275        write('But the warden has spotted you and shot you down.'), nl,
  276        die.
  277
  278describe(entrance) :-
  279        write('The warden is dead. Flee to freedom!'), nl.
  280
  281describe(outside) :-
  282        write('You have escaped!! Congrats!'), nl,
  283        finish, !