CP/M/CPM_CDROM.iso/mbug/mbug086.arc/GAMES.LBR/CONVOY1.IZ/CONVOY1.I

Text File | 1979-12-31 | 10KB | 344 lines

procedure Board;

const
  tab = ^I;

var
  k :integer;

begin
writeln;
writeln(tab,'The board (sub indicated by "<"):');
writeln;
write(tab);
for k := 1 to sqr(grid_size) do
  begin
  if k = sub.location
    then write(k:3,'<')
    else write(k:3,' ');
  if k mod grid_size = 0
    then begin
         writeln;
         write(tab);
         end;
  end;
writeln;
end; (* Board *)


procedure Instruct;

const
  tab = ^I;

var
  ch :char;

begin
writeln('This is a naval war game played on a ',grid_size,'x',grid_size,' matrix.');
writeln('You are the sub; the computer is a cargo ship with an escort and a destroyer.');
writeln('The ship starts in square ',sqr(grid_size),' and randomly moves towards its port (square 1)');
writeln('moving 1,2, or 3 squares at a time. The escort always stays within one');
writeln('square of the ship. The destroyer starts in a square near the ship and moves');
writeln('randomly 0,1,2, or 3 squares at a time searching for the sub.');
writeln('The sub starts near the port and can move up, down, left, or right one square');
writeln('at a time, two moves per turn, and it has torpedoes which it can fire one at a');
writeln('time in any straight line. After each sub move, the periscope will search each');
writeln('adjacent square for the ship. Also, random reconnaissance reports will be');
writeln('made. The sequence of play is:');
writeln;
writeln(tab,'1 ship and destroyers move,');
writeln(tab,'2 your move,');
writeln(tab,'3 you may fire a torpedo,');
writeln(tab,'4 periscope search,');
writeln(tab,'5 your move again,');
writeln(tab,'and back to 1.');
writeln;
write('Press RETURN... ');
readln(ch);
writeln;
writeln('The sub wins if it manages to destroy the cargo ship without moving to a');
writeln('square occupied by a destroyer.');
writeln('Firing commands are: NO, L, R, U, D, LU, LD, RU, RD.');
writeln('If you enter 0 as your move, then the board will be printed out.');
board;
write('Press RETURN... ');
readln(ch);
writeln; writeln;
end; (* Instruct *)


procedure Depth_Charge;
begin
who_won := computer; ended := true;
writeln('VAROOM!! Sub depth charged!');
end; (* Depth_Charge *)


procedure Move_Ship;

var
  move, k, dir, num_moves :integer;
  valid, reported :boolean;

  procedure Move_Escort;

  var
    move :integer;
    valid :boolean;

  begin
  repeat
    valid := true;
    move := ship.location + (1 - random(2) * 2) * (random(2) * 9 + 1);
    if (move < 2) or (move > sqr(grid_size)) then valid := false;
  until valid;
  escort.location := move;
  if escort.location = sub.location
    then begin
         writeln('Escort directly overhead!');
         depth_charge;
         end;
  end; (* Move_escort *)

begin (* Move_Ship *)
reported := false; randomize;
k := 1;
num_moves := random(3) + 1;
while (k <= num_moves) and (not ended) do with ship do
  begin
  if random < 0.75
    then dir := -1
    else dir := 1;
  valid := false;
  repeat
    move := dir * (random(2) * 9 + 1);
    if move = 1
      then begin
           if location mod grid_size = 0
             then dir := -dir
             else if -move = last_move
                    then dir := -dir
                    else valid := true;
           end
      else if move = -1
             then begin
                  if location mod grid_size = 1
                    then dir := -dir
                    else if -move = last_move
                           then dir := -dir
                           else valid := true;
                  end
             else if (-move = last_move) or
                     (location+move < 1) or (location+move > sqr(grid_size)) or
                     (location = destroyer.location)
                    then dir := -dir
                    else valid := true;
  until valid;
  if not reported
    then begin
         writeln('Ship moved.');
         reported := true;
         end;
  if location in [1..3,11,12,21]
    then begin
         who_won := computer; ended := true;
         writeln('Ship''s in port.');
         end
    else begin
         if location = sub.location
           then writeln('Ship now overhead.');
         last_move := move;
         location := location + move;
         if not escort.dead then move_escort;
         k := succ(k);
         end;
  end; (* while *)
end; (* Move_Ship *)


procedure Move_Destroyer;

var
  move, k, dir, num_moves :integer;
  valid, reported :boolean;

begin
reported := false; randomize;
k := 1;
if random > 0.8
  then num_moves := 0
  else num_moves := random(3) + 1;
while (k <= num_moves) and (not ended) do with destroyer do
  begin
  if random < 0.65
    then dir := -1
    else dir := 1;
  valid := false;
  repeat
    move := dir * (random(2) * 9 + 1);
    if move = 1
      then begin
           if location mod grid_size = 0
             then dir := -dir
             else if -move = last_move
                    then dir := -dir
                    else valid := true;
           end
      else if move = -1
             then begin
                  if location mod grid_size = 1
                    then dir := -dir
                    else if -move = last_move
                           then dir := -dir
                           else valid := true;
                  end
             else if (-move = last_move) or
                     (location+move < 2) or (location+move > sqr(grid_size)) or
                     (location = ship.location)
                    then dir := -dir
                    else valid := true;
  until valid;
  if not reported
    then begin
         writeln('Destroyer has moved.');
         reported := true;
         end;
  if location = sub.location
    then depth_charge
    else begin
         last_move := move;
         location := location + move;
         k := succ(k);
         end;
  end; (* while *)
end; (* Move_Destroyer *)


function Nearby (centre, intruder :integer) :boolean;
(* Returns true if "intruder" is in the immediate vicinity of "centre". *)

begin
nearby := (intruder = centre) or
          (intruder = centre-1) or (intruder = centre+1) or
          (intruder = centre-grid_size) or (intruder = centre+grid_size) or
          (intruder = centre-(grid_size-1)) or (intruder = centre+(grid_size-1)) or
          (intruder = centre-(grid_size+1)) or (intruder = centre+(grid_size+1));
end; (* Nearby *)


procedure Scan;

begin
randomize;
if (destroyer.location = sub.location) and (not destroyer.dead)
  then begin
       writeln('Destroyer directly overhead.');
       if random < 0.8
         then depth_charge
         else writeln('Depth charge just missed!');
       end
  else if (escort.location = sub.location) and (not escort.dead)
         then begin
              writeln('Escort directly overhead.');
              depth_charge;
              end
         else if nearby(sub.location,destroyer.location) and
                 (not destroyer.dead)
                then begin
                     writeln('Destroyer closing in at ',destroyer.location,'.');
                     destroyer.last_seen := destroyer.location;
                     end
                else if nearby(sub.location,escort.location) and
                        (not escort.dead)
                       then begin
                            writeln('Escort very near!');
                            escort.last_seen := escort.location;
                            end
                       else if (random > 0.6) and (not destroyer.dead)
                              then begin
                                   writeln('Recon. plane spots tincan at ',destroyer.location,'!');
                                   destroyer.last_seen := destroyer.location;
                                   end;
end; (* Scan *)


procedure Periscope_Search;

begin
randomize;
write('Up periscope: ');
if nearby(sub.location,ship.location)
  then begin
       writeln('ship at ',ship.location,'.');
       ship.last_seen := ship.location;
       end
  else begin
       writeln('ship not in sight.');
       if random > 0.4
         then begin
              writeln('Recon. shows ship at ',ship.location,'.');
              ship.last_seen := ship.location;
              end;
       end;
scan;
end; (* Periscope_Search *)


procedure Move_Sub;

var
  new_loc :integer;
  valid :boolean;

begin
writeln;
writeln('Sub is now at ',sub.location,'.');
write('Ship last seen at ',ship.last_seen);
if destroyer.dead
  then writeln('.')
  else writeln(', destroyer last sighted at ',destroyer.last_seen,'.');
repeat
  valid := true;
{$I-}
  repeat
    write('Sub''s move: ');
    readln(new_loc);
  until ioresult = 0;
{$I+}
  if (new_loc < 2) or (new_loc > sqr(grid_size))
    then begin
         valid := false;
         if new_loc = 0
           then board
           else writeln('What? Try again.');
         end;
  if valid
    then if new_loc = sub.location + 1
           then begin
                if sub.location mod grid_size = 0
                  then begin
                       valid := false;
                       writeln('Can''t move there. Try again.');
                       end;
                end
           else if new_loc = sub.location - 1
                  then begin
                       if new_loc mod grid_size = 0
                         then begin
                              valid := false;
                              writeln('Can''t move there. Try again.');
                              end;
                       end
                  else if not ((new_loc = sub.location+grid_size) or
                               (new_loc = sub.location-grid_size) or
                               (new_loc = sub.location))
                         then begin
                              valid := false;
                              writeln('Can''t move there. Try again.');
                              end;
until valid;
sub.location := new_loc;
periscope_search;
end; (* Move_Sub *)