program test;
uses
    crt;
type
PTriangle = ^TTriangle;
TTriangle = record
   Versh:Array[1..3,1..3] of integer;
   NextTriangle: Ptriangle;
end;

function NoMemForTriag:Boolean;
begin
if maxAvail < SizeOf(PTriangle) then
   begin
    WriteLn('Not enough Memory!');
     NoMemForTriag:=true;
    end
     else
      NoMemForTriag:=false;
end;

procedure Vvod_CoordTreugolnika(var PC:Ptriangle;TC:integer);
var V_Counter, Coord_Counter:integer;
begin
   WriteLn('Zadaite parametry Treyg No ', TC);
    For V_Counter:=1 to 3 do
     begin
      WriteLn('Vershina ', Chr(Ord('A')+V_Counter-1));
       For Coord_Counter:=1 to 3 do
        begin
         Write(Chr(Ord('X')+Coord_Counter-1),': ');
         ReadLn(PC^.Versh[V_Counter, Coord_Counter]);
        end;
       end;
     PC^.NextTriangle:=nil;
end;

procedure Vvod_Treugolnikov(var PS:Ptriangle);
var Triangle_Counter:integer;
     G:Char;
     PCurrent,PPreviews: PTriangle;

  function Vvod1_Treugolnika:Boolean;
   begin
    Vvod1_Treugolnika:=false;
    If  NoMemForTriag then exit;
    New(PCurrent);
    IF Triangle_Counter=0 then PS:= PCurrent;
    INC(Triangle_Counter);
    Vvod_CoordTreugolnika(Pcurrent,Triangle_Counter);
    If PPreviews <> nil then PPreviews^.NextTriangle:=PCurrent;
    PPreviews:=PCurrent;
    Vvod1_Treugolnika:=true;
   end;

  begin
   Triangle_Counter:=0; PPreviews:=nil;
   repeat
   WriteLN('Treugolnik - T, Zavershenie - Z');
   Read(G);
  Case G of
  'Z': break;
  'T': If not Vvod1_Treugolnika then break;
else
  WriteLN('Ne pon9ntno!');
end; {case}
until False;
end;

procedure CheckForTria(Pstart:Ptriangle);
var
  PCurrent:Ptriangle;
  Triangle_Counter,I,J:integer;
   begin
    PCurrent:=PStart;
    Triangle_Counter:=0;
  repeat
   INC(Triangle_Counter);
   with Pcurrent^  do
    begin
     For I:=1 to 2 do
      For J:=I+1 to 3 do
       begin
        if (Pcurrent^.Versh[I, 1]=Versh[J,1]) and
           (Versh[I, 2]=Versh[J,2]) and
           (Versh[I, 3]=Versh[J,3]) then
          WriteLn('Treugolnik No', Triangle_Counter,' Vershiny sovpadaut!');
        end;
      end;
      PCurrent:=Pcurrent^.NextTriangle;
     until PCurrent = nil;

     end;


procedure Vyvod_Rez(PStart: PTriangle);
var
  Triangle_Counter, V_Counter, Coord_Counter:integer;

  PCurrent:Ptriangle;

begin
   PCurrent:=PStart;   Triangle_Counter :=0;
  repeat
    INC(Triangle_Counter);
        WriteLn('Treyg No ', Triangle_Counter);
        For V_Counter:=1 to 3 do
          begin
            WriteLn('Vershina ', Chr(Ord('A')+V_Counter-1));
             For Coord_Counter:=1 to 3 do
              begin
                 Write(Chr(Ord('X')+Coord_Counter-1),': ',
                 Pcurrent^.Versh[V_Counter, Coord_Counter], ' ');
              end; writeLn;
          end;
      PCurrent:=Pcurrent^.NextTriangle;
     until PCurrent = nil;
  readln;
  Readln;
end;

procedure ReturnMemory(Pstart:Ptriangle);
var
  PCurrent,PPreviews:Ptriangle;
   begin
    PCurrent:=PStart;
     repeat
       Ppreviews:=Pcurrent;
       PCurrent:=Pcurrent^.NextTriangle;
       Dispose(PPreviews);
     until PCurrent = nil;
end;

Procedure ControlMemory(K:String);
begin
  WriteLn(K, MemAvail);
end;

var Pstart:PTriangle;

begin
   clrscr;
   ControlMemory('starting value : ');
   Vvod_Treugolnikov(Pstart);
   ControlMemory('After entering : ');
   CheckForTria(Pstart);
   Vyvod_Rez(PStart);
   ReturnMemory(PStart);
   ControlMemory('Finished : ');
   readln;
end.