10А электив. Очередь: задача об островах

На клеточной карте -1 обозначает море, 0 - сушу. Нужно пометить острова (группы клеток, соприкасающихся боковыми сторонами) цифрами, каждый остров - своей цифрой.
Пример
Исходная карта:
--------------------
-1  0 -1 -1  0
 0  0  0 -1  0
-1  0 -1 -1  0
-1 -1  0 -1  0
-1  0  0 -1 -1
--------------------
Карта после закраски:
--------------------
 -1  1 -1 -1  2
  1  1  1 -1  2
 -1  1 -1 -1  2
 -1 -1  3 -1  2
 -1  3  3 -1 -1
--------------------
Видим, что на карте 3 острова. Остров №1 состоит из 5 клеток, №2 из четырех, №3 из трех.

Для закраски островов используем очередь. Найдя очередную непомеченную клетку-сушу, помещаем ее в очередь и начинаем от нее процесс закраски. Извлекаем клетку из очереди, помечаем ее номером острова, а в очередь добавляем все соседние с ней непомеченные клетки - участки суши. Закраска закончится, когда очередь опустеет (все клетки острова окажутся в нее добавлены, а затем извлечены и помечены). Закраска одного острова представляет собой волновой алгоритм - поиск в ширину.

Алгоритм закраски острова

добавить в очередь клетку (x₀,y₀)

запомнить номер острова k

нц пока очередь не пуста

  извлечь из очереди клетку (x,y)

  а[x,y]:= k;

  если точка (x-1,y) существует и является

    сушей, то добавить ее в очередь все

  если точка (x,y+1) существует и является

    сушей, то добавить ее в очередь все

  если точка (x+1,y) существует и является

    сушей, то добавить ее в очередь все

  если точка (x,y-1) существует и является

    сушей, то добавить ее в очередь все

кц

Изучите программу, реализующую этот алгоритм, и выполните предложенные задания.

program FillQueue;
{Очередь. Заливка области}
{Самостоятельно выполните задания:
(В) Вывести количество островов на карте
(С) Вывести площадь каждого острова
(*) Вывести периметр каждого острова
(**) Разработать алгоритм поиска пути по морю между двумя клетками (данные клетки и все клетки пути относятся к морю)}

Type
  point = record
            x,y : integer; {координаты точки}
          end;
const
  N=100;
var
  a : array[1..10,1..10] of integer;      {карта максимального                                                  размера}
  f : text;                               {файловая переменная}
  xmax, ymax : integer;                   {реальный размер карты}
  Que : array[1..N] of point;             {очередь}
  head, tail : integer;                   {голова и хвост очереди}
  k: integer;                             {номер для пометки очередного острова}
  pt : point;                             {координаты клетки}
  x1, y1 : integer;                       {для хранения текущих координат}
  i, j : integer;

Function Full:boolean;
begin
  if tail=N then Full:=true else Full:=false;
end;

Function Empty:boolean;
begin
  if tail=head then Empty:=true else Empty:=false;
end;

Procedure AddQue(a:point);
begin
  if not(Full) then
    begin
      que[tail]:=a;
      inc(tail);
    end;
end;

Procedure OutQue(Var a:point);
begin
  if not(Empty) then
    begin
      a:=que[head];
      inc(head);
    end;
end;

Procedure ReadMap;
var i, j: integer;
begin
  assign(f,'map.txt');
  reset(f);
  readln(f,xmax,ymax);
  for i:=1 to xmax do
    for j:=1 to ymax do
      read(f,a[i,j]);
  close(f);
end;

Procedure SaveMap;
var i, j: integer;
begin
  assign(f,'res.txt');
  rewrite(f);
  writeln(f,xmax:3,ymax:3);
  for i:=1 to xmax do begin
    for j:=1 to ymax do write(f,a[i,j]:3);
    writeln(f);
  end;
  close(f);
end;

procedure ShowMap;
var i, j: integer;
begin
  writeln('--------------------');
  for i:=1 to xmax do begin
    for j:=1 to ymax do
      write(a[i,j]:3);
    writeln;
  end;
  writeln('--------------------');
end;

procedure Paint;            {процедура закраски острова}
var i,j : integer;
begin
  while not(Empty) do       {пока очередь не опустела}
    begin
      OutQue(pt);           {извлекаем из нее клетку}
      x1:=pt.x; y1:=pt.y;   {запоминаем ее координаты}
      a[x1,y1]:=k;          {помечаем извлеченную клетку}
      {проверяем, являются ли соседние клетки непомеченной сушей}
      {если клетка сверху есть и она является непомеченной сушей}
      if (x1 > 1) and (a[x1-1,y1]=0) 
       {собираем ее координаты в запись pt и помещаем ее в очередь}
       then begin  pt.x:=x1-1; pt.y:=y1; AddQue(pt) end;
      if (y1 > 1) and (a[x1,y1-1]=0) 
       then begin  pt.x:=x1; pt.y:=y1-1; AddQue(pt) end;
      if (x1 < xmax) and (a[x1+1,y1]=0) 
       then begin  pt.x:=x1+1; pt.y:=y1; AddQue(pt) end;
      if (y1 < ymax) and (a[x1,y1+1]=0) 
       then begin  pt.x:=x1; pt.y:=y1+1; AddQue(pt) end;
    end;
end;

begin
  ReadMap;      {считываем карту из файла}
  {вывод исходной карты на экран}
  writeln ( 'Исходная карта:' );
  ShowMap;
  {подготовка к работе}
  k:=0;
  {просматриваем карту, пока не найдем непомеченную клетку-сушу}
  for i:=1 to xmax do
    for j:=1 to ymax do
      if a[i,j]=0 then
        begin
          inc(k);           {назначаем острову очередной номер}
          head:=1; tail:=1; {приводим очередь в исходное (пустое) 
                             состояние}
          pt.x:=i; pt.y:=j; {запоминаем координаты первой клетки                                 острова в записи pt}
          AddQue(pt);       {помещаем координаты первой клетки                                   острова в очередь}
          Paint;            {запускаем процедуру закраски острова}
        end;
  {записываем карту в файл}
  SaveMap;
  writeln ( 'Карта после закраски:' );
  ShowMap;
End.