Program Kursach;
uses crt;
type
    Tinf=integer;
    List=^TList;
    TList=record
      data:TInf;
      next : list;
      prev : list;
end;
{=====================================Creation of Spisok====================================}
procedure AddElem(var first:List; znach1 : tinf);
var
    tmp,tmp1:List;
begin
if first=nil then
    begin
        Getmem(first,SizeOf(TList));
        first^.next:=first;
        tmp:=first;
    end
else
    begin
        tmp:=first;
        while tmp^.next<>first do
            tmp:=tmp^.next;
            GetMem(tmp1,SizeOf(Tlist));
            tmp1^.next:=tmp^.next;
            tmp1^.prev:=tmp;
            tmp1^.next^.prev := tmp1;
            tmp^.next:= tmp1;
            tmp1^.data:=znach1;
    end;
end;
{====================================Printing of Spisok=====================================}
procedure print(first : list);
var
    p: List;
begin
if first = nil then
writeln('<empty>')
else
    begin
    p:= first;
        repeat
            write(p^.data:4); p:=p^.next;
        until p = first;
    end;
writeln;
end;
{==================================Clearing all Spisok======================================}
Procedure FreeStek(spis1:List);
var
    tmp,first:List;
begin
if spis1=nil then
    exit;
    first:=spis1;
    tmp:=spis1;
    spis1:=spis1^.next;
    dispose(tmp);
while spis1<>first do
    begin
        tmp:=spis1;
        spis1:=spis1^.next;
        FreeMem(tmp,SizeOf(Tlist));
    end;
end;
{==========================Deleting of the element========================}
function removeitem(var first: list; p: list) : list;
begin
if first^.next = first then
    begin
        freemem(first, sizeof(tlist));
        first := nil;
        removeitem := nil;
        exit;
    end;
    removeitem := p^.next;
    p^.prev^.next := p^.next;
    p^.next^.prev := p^.prev;
    if p = first then first := p^.next;
        freemem(p, sizeof(tlist));
        p := nil;
end;
procedure process(var first:list);
var
    p: list;
begin
if first = nil then
    writeln('empty')
else
    begin
        p:= first;
        repeat
            if (p^.data < 0) and (p^.next^.data = p^.prev^.data) then
                begin
                    p := removeitem(first, p);
                end
            else
                p:=p^.next;
        until p = first;
    end;
end;
{=================================Menu of Program========================================================}
var
    SpisNach,
    tmpl:List;
    znach,a,b:integer;
    ch:char;
begin
    SpisNach:=nil;
    repeat
        clrscr;
        textcolor(1);
        writeln('                     ======================================');
        writeln('                     ===                                ===');
        writeln('                     ===                                ===');
          write('                     ===');
        TextColor(4);
          Write('             WELCOME!!!');
        textcolor(1);
        writeln('         ===');
        writeln('                     ===                                ===');
        writeln('                     ===                                ===');
          write('                     ===');
        TextColor(5);
          Write('            "Circle List"');
        textcolor(1);
        writeln('       ===');
        writeln('                     ===                                ===');
        writeln('                     ===                                ===');
        writeln('                     ======================================');
        TextColor(6);
        writeln;
        writeln;
        writeln;
        writeln;
        Writeln('                           Choose the right action :');
        TextColor(7);
        writeln;
        writeln;
        Writeln('                            1) Add a new Element .');
        writeln;
        Writeln('                            2) Show the List .');
        writeln;
        Writeln('                            3) Delete the Element .');
        writeln;
        Writeln('                            4) Exit .');
        writeln;
        ch:=readkey;
            case ch of
                '1':begin
                        write('Enter value of new Element  : ');
                        readln(znach);
                        AddElem(SpisNach,znach);
                    end;
                '2':begin
                        clrscr;
                        Print(SpisNach);
                        readkey;
                    end;
                '3':begin
                        process(spisnach);
                    end;
            end;
    until ch='4';
    freestek(spisnach);
end.