1/* FINDING NEMO :: A Game by Urvashi Gupta
    2   Issue the command:   start.  */
    3
    4:- dynamic at/2, i_am_at/1, alive/1, timer/1, check_timer/1.   /* Needed by SWI-Prolog. */
    5:- retractall(at(_, _)), retractall(i_am_at(_)), retractall(timer(_)), retractall(check_timer(_)).    6
    7/* This defines my current location. */
    8
    9i_am_at(reef).
   10
   11
   12/* These facts describe how the ocean is connected. */
   13
   14path(reef, w, beach).
   15path(beach, e, reef).
   16
   17path(reef, e, midocean).
   18path(midocean, w, reef).
   19
   20path(reef, n, ocean_surface).
   21path(ocean_surface, s, reef).
   22
   23path(ocean_surface, n, ocean) :- at(dory, in_hand).
   24path(ocean_surface, n, ocean) :-
   25        write('Sorry! The whales can only speak to Dory! Better find her!'), nl,
   26        !, fail.
   27path(ocean, s, ocean_surface).
   28
   29path(reef, s, deep_sea) :- at(seashell, in_hand), at(stick, in_hand).
   30path(reef, s, deep_sea) :-
   31        write('The corals are covering the deep sea.'), nl,
   32        write('They only move when you tune in to Seashells and Sticks!'), nl,
   33        fail.
   34path(deep_sea, n, reef).
   35
   36path(ocean, w, green_sea).
   37path(green_sea, e, ocean).
   38
   39path(ocean, e, red_sea).
   40path(red_sea, w, ocean).
   41
   42path(red_sea, n, greenlands).
   43path(greenlands, s, red_sea).
   44
   45path(red_sea, e, junkyard) :- at(leaves, in_hand).
   46path(red_sea, e, junkyard) :-
   47        write('Can''t enter the junkyard!'), nl,
   48        write('Its super dirty here! Find something to clean it up!'), nl,
   49        !, fail.
   50path(junkyard, w, red_sea).
   51
   52path(red_sea, s, skylands).
   53path(skylands, n, red_sea).
   54
   55path(junkyard, clean, toothyard).
   56path(toothyard, w, junkyard).
   57path(green_sea, cut, green_sea_surface) :- at(tooth, in_hand).
   58path(green_sea, cut, green_sea_surface) :-
   59        write('Sorry! We need to find something to cut this net fast! '), nl,
   60        !, fail.
   61path(green_sea_surface, e, green_sea).
   62
   63
   64/* These facts tell where the various objects in the game
   65   are located. */
   66
   67at(stick, ocean_surface).
   68at(seashell, beach).
   69at(dory, deep_sea).
   70at(nemo, green_sea_surface).
   71at(leaves, greenlands).
   72at(tooth, toothyard).
   73
   74
   75/* This fact mentions the total time a player has
   76before his game finishes */
   77
   78timer(300).
   79
   80check_timer(A):- A \= 0.
   81
   82
   83/* These rules display the amount of time left to play the game. */
   84
   85time :-
   86        timer(X),
   87        write('You have '),
   88	write(X),
   89	write(' seconds left.'),
   90        nl, !.
   91
   92
   93/* These rules describe how to pick up an object. */
   94
   95take(X) :-
   96        at(X, in_hand),
   97        write('One at a time. You''re already holding the object!'),
   98        nl, !.
   99
  100take(X) :-
  101        i_am_at(Place),
  102        at(X, Place),
  103        retract(at(X, Place)),
  104        assert(at(X, in_hand)),
  105        write('OK.'),
  106        nl, !.
  107
  108take(_) :-
  109        write('I can''t find the object you are trying to take.'),
  110        nl.
  111
  112
  113/* These rules describe how to put down an object. */
  114
  115drop(X) :-
  116        at(X, in_hand),
  117        i_am_at(Place),
  118        retract(at(X, in_hand)),
  119        assert(at(X, Place)),
  120        write('OK.'),
  121        nl, !.
  122
  123drop(_) :-
  124        write('Don''t drop things you aren''t holding!'),
  125        nl.
  126
  127
  128/* These rules define the four direction letters as calls to go/1
  129and allows the players to cut and clean */
  130
  131n :- go(n).
  132
  133s :- go(s).
  134
  135e :- go(e).
  136
  137w :- go(w).
  138
  139clean :- go(clean).
  140
  141cut :- go(cut).
  142
  143
  144/* This rule tells how to move in a given direction. */
  145
  146go(Direction) :-
  147        i_am_at(Here),
  148        path(Here, Direction, There),
  149        retract(i_am_at(Here)),
  150        assert(i_am_at(There)),
  151        timer(OldTime),
  152        check_timer(OldTime), !,
  153	NewTime is OldTime - 10,
  154	retract(timer(OldTime)),
  155	assert(timer(NewTime)),
  156        look, !.
  157
  158go(_) :-
  159        write('There is no point in using this command right now.').
  160
  161
  162/* This rule tells how to look around you. */
  163
  164look :-
  165        i_am_at(Place),
  166        describe(Place),
  167        nl,
  168        notice_objects_at(Place),
  169        nl.
  170
  171/* This rule displays all the items in your inventory. */
  172
  173
  174i :-
  175	write('We found these items in your inventory: '), nl,
  176	notice_objects_at(in_hand),
  177	time,
  178        nl.
  179
  180inventory :-
  181	write('We found these items in your inventory: '), nl,
  182	notice_objects_at(in_hand),
  183	time,
  184	nl.
  185
  186
  187/* These rules set up a loop to mention all the objects
  188   in your vicinity. */
  189
  190notice_objects_at(Place) :-
  191        at(X, Place),
  192        write('FOUND :: '), write(X), nl,
  193        fail.
  194
  195notice_objects_at(_).
  196
  197
  198/* This rule tells how to die. */
  199
  200die :-
  201        !, finish.
  202
  203
  204/* Under UNIX, the halt.  command quits Prolog but does not
  205   remove the output window. On a PC, however, the window
  206   disappears before the final output can be seen. Hence this
  207   routine requests the user to perform the final  halt.  */
  208
  209finish :-
  210        nl,
  211        write('The game is over. Please enter the ''halt.''  command.'),
  212        nl, !.
  213
  214
  215/* This rule just writes out game instructions. */
  216
  217instructions :-
  218        nl,
  219        write('Enter commands using standard Prolog syntax.'), nl,
  220        write('Available commands are:'), nl,
  221        write('start.                   -- to start the game.'), nl,
  222        write('n.  s.  e.  w.           -- to go in that direction.'), nl,
  223        write('take(Object).            -- to pick up an object.'), nl,
  224        write('drop(Object).            -- to put down an object.'), nl,
  225        write('clean.                   -- to clean objects.'), nl,
  226        write('cut.                     -- to cut objects'), nl,
  227        write('look.                    -- to look around you again.'), nl,
  228        write('i.                       -- to see the objects currently held.'), nl,
  229	write('inventory.		   -- to see the objects currently held.'), nl,
  230	write('time.                    -- to check the amount of time left.'), nl,
  231        write('instructions.            -- to see this message again.'), nl,
  232        write('halt.                    -- to end the game and quit.'), nl,
  233        nl.
  234
  235
  236/* This rule prints out instructions and tells where you are. */
  237
  238start :-
  239        instructions,
  240        look.
  241
  242
  243/* These rules describe the various ocean areas.  Depending on
  244   circumstances, a room may have more than one description. */
  245
  246describe(_) :-
  247	timer(OldTime),
  248	\+ check_timer(OldTime),
  249	write('Oh nooo! Time is up! Nemo is gone! :''('), nl,
  250	write('You can still use basic commands but what''s the point of moving around anymore? :('), nl,
  251	finish, !.
  252
  253
  254describe(reef) :-
  255        at(nemo, in_hand),
  256        write('Nemo is back home! You and Dory make a good team! Don''t lose him again. '), nl,
  257        finish, !.
  258
  259describe(reef) :-
  260        write('You are in a small reef. To the north is the ocean surface'), nl,
  261        write('with whales; to the south is the closed deep blue sea of'), nl,
  262        write('corals; to the west is the beautiful beach; to the east is the mid ocean.'), nl,
  263        write('You must find nemo quickly before the fishermen take '), nl,
  264        write('him away. Hurry! '), nl.
  265
  266describe(beach) :-
  267        write('Welcome to the sunny beach! The reef is to the east.'), nl,
  268        write('Stay here and listen to some tunes played by our very own-'), nl,
  269        write('Seashells and Sticks Band! Remember that seashells are incomplete without sticks.'), nl.
  270
  271describe(ocean_surface) :-
  272        write('Welcome to the ocean surface! Go higher to reach the whales. '), nl,
  273        write('Go south to reach the reef again.'), nl,
  274        write('Remember that sticks are incomplete without seashells. '), nl.
  275
  276describe(ocean) :-
  277        at(dory, in_hand),
  278        write('Whale: Yeaayy! I can understand where you need to go now! '), nl,
  279        write('Whale: Lets GOOOOOOO!!! I will drop you to the write place.'), nl,
  280        write('Go west to reach the green sea;'), nl,
  281        write('go east to reach the dark red sea.'), nl,
  282        write('go south to reach the reef again.'), nl.
  283
  284describe(ocean) :-
  285    write('welcome to Ocean surface! Sorry! The whales can only speak to Dory! Better find her!'), nl.
  286
  287describe(deep_sea) :-
  288        at(seashell, in_hand),
  289        at(stick, in_hand),
  290        write('The corals have moved. Swim south and wake up Dory!'), nl,
  291        write('You are close to finding Nemo!'), nl.
  292
  293describe(deep_sea) :-
  294        write('Yes! You have found dory!'), nl,
  295        write('Go north to reach the reef.'), nl.
  296
  297describe(green_sea) :- at(tooth, in_hand), at(nemo, in_hand),
  298        write('Welcome to the Green Sea!'), nl.
  299
  300describe(green_sea) :- at(tooth, in_hand),
  301        write('Awesome! You found the golden tooth!'), nl,
  302        write('Lets CUT and free Nemo!'), nl.
  303
  304describe(green_sea) :-
  305        write('Welcome to the Green Sea!'), nl,
  306        write('The fishermen are closing in. Nemo is trapped in a net!'), nl,
  307        write('Find a sharp object to cut the net! Fast!'), nl,
  308        write('Go east to reach the ocean again.'), nl.
  309
  310describe(red_sea) :-
  311        write('Welcome to the Red Sea!'), nl,
  312        write('Go East for the junkyard place, full of broken plastic and sharks teeth!'), nl,
  313        write('Go north for the Greenlands; south for the SkyLands; west for the ocean'), nl.
  314
  315describe(toothyard) :-
  316        write('You have uncovered the golden tooth!'), nl,
  317        write('Go west to go back to the junkyard and save nemo!'), nl.
  318
  319
  320describe(junkyard) :- at(leaves, in_hand), at(tooth, in_hand),
  321        write('Welcome to the junkyard!'), nl,
  322        write('Go west to reach the red sea.'), nl.
  323
  324describe(junkyard) :- at(leaves, in_hand),
  325        write('Awesome!'), nl,
  326        write('You found something to CLEAN up this junk! Lets look for that tooth!'), nl.
  327
  328describe(junkyard) :-
  329        write('Welcome to the junkyard!'), nl.
  330
  331describe(greenlands) :-
  332        write('Welcome to the GreenLands!'), nl,
  333        write('Go south to go back to the red sea!'), nl.
  334
  335
  336describe(skylands) :-
  337        write('Welcome to the SkyLands!'), nl,
  338        write('Land of crocodiles! Haahahahha! Runnnn!'), nl.
  339
  340describe(midocean) :-
  341        write('Welcome to the Mid Ocean Wave!'), nl,
  342        write('The Jellyfish Land! Be careful! They sting! A LOT!!'), nl.
  343
  344 describe(green_sea_surface) :-
  345        write('Found Nemo! Lets take him back home!'), nl,
  346        write('Go east to reach the reef.'), nl