Hunt the Wumpus

OS-9 Pascal edition

{ *** HUNT THE WUMPUS *** }
program wumpus;
const
  HUNTER = 1;
  WUMPUS = 2;
  PIT1 = 3;
  PIT2 = 4;
  BAT1 = 5;
  BAT2 = 6;
var
  randstate : integer;
  arrows,lt,j,k,o,duel: integer;
  answer: char;
  path: array[1..5] of integer;
  cave: array[1..20,1..3] of integer;
  feature, origsetup: array[HUNTER..BAT2] of integer;

{ Returns a random number between 0.0 and 1.0 }
function random(var block:integer) : real; external;
procedure randomize(var block:integer); external;

{ Provide a random integer 1 <= x <= maxval }
function rnd(maxval:integer):integer;
begin
  rnd := trunc(random(randstate) * maxval) + 1;
end;

{ *** SET UP CAVE (DODECAHEDRAL NODE LIST) *** }
{ Pascal does not have initialization of arrays }
procedure initcave;
  var
    j,k: integer;
    cavefile: text;
  begin
     {
     reset(cavefile, '/d0/games/wumpuscave');
     for j := 1 to 20 do
       for k := 1 to 3 do
         read(cave[j,k]);
     close(cavefile);
     }

     cave[1,1]  := 2;  cave[1,2]  := 5;  cave[1,3]  := 8;
     cave[2,1]  := 1;  cave[2,2]  := 3;  cave[2,3]  := 10;
     cave[3,1]  := 2;  cave[3,2]  := 4;  cave[3,3]  := 12;
     cave[4,1]  := 3;  cave[4,2]  := 5;  cave[4,3]  := 14;
     cave[5,1]  := 1;  cave[5,2]  := 4;  cave[5,3]  := 6;
     cave[6,1]  := 5;  cave[6,2]  := 7;  cave[6,3]  := 15;
     cave[7,1]  := 6;  cave[7,2]  := 8;  cave[7,3]  := 17;
     cave[8,1]  := 1;  cave[8,2]  := 7;  cave[8,3]  := 9;
     cave[9,1]  := 8;  cave[9,2]  := 10; cave[9,3]  := 18;
     cave[10,1] := 2;  cave[10,2] := 9;  cave[10,3] := 11;
     cave[11,1] := 10; cave[11,2] := 12; cave[11,3] := 19;
     cave[12,1] := 3;  cave[12,2] := 11; cave[12,3] := 13;
     cave[13,1] := 12; cave[13,2] := 14; cave[13,3] := 20;
     cave[14,1] := 4;  cave[14,2] := 13; cave[14,3] := 15;
     cave[15,1] := 6;  cave[15,2] := 14; cave[15,3] := 16;
     cave[16,1] := 15; cave[16,2] := 17; cave[16,3] := 20;
     cave[17,1] := 7;  cave[17,2] := 16; cave[17,3] := 18;
     cave[18,1] := 9;  cave[18,2] := 17; cave[18,3] := 19;
     cave[19,1] := 11; cave[19,2] := 18; cave[19,3] := 20;
     cave[20,1] := 13; cave[20,2] := 16; cave[20,3] := 19;
  end;

{ *** LOCATE L ARRAY ITEMS *** }
{ *** 1-YOU, 2-WUMPUS, 3&4-PITS, 5&6-BATS *** }
procedure populate;
  var
    j,k: integer;
    crossover: boolean;
  begin
    repeat
      for j := 1 to 6 do
        begin
         feature[j] := rnd(20);
         origsetup[j] := feature[j]
        end;

     { *** CHECK FOR CROSSOVERS (IE feature[HUNTER]=feature[WUMPUS], ETC) *** }
      crossover := false;
      for j := 1 to 6 do
        for k := 1 to 6 do
           if (j<>k) and (feature[j]=feature[k]) then
             crossover := true;
    until crossover = false;
  end;

{ *** INSTRUCTIONS *** }
procedure instructions;
  var
     cr: char;
  begin
     writeln('WELCOME TO ''HUNT THE WUMPUS''');
     writeln('  THE WUMPUS LIVES IN A CAVE OF 20 ROOMS. EACH ROOM');
     writeln('HAS 3 TUNNELS LEADING TO OTHER ROOMS. (LOOK AT A');
     writeln('DODECAHEDRON TO SEE HOW THIS WORKS-IF YOU DON''T KNOW');
     writeln('WHAT A DODECAHEDRON IS, ASK SOMEONE)');
     writeln;
     writeln('     HAZARDS:');
     writeln(' BOTTOMLESS PITS - TWO ROOMS HAVE BOTTOMLESS PITS IN THEM');
     writeln('     IF YOU GO THERE, YOU FALL INTO THE PIT (& LOSE!)');
     writeln(' SUPER BATS - TWO OTHER ROOMS HAVE SUPER BATS. IF YOU');
     writeln('     GO THERE, A BAT GRABS YOU AND TAKES YOU TO SOME OTHER');
     writeln('     ROOM AT RANDOM. (WHICH MAY BE TROUBLESOME)');
     write('HIT RETURN TO CONTINUE');
     prompt;
     readln(cr);
     writeln('     WUMPUS:');
     writeln(' THE WUMPUS IS NOT BOTHERED BY HAZARDS (HE HAS SUCKER');
     writeln(' FEET AND IS TOO BIG FOR A BAT TO LIFT).  USUALLY');
     writeln(' HE IS ASLEEP.  TWO THINGS WAKE HIM UP: YOU SHOOTING AN');
     writeln(' ARROW OR YOU ENTERING HIS ROOM.');
     writeln('     IF THE WUMPUS WAKES HE MOVES (P=.75) ONE ROOM');
     writeln(' OR STAYS STILL (P=.25).  AFTER THAT, IF HE IS WHERE YOU');
     writeln(' ARE, HE EATS YOU UP AND YOU LOSE!');
     writeln;
     writeln('     YOU:');
     writeln(' EACH TURN YOU MAY MOVE OR SHOOT A CROOKED ARROW');
     writeln('   MOVING:  YOU CAN MOVE ONE ROOM (THRU ONE TUNNEL)');
     writeln('   ARROWS:  YOU HAVE 5 ARROWS.  YOU LOSE WHEN YOU RUN OUT');
     writeln('   EACH ARROW CAN GO FROM 1 TO 5 ROOMS. YOU AIM BY TELLING');
     writeln('   THE COMPUTER THE ROOM#S YOU WANT THE ARROW TO GO TO.');
     writeln('   IF THE ARROW CAN''T GO THAT WAY (IF NO TUNNEL) IT MOVES');
     writeln('   AT RANDOM TO THE NEXT ROOM.');
     writeln('     IF THE ARROW HITS THE WUMPUS, YOU WIN.');
     writeln('     IF THE ARROW HITS YOU, YOU LOSE.');
     write('HIT RETURN TO CONTINUE');
     prompt;
     readln(cr);
     writeln('    WARNINGS:');
     writeln('     WHEN YOU ARE ONE ROOM AWAY FROM A WUMPUS OR HAZARD,');
     writeln('     THE COMPUTER SAYS:');
     writeln(' WUMPUS:  ''I SMELL A WUMPUS''');
     writeln(' BAT   :  ''BATS NEARBY''');
     writeln(' PIT   :  ''I FEEL A DRAFT''');
     writeln;
  end;

{ *** PRINT LOCATION & HAZARD WARNINGS *** }
procedure location;
  var
    j,k: integer;
  begin
    writeln;
    for j := 2 to 6 do
        for k := 1 to 3 do
            if cave[feature[HUNTER],k]=feature[j] then
              case j of
                  2: writeln('I SMELL A WUMPUS!');
                3,4: writeln('I FEEL A DRAFT');
                5,6: writeln('BATS NEARBY!');
              end;

    writeln('YOU ARE IN ROOM ', feature[HUNTER]);
    writeln('TUNNELS LEAD TO ', cave[lt,1], ' ', cave[lt,2], ' ', cave[lt,3]);
    writeln
  end;

{ *** CHOOSE OPTION *** }
function askaction:integer;
  var
    i: char;
    o: integer;
  begin
    o := 0;
    repeat
      write('SHOOT OR MOVE (S-M)? ');
      prompt;
      readln(i);
      if (i = 'S') or (i = 's') then
        o := 1;
      if (i = 'M') or (i = 'm') then
        o := 2;
    until o <> 0;
    askaction := o;
  end;

{ *** SEE IF ARROW IS AT feature[HUNTER] OR AT feature[WUMPUS] }
procedure hittest;
  begin
    if lt=feature[WUMPUS] then
      begin
        writeln('AHA! YOU GOT THE WUMPUS!');
        duel := 1
       end
     else if lt=feature[HUNTER] then
       begin
         writeln('OUCH! ARROW GOT YOU!');
         duel := -1
       end;
  end;

{ *** MOVE WUMPUS ROUTINE *** }
procedure movewumpus;
  var
    k: integer;
  begin
    k := rnd(4);
    if k<>4 then
      feature[WUMPUS] := cave[feature[WUMPUS],k];
    if feature[WUMPUS] = lt then
      begin
        writeln('TSK TSK TSK - WUMPUS GOT YOU!');
        duel := -1
      end;
  end;

{ *** ARROW ROUTINE *** }
procedure shootarrow;
  var
    j9,k,k1: integer;
    goodroom: boolean;
  begin
    duel := 0;
    { *** PATH OF ARROW *** }
    repeat
      write('NO. OF ROOMS (1-5)? ');
      prompt;
      readln(j9);
    until (j9 > 0) and (j9 < 6);
    for k := 1 to j9 do
      begin
        repeat
          goodroom := false;
          write('ROOM # ');
          prompt;
          readln(path[k]);
          if k > 2 then
            if path[k] <> path[k-2] then
              goodroom := true
            else
              writeln('ARROWS AREN''T THAT CROOKED - TRY ANOTHER ROOM')
          else
            goodroom := true;
        until goodroom = true;
      end;
      
      { *** SHOOT ARROW *** }
      lt := feature[HUNTER];
      for k := 1 to j9 do
        begin
          for k1 := 1 to 3 do
            if cave[lt,k1]=path[k] then
              lt := path[k]
            else
              lt := cave[lt, rnd(3)]; { *** NO TUNNEL FOR ARROW *** }
          hittest;
        end;

     writeln('MISSED');
     lt := feature[HUNTER];
     { *** MOVE WUMPUS *** }
     movewumpus;
     { *** AMMO CHECK *** }
     arrows := arrows - 1;
     if arrows = 0 then
       duel := -1;
  end;

{ *** MOVE ROUTINE *** }
procedure movehunter;
  label 1045,1145;
  var
    k: integer;
    legal: boolean;
  begin
    duel := 0;
    repeat
      repeat
        write('WHERE TO? ');
        prompt;
        readln(lt);
      until (lt >= 1) and (lt <= 20);
      legal := false;
      for k := 1 to 3 do { *** CHECK IF LEGAL MOVE *** }
        if cave[feature[HUNTER],k]=lt then
          legal := true;
      if lt = feature[HUNTER] then
        legal := true;
      if legal = false then
        write('NOT POSSIBLE -');
    until legal;

     { *** CHECK FOR HAZARDS *** }
1045:
    feature[HUNTER] := lt;
    { *** WUMPUS *** }
    if lt = feature[WUMPUS] then
      begin
        writeln('... OOPS! BUMPED A WUMPUS!');
        { *** MOVE WUMPUS *** }
        movewumpus;
        if duel<>0 then
          goto 1145;
      end;
      { *** PIT *** }
      if (lt=feature[PIT1]) or (lt=feature[PIT2]) then
        begin
          writeln('YYYYIIIIEEEE . . . FELL IN PIT');
          duel := -1;
          goto 1145
        end;

     { *** BATS *** }
     if (lt=feature[BAT1]) or (lt=feature[BAT2]) then
       begin
         writeln('ZAP--SUPER BAT SNATCH! ELSEWHEREVILLE FOR YOU!');
         lt := rnd(20);
         goto 1045 { See if you landed on something }
       end;
1145:
  end;

begin
  randstate := 0;
  randomize(randstate);

  write('INSTRUCTIONS (Y-N)? ');
  prompt;
  readln(answer);
  if (answer = 'Y') or (answer = 'y') then
    instructions;
  initcave;
  populate;

  while true do
    begin
      { *** SET NO. OF ARROWS *** }
      arrows := 5;
      lt := feature[HUNTER];
      { *** RUN THE GAME *** }
      writeln('HUNT THE WUMPUS');
      repeat
        { *** HAZARD WARNING AND LOCATION *** }
        location;
        { *** MOVE OR SHOOT *** }
        o := askaction;
        if o = 1 then
          shootarrow
        else
          movehunter;
 
      until duel <> 0;
      if duel > 0 then
        writeln('HEE HEE HEE - THE WUMPUS''LL GET YOU NEXT TIME!!')
      else
        writeln('HA HA HA - YOU LOSE!');

      for j := 1 to 6 do
        feature[j] := origsetup[j];

      write('SAME SETUP (Y-N)? ');
      prompt;
      readln(answer);
      if (answer<>'Y') and (answer<>'y') then populate;
    end;

end.



Sidst opdateret: 2018/10/01
Website vedligeholdt af Søren Roug