Program Laba_3; {реализация алгоритма перебора}
Uses WinCrt;
label 1,2,3,4,5;
type
 Matrix=array[0..3,0..3] of byte;
 TriMatrix = array [0..4] of matrix;

const
 A_data:Matrix=((1,1,1,0),(1,0,0,0),(0,0,1,0),(1,1,0,0));
 AB_data:Matrix=((1,0,1,1),(0,0,1,0),(0,1,0,0),(1,0,1,0));
 BC_data:Matrix=((0,1,0,1),(0,0,0,1),(1,1,0,1),(0,0,1,0));
 CD_data:Matrix=((1,0,0,1),(0,1,1,1),(0,0,0,1),(0,1,0,0));
 D_data:Matrix=((1,1,0,0),(1,1,1,0),(1,0,0,0),(0,0,1,0));

var
 Feeld_struct : TriMatrix;
 RezPath : array[0..5] of byte;
 Input :char;
 i,j,n,k:byte;
{==================================================================================================}
Procedure OneStep_Search(j:integer);  {Поиск в первом звене комутаторов}
          var k: integer;
          begin
               RezPath[5]:=0;
               RezPath[0]:=j;
               for k:=0 to 3 do begin
                  if Feeld_struct[1,j div 4,k]=1 then begin
                     RezPath[1]:=(j div 4)*4+k;
                     RezPath[5]:=1;
                     break;
                  end;
               end;
               if RezPath[5]=0 then writeln('Свободного пути не существует на ступени 1');
          end;

{==================================================================================================}
Procedure Inverse_Search(i:integer); {Поиск в последнем звене комутаторов}
          var k: integer;
          begin
               RezPath[5]:=0;
               RezPath[4]:=i;
               for k:=0 to 3 do begin
                  if Feeld_struct[3,i div 4,k]=1 then begin
                     RezPath[3]:=(i div 4)*4+k;
                     RezPath[5]:=1;
                     break;
                  end;
               end;
               if RezPath[5]=0 then writeln('Свободного пути не существует на ступени 4')
               else begin     {выводит результат поиска}
                    for k:=0 to 4 do begin
                      Write(RezPath[k]);
                      if k<4 then Write('-');
                    end;
                    writeln;
                    writeln('Соединение установленно');
                    readkey;
               end;
          end;

{==================================================================================================}
Procedure Central_Search(j:integer);   {поиск в полнодоступной зоне}
          var k, l : integer;
          Begin
               RezPath[5]:=0;
               For k:=2 to j do
               begin
                    for l:=0 to 15 do begin
                        if Feeld_struct[k,l div 4, l mod 4]=1 then begin
                          RezPath[k]:=l;
                          RezPath[5]:=1;
                          break;
                        end;
                    end;
                    if RezPath[5]=0 then begin
                       writeln('Свободного пути не существует на ступени',k);
                       break;
                    end;
               end;
               if j=4 then begin  {выводит результат поиска}
                  for k:=0 to j do begin
                      Write(RezPath[k]);
                      if k<j then Write('-');
                  end;
                  writeln;
                  writeln('Соединение установленно');
                  readkey;
               end;
          end;
{==================================================================================================}
BEGIN
 clrscr;
 Writeln('Лабораторная работа №3');
 Write('Реализация алгоритмов поиска свободного соединительного пути в  коммутационном  поле АТС');
 Writeln('');
 Writeln('Press any key to continue...');
 Readkey;
 Feeld_struct[0]:=A_data;
 Feeld_struct[1]:=AB_data;
 Feeld_struct[2]:=BC_data;
 Feeld_struct[3]:=CD_data;
 Feeld_struct[4]:=D_data;
 clrscr;
 goto 1;
2: Writeln('Будем продолжать? y/n');
   Readln(Input);
   if Input='y' then goto 1 else if Input='n' then goto 3;
1: Writeln('Введите тип искания: Линейное-L, Свободное-S, Групповое-G');
 Readln(Input);
 if Input='G' then
  begin
       Randomize;
       repeat
             begin
                  i:=Random(16);
             end
       until A_data[i div 4, i mod 4]=1;
       repeat
             begin
                  j:=Random(16);
             end
       until D_data[j div 4, j mod 4]=1;
       OneStep_Search(i);
       if RezPath[5]=1 then Central_Search(2);
       if RezPath[5]=1 then Inverse_Search(j);
  end else
 if Input='S' then
  begin
   4: writeln('Введите i');
   readln(i);
   if (i>15) or (i<0) then begin
      Writeln('Число находится за допустимыми пределами!');
      writeln;
      goto 4;
   end;
   if A_data[i div 4, i mod 4]=1 then begin
      OneStep_Search(i);
      if RezPath[5]=1 then Central_Search(4);
      end
   else writeln('Свободного пути не существует, т.к. занят вход');
  end else
 if Input='L' then
  begin
   5: writeln('Введите i,j:');
   readln(i,j);
   if ((i>15) or (i<0)) or ((j>15) or (j<0)) then begin
      Writeln('Число(а) за допустимыми пределами!');
      writeln;
      goto 5;
   end;
   if (A_data[i div 4, i mod 4]=1) and (D_data[j div 4, j mod 4]=1) then begin
      OneStep_Search(i);
      if RezPath[5]=1 then Central_Search(2);
      if RezPath[5]=1 then Inverse_Search(j);
   end else writeln('Свободного пути не существует, т.к. заняты вход/выход');
  end else
      begin
           Writeln('Введен неверный символ, повторите ввод!');
           writeln;
           goto 1;
      end;
  goto 2;
  3: writeln;
END.