1/* SpaceJam, by Jacob Katz. CIS 554 Fall 2014. */
    2
    3:- dynamic i_am_at/1, at/2, holding/1, count/1.    4:- retractall(at(_, _)), retractall(i_am_at(_)), retractall(alive(_)).    5
    6i_am_at(atrium).
    7
    8path(classroom, s, atrium).
    9
   10path(atrium, n, classroom).
   11path(atrium, w, lockerroom).
   12path(atrium, e, gym) :- holding(full_secret_stuff).
   13path(atrium, e, gym) :- holding(empty_secret_stuff),
   14        write('You need to fill your secret stuff'), nl,
   15        write('bottle before you can drink it!'), nl,
   16        write('Go fill the secret stuff in the bathroom sink '),nl,
   17        write('and then come win the game!'), nl, !.
   18path(atrium, e, gym) :- write('You can''t go into the gym without your'), nl,
   19                        write('secret stuff! If you do, you will lose!'), nl,
   20                        write('Go find your secret stuff, fill it up'), nl,
   21                        write('in the sink, and then come back to help'), nl,
   22                        write('win the game!'), nl, !, fail.
   23
   24path(gym, w, atrium).
   25
   26path(lockerroom, e, atrium).
   27path(lockerroom, s, bathroom_sink).
   28path(lockerroom, w, locker) :- holding(combination), !.
   29
   30path(locker, e, lockerroom).
   31
   32path(bathroom_sink, n, lockerroom).
   33
   34at(combination, classroom).
   35at(empty_secret_stuff, locker).
   36at(full_secret_stuff, bathroom_sink).
   37at(game, gym).
   38
   39/*Start timer at 16 moves, which is 2x the most optimal path*/
   40
   41count(16).
   42
   43decrement :- count(CurTime),
   44            NewTime is CurTime-1,
   45            retract(count(CurTime)),
   46            assert(count(NewTime)), !.
   47
   48/* These rules describe how to pick up an object. */
   49
   50take(full_secret_stuff) :-
   51        i_am_at(bathroom_sink),
   52        at(full_secret_stuff, bathroom_sink),
   53        !, take_full_secret_stuff.
   54
   55take(X) :-
   56        holding(X),
   57        write('You''re already holding it!'),
   58        !, nl.
   59
   60take(X) :-
   61        i_am_at(Place),
   62        at(X, Place),
   63        retract(at(X, Place)),
   64        assert(holding(X)),
   65        write('OK.'),
   66        !, nl.
   67
   68take(_) :-
   69        write('I don''t see it here.'),
   70        nl.
   71
   72take_full_secret_stuff :-
   73        i_am_at(bathroom_sink),
   74        at(full_secret_stuff, bathroom_sink),
   75        holding(empty_secret_stuff),
   76        retract(at(full_secret_stuff, bathroom_sink)),
   77        assert(holding(full_secret_stuff)),
   78        write('OK.'), !, nl.
   79
   80take_full_secret_stuff :-
   81        write('You need the empty secret stuff bottle!'), nl, fail.
   82
   83
   84/* These rules describe how to put down an object. */
   85
   86drop(X) :-
   87        holding(X),
   88        i_am_at(Place),
   89        retract(holding(X)),
   90        assert(at(X, Place)),
   91        write('OK.'),
   92        !, nl.
   93
   94drop(_) :-
   95        write('You aren''t holding it!'),
   96        nl.
   97
   98
   99/* These rules define the direction letters as calls to go/1. */
  100
  101n :- go(n).
  102
  103s :- go(s).
  104
  105e :- go(e).
  106
  107w :- go(w).
  108
  109i :- inventory.
  110
  111
  112inventory :- what_are_you_holding(_).
  113
  114what_are_you_holding(Obj) :- holding(Obj),
  115                            write('Holding: ' ),write(Obj),nl,fail.
  116
  117what_are_you_holding(_).
  118
  119
  120/* This rule tells how to move in a given direction. */
  121
  122go(Direction) :-
  123        count(X),
  124        X>=0,
  125        i_am_at(atrium),
  126        holding(full_secret_stuff),
  127        path(atrium, Direction, gym),
  128        retract(i_am_at(atrium)),
  129        assert(i_am_at(gym)),!,
  130        win.
  131
  132go(Direction) :-
  133        count(X),
  134        X>=0,
  135        i_am_at(Here),
  136        path(Here, Direction, There),
  137        retract(i_am_at(Here)),
  138        assert(i_am_at(There)),
  139        !,
  140        decrement,
  141        look, nl,
  142        write('You have '), write(X), write(' moves until it is too late!'),nl.
  143
  144go(_) :-
  145        count(X),
  146        X<0, !,
  147        write('Unfortunately you didn''t make it in time! :('),nl,
  148        write('Your team lost the game because you were too slow.'), nl,
  149        write('Maybe next time!'),
  150        die.
  151
  152go(_) :-
  153        write('You can''t go that way.').
  154
  155
  156/* This rule tells how to look about you. */
  157
  158look :-
  159        i_am_at(Place),
  160        describe(Place),
  161        nl,
  162        notice_objects_at(Place),
  163        nl.
  164
  165
  166/* These rules set up a loop to mention all the objects
  167   in your vicinity. */
  168
  169notice_objects_at(Place) :-
  170        at(X, Place),
  171        write('There is a '), write(X), write(' here.'), nl,
  172        fail.
  173
  174notice_objects_at(_).
  175
  176
  177/* This rule tells how to die. */
  178
  179die :-
  180        finish.
  181
  182/* This rule tells how to win. */
  183
  184win :-
  185        champion.
  186
  187
  188/* Under UNIX, the "halt." command quits Prolog but does not
  189   remove the output window. On a PC, however, the window
  190   disappears before the final output can be seen. Hence this
  191   routine requests the user to perform the final "halt." */
  192
  193finish :-
  194        nl,
  195        write('The game is over. Please enter the "halt." command.'),
  196        nl.
  197
  198champion :-
  199        nl,
  200        write('CONGRATS! You made it to the big game with your secret stuff!'),nl,
  201        write('Now you will win the big game just as you won this adventure.'), nl,
  202        write('The game is now over. Please enter the "halt." command.'), nl.
  203
  204/* This rule just writes out game instructions. */
  205
  206instructions :-
  207        nl,
  208        write('Enter commands using standard Prolog syntax.'), nl,
  209        write('Available commands are:'), nl,
  210        write('start.             -- to start the game.'), nl,
  211        write('n.  s.  e.  w.     -- to go in that direction.'), nl,
  212        write('i                  -- inventory.'),nl,
  213        write('take(Object).      -- to pick up an object.'), nl,
  214        write('drop(Object).      -- to put down an object.'), nl,
  215        write('look.              -- to look around you again.'), nl,
  216        write('instructions.      -- to see this message again.'), nl,
  217        write('halt.              -- to end the game and quit.'), nl,
  218        nl.
  219
  220
  221/* This rule prints out instructions and tells where you are. */
  222
  223start :-
  224        instructions,
  225        look,
  226        count(X),
  227        write('You have '), write(X), write(' moves to finish!').
  228
  229
  230/* These rules describe the various rooms.  Depending on
  231   circumstances, a room may have more than one description. */
  232
  233describe(atrium) :- write('You are at the atrium.'), nl,
  234                    write('To the north is the classroom.'), nl,
  235                    write('To the west is the lockerroom.'), nl,
  236                    write('To the east is the gym, where you can '), nl,
  237                    write('go win the game for the team; but you won''t '), nl,
  238                    write('be able to unless you can find your '), nl,
  239                    write('secret stuff, fill it up, and get to the gym. '), nl.
  240
  241describe(classroom) :- write('You are in the classroom right now.'), nl.
  242
  243describe(gym) :-
  244        holding(full_secret_stuff),
  245        write('You finally arrived with your secret stuff.'), nl,
  246        write('Let''s win this game now!'), nl,
  247        finish, !.
  248
  249describe(bathroom_sink) :-
  250        holding(empty_secret_stuff),!,
  251        write('Now that you have your empty secret stuff bottle,'), nl,
  252        write('you can fill it up here! After you''ve done that'), nl,
  253        write('head over to the gym and help win this game!'), nl.
  254
  255describe(bathroom_sink) :-
  256        holding(full_secret_stuff),!,
  257        write('You already have the full secret stuff! Get to'), nl,
  258        write('the gym as fast as you can so you can successfully'), nl,
  259        write('win the game!'), nl.
  260
  261describe(bathroom_sink) :-
  262        write('You need to get your secret stuff bottle so'), nl,
  263        write('you can fill it up here. Until then, nothing for'), nl,
  264        write('you to do here! '), nl,
  265        write('To return to the lockerroom, go NORTH.'), nl.
  266
  267describe(lockerroom) :-
  268        holding(combination),!,
  269        write('Now that you have the locker combination, you can'), nl,
  270        write('go to the WEST and access the locker.'), nl,
  271        write('To the SOUTH is the bathroom sink where, once'), nl,
  272        write('you have the secret stuff bottle, you can'), nl,
  273        write('fill it up and go win the game!'), nl.
  274
  275describe(lockerroom) :-
  276        write('You''re in the locker room, you need a'), nl,
  277        write('locker combination to access a locker.'), nl,
  278        write('To the SOUTH is the bathroom sink where, once'), nl,
  279        write('you have the secret stuff bottle, you can'), nl,
  280        write('fill it up and go win the game!'), nl,!.
  281
  282describe(lockerroom) :-
  283        write('You''re in the locker room, you need a'), nl,
  284        write('locker combination to access a locker.'), nl,
  285        write('To the SOUTH is the bathroom sink where, once'), nl,
  286        write('you have the secret stuff bottle, you can'), nl,
  287        write('fill it up and go win the game!'), nl,!.
  288
  289describe(locker) :-
  290        write('You made it to the locker!'), nl,
  291        write('Now you can get the secret stuff bottle,'), nl,
  292        write('but be aware that you still have to'), nl,
  293        write('fill it up in the bathroom sink!'), nl