Список окрестностей вершины

uses crt,graph;
Type
T=^Telem;
Telem=Record
nv:integer;
nd,kd:byte;
adres:T;
end;
 
var
first,pu,tu:T;
kver,ji,vmax:byte;
m:array[1..10,1..10] of integer;
f:array[1..100] of byte;
Vibor:integer;
 
Procedure Init_Graph_Mode;
        Var
            Gr_Driver, Gr_Mode, Error_Code: Integer;
    Begin
    Gr_driver:= Detect;
InitGraph(Gr_Driver,  Gr_mode,  '');
    Error_Code:= GraphResult;
    If      Error_Code <> 0 then
            Begin
            Writeln('Soobshenie ob oshibke:',GraphErrorMsg(Error_Code));
            Halt;
            End
    End;
 
Procedure TextMenu;
Begin
TextColor(15);
writeln('Vvedite 1 dlya vvoda matrici smegnosti');
writeln('Vvedite 2 dlya formirovaniya spiska okrestnostei vershin');
writeln('Vvedite 3 dlya vivoda spiska na ekran');
writeln('Vvedite 0 dlya vihoda');
writeln;
End;
 
Procedure Vvod;
var
F_input:Text;
i,j:byte;
File_Name:string;
Begin
kver:=0 ; i:=0;
writeln('Vvedite imya faila dlya vvoda');
readln(File_Name);
assign(F_input,File_Name);
reset(F_input);
while not Eof(F_input) do
begin
 inc(i);  j:=0;
 While  Not  Eoln(F_input)  Do
 begin
  inc(j);
        read(F_input,m[i,j]);
  end;
 readln(F_input);
end;          kver:=i; ji:=j;
writeln('kolichestvo vershin = ',kver);
for i:=1 to kver do begin
for j:=1 to kver do
write(m[i,j]:3);
writeln;
end;
Close(F_input);
End;
 
Procedure Form_spis;
var i,k,j:byte;
Begin
    New(tu);
First:=tu;
    for i:=1 to kver do
    begin
        tu^.nv:=-i;
        for j:=1 to ji do
            if m[i,j]=1 then
            begin
          pu:=tu;
                new(tu);
                pu^.adres:=tu;
                tu^.nv:=j;
 
 
            end
      else if m[i,j]=-1 then
      k:=k+1;
 
      pu:=tu;
      new(tu);
      pu^.adres:=tu;
 
         end;
    tu^.adres:=nil;
end;
 
Procedure Vivod;
Begin
tu:=first;
while tu<>nil do
begin
writeln(tu^.nv:4);
tu:=tu^.adres;
end;
End;
 
Procedure Stepen_isx;
var tu:T;
   i,j:byte;
begin
tu:=first;
while tu<>nil do
begin
if tu^.nv<0 then
begin
i:=-tu^.nv;
f[i]:=0;
end
else f[i]:=f[i]+1;
tu:=tu^.adres;
end;
end;
 
Procedure viv1;
Var i:byte;
begin
for i:=1 to kver do
write(f[i],' ');
end;
 
 
 
procedure delete;
var pu,tu:T;i,imin,min,kdel:byte;mdel:array[1..10] of integer;
begin
     min:=10;imin:=1;
     for i:=2 to kver do
      if F[i]>min then
      begin
      min:=f[i];
      imin:=i;
      end;
        tu:=first;
        while tu<>nil do
        begin
         if tu^.nv=-imin then
          begin
           kdel:=1;
           mdel[kdel]:=imin;
            tu:=tu^.adres;
            while(tu<>nil)and(tu^.nv<0) do
            begin
              inc(kdel);
              mdel[kdel]:=tu^.nv;
              tu:=tu^.adres;
            end;
           break;
         end;
            pu:=tu;
            tu:=tu^.adres;
      end;
        for i:=1 to kdel do
         begin
           tu:=first;
           while tu<>nil do
                 begin
                   if tu^.nv=-mdel[i] then
                    begin
                       if tu=first then first:=tu^.adres
                            else
                             begin
                             pu^.adres:=tu^.adres;
                             tu:=pu;
                             end;
                                 tu:=tu^.adres;
            while(tu<>nil)and(tu^.nv<0) do
            begin
                 if tu=first then first:=tu^.adres
                            else
                             begin
                             pu^.adres:=tu^.adres;
                             tu:=pu;
                             end;
                   pu:=tu;
              tu:=tu^.adres;
            end;
                    end
             else if tu^.nv=mdel[i] then
                             begin
                             pu^.adres:=tu^.adres;
                             tu:=pu;
                             end;
             pu:=tu;
            tu:=tu^.adres;
             end
           end;
          end;
 
 
 
BEGIN
Repeat
TextMenu;
readln(Vibor);
case Vibor of
1: Vvod;
2: Form_spis;
3: Vivod;
4:Begin  Stepen_isx; viv1; End;
5: begin delete; Vivod; End;
end;
until Vibor=0;
clrscr;
END.