1/* A Doha Dilemma (based on a true story), by Rigel. */
    2
    3:- dynamic i_am_at/1, at/2, holding/1, examined/1, time/1.    4:- retractall(at(_, _)), retractall(i_am_at(_)), retractall(alive(_)).    5
    6i_am_at(restaurant).
    7time(30).
    8
    9path(restaurant, n, bathroom).
   10path(bathroom, s, restaurant).
   11path(restaurant, s, outside).
   12path(outside, n, restaurant).
   13path(outside, s, lobby).
   14path(outside, w, street).
   15path(street, e, outside).
   16path(street, n, taxi) :- holding(wallet), \+ holding(few_dollars), 
   17        write('Your wallet is empty. You need money to take a taxi!'), nl,
   18        !, fail.
   19path(street, n, taxi) :- \+ holding(wallet),
   20        write('You don''t have your wallet - how do you plan on taking a taxi?'), nl,
   21        !, fail.
   22path(street, n, taxi) :- holding(few_dollars).
   23path(lobby, n, outside).
   24path(lobby, w, outside_room).
   25path(lobby, e, front_desk).
   26path(front_desk, w, lobby).
   27path(outside_room, s, lobby).
   28path(outside_room, n, room) :- holding(key_card).
   29path(outside_room, n, room) :-
   30        write('You lost your key card! Better go get a new one.'), nl,
   31        !, fail.
   32path(room,s,outside_room).
   33path(taxi, n, gig).
   34
   35inside(tissue_box, few_dollars).
   36
   37at(tissue_box, bathroom).
   38at(key_card, front_desk).
   39at(wallet, room).
   40at(trumpet, room).
   41
   42in(tissue_box, few_dollars).
   43
   44requires(few_dollars, wallet).
   45
   46examinable(tissue_box).
   47
   48
   49/* This rule describes how you decrement the time you have left. */
   50
   51decr_time(X, X1) :-
   52    time(X),
   53    X1 is X-1,
   54    X1 is 1, 
   55    write('You have '), write(X1), write(' minute left.'), nl.
   56
   57decr_time(X, X1) :-
   58    time(X),
   59    X1 is X-1,
   60    write('You have '), write(X1), write(' minutes left.'), nl.
   61
   62
   63/* These rules describe how to pick up an object. */
   64
   65take(X) :-
   66        holding(X),
   67        write('You''re already holding it!'),
   68        !, nl.
   69
   70take(X) :-
   71        requires(X,Y), \+ holding(Y),
   72        write('You can''t take '), write(X), write(' yet - you need a '), write(Y), write('.'),
   73        !, nl.
   74
   75take(X) :-
   76        examinable(X),
   77        write('Why would you want to take that?'), !, nl.
   78
   79take(X) :-
   80        i_am_at(Place),
   81        at(X, Place),
   82        retract(at(X, Place)),
   83        assert(holding(X)),
   84        write('OK.'), 
   85        !, nl.
   86
   87take(_) :-
   88        write('I don''t see it here.'),
   89        nl.
   90
   91/* These rules describe how to put down an object. */
   92
   93drop(X) :-
   94        holding(X),
   95        i_am_at(Place),
   96        retract(holding(X)),
   97        assert(at(X, Place)),
   98        write('OK.'),
   99        !, nl.
  100
  101drop(_) :-
  102        write('You aren''t holding it!'),
  103        nl.
  104
  105/* These rules describe how to check your inventory. */
  106
  107i :- write('Inventory:'), nl,
  108     holding(X),
  109     write(X), nl,
  110     fail.
  111
  112i :- \+ holding(_), write('Your inventory is empty.'), !, nl.
  113
  114i.
  115    
  116
  117/* These rules define the direction letters as calls to go/1. */
  118
  119n :- go(n).
  120
  121s :- go(s).
  122
  123e :- go(e).
  124
  125w :- go(w).
  126
  127
  128/* This rule tells how to move in a given direction. */
  129
  130go(_) :-
  131        time(X),
  132        X is 0,
  133        die, !.
  134
  135go(Direction) :-
  136        i_am_at(Here),
  137        path(Here, Direction, There),
  138        retract(i_am_at(Here)),
  139        assert(i_am_at(There)),
  140        time(X),
  141        decr_time(X, Y),
  142        retract((time(X))),
  143        assert(time(Y)),
  144        !, look.
  145
  146go(_) :-
  147        write('You can''t go that way.').
  148
  149
  150/* This rule tells how to look about you. */
  151
  152look :-
  153        i_am_at(Place),
  154        describe(Place),
  155        nl,
  156        notice_objects_at(Place),
  157        nl.
  158
  159
  160/* These rules set up a loop to mention all the objects
  161   in your vicinity. */
  162
  163notice_objects_at(Place) :-
  164        at(X, Place),
  165        write('There is a '), write(X), write(' here.'), nl,
  166        fail.
  167
  168notice_objects_at(_).
  169
  170
  171/* This rule describes how to examine an object */
  172
  173examine(X) :- examinable(X),
  174              assert(examined(X)),
  175              in(X, Y),
  176              write('You found a '), write(Y), write(' in the '), write(X), write('!'), nl,
  177              i_am_at(Place),
  178              assert(at(Y,Place)),
  179              !, nl.
  180
  181examine(X) :- examinable(X),
  182              assert(examined(X)),
  183              write('There''s nothing special about '), write(X), write('.'), !, nl.
  184
  185examine(_) :- write('You can''t examine that.'), nl.
  186
  187
  188/* This rule tells how to die. */
  189
  190die :-
  191        finish.
  192
  193
  194/* Under UNIX, the "halt." command quits Prolog but does not
  195   remove the output window. On a PC, however, the window
  196   disappears before the final output can be seen. Hence this
  197   routine requests the user to perform the final "halt." */
  198
  199finish :-
  200        nl,
  201        write('The game is over. Please enter the "halt." command.'),
  202        nl.
  203
  204
  205/* This rule just writes out game instructions. */
  206
  207instructions :-
  208        nl,
  209        write('Enter commands using standard Prolog syntax.'), nl,
  210        write('Available commands are:'), nl,
  211        write('start.             -- to start the game.'), nl,
  212        write('n.  s.  e.  w.     -- to go in that direction.'), nl,
  213        write('take(Object).      -- to pick up an object.'), nl,
  214        write('drop(Object).      -- to put down an object.'), nl,
  215        write('examine(Object)    -- to examine an object.'), nl,
  216        write('i.                 -- to check your inventory.'), nl,
  217        write('look.              -- to look around you again.'), nl,
  218        write('instructions.      -- to see this message again.'), nl,
  219        write('halt.              -- to end the game and quit.'), nl,
  220        nl.
  221
  222
  223/* This rule prints out instructions and tells where you are. */
  224
  225start :-
  226        instructions,
  227        look.
  228
  229
  230/* These rules describe the various rooms.  Depending on
  231   circumstances, a room may have more than one description. */
  232
  233describe(restaurant) :- write('You are in a restaurant. To the north is the bathroom, to the south is the exit.'), nl,
  234                        write('You''re on tour with the Penn Glee Club in Doha right now, and you need to make it to your gig.'), nl,
  235                        write('You''re already late. Hurry up!'), nl.
  236
  237describe(bathroom) :- write('You''re in the bathroom at the restaurant.'), nl,
  238                      write('To the south is the restaurant.'), nl.
  239
  240describe(outside) :- write('You''re outside. To the north is the restaurant, to the south is the hotel, and to the west is the street.'), nl.
  241
  242describe(lobby) :- write('You''re in the hotel lobby. To the west is the elevators, to the east is the front desk,'), nl,
  243                   write('and to the north is the exit.'), nl.
  244
  245describe(front_desk) :- write('You''re at the front desk. To the west is the hotel lobby.'), nl.
  246
  247describe(outside_room) :- write('You''re outside your hotel room. To the north is your hotel room, to the south are the elevators.'), nl.
  248
  249describe(room) :- write('You''re in your hotel room. The door is to the south.'), nl,
  250                  write('Everybody has already left for the gig. Hurry!'), nl.
  251
  252describe(street) :- write('You''re out by the street. Taxis are wizzing by to the north, and the outside of the restaurant is to the east.'), nl.
  253
  254describe(taxi) :- write('You''re in a taxi. To the south is the street and the north is the gig.'), nl,
  255                  write('Do you have everything you need?'), nl.
  256
  257describe(gig) :- holding(trumpet), nl,
  258                 write('You made it to the gig. Congratulations!'),
  259                 finish, !.
  260
  261describe(gig) :- write('You didn''t bring your instrument, you idiot! What are you supposed to play?'), nl,
  262                 write('The rest of the band starts performing and you sit on the sidelines.'),
  263                 die, !