Кольцевые Двусвязные Списки Опции

[ikorstenxl]

ПОМОГИТЕ ПОЖАЛУЙСТА ДОДЕЛАТЬ ПРОГРАММУ.
Вот собственно код :

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:=first;
    tmp^.next:=tmp1;
    tmp:=tmp1;
  end;
  tmp^.data:=znach1;
end;

{====================================Printing of Spisok=====================================}
procedure Print(spis1:List);
var
  first:List;
begin
  if spis1=nil then
  begin
    writeln('Please add a new element');
    exit;
  end;
  first:=spis1;
  Write(spis1^.data, ' ');
  spis1:=spis1^.next;
  while spis1<>first do
  begin
    Write(spis1^.data, ' ');
    spis1:=spis1^.next;
  end;
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;
  {===============================================================================
===========}
Procedure DelElem(var spis1:List;tmp:List);
var
  tmpi:List;
begin
  if tmp=spis1 then
  begin
    tmpi:=tmp;
    while tmpi^.next<>spis1 do
      tmpi:=tmpi^.next;
    if tmpi=spis1 then
    begin
      spis1^.next:=nil;
      dispose(spis1);
      spis1:=nil
    end
    else
    begin
      tmpi^.next:=tmp^.next;
      spis1:=spis1^.next;
      dispose(tmp)
    end;
  end
  else
  begin
    tmpi:=spis1;
    while tmpi^.next<>tmp do
      tmpi:=tmpi^.next;
    tmpi^.next:=tmp^.next;
    dispose(tmp);
  end;
end;
 {=============================Deleting the element of Spisok===============================}
procedure DelElemZnach(var Spis1:List;znach1:TInf);
var
  tmp:List;
begin
  tmp:=spis1;

  
    if tmp^.data < 0 then                                                                    {!!!}
        if tmp^.next^.data = tmp^.prev^.data then 
  begin
    DelElem(spis1,tmp);
    exit;
  end;
  tmp:=tmp^.next;
  while tmp<>spis1 do
  begin


       if tmp^.data < 0 then                                                                  {!!!}
      if tmp^.prev^.data = tmp^.next^.data then 
    begin
      DelElem(spis1,tmp);
      exit
    end;
    tmp:=tmp^.next;
  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
       DelElemZnach(SpisNach);
          end;

    end;
    until ch='4';
    freestek(spisnach);
end.

Как вы могли понять программа добавляет новый элемент в кольцевой двусвязный список, выводит на экран список,и чистит его при выходе из программы. еще есть процедура которая удаляет элементы по условию :
1) if tmp^.data < 0 then - то бишь отрицательный элемент списка,
а должно быть два условия :
1)...
2) if tmp^.prev^.data = tmp^.next^.data then - отрицательный элемент который находить между двумя одинаковыми (1 -2 1 - удалить -2).

только вот дело в том что программа ,если только с первым условием , удаляет все отрицательные элементы, а если с двумя условиями то просто не удаляет ни чего.

подскажите пожалуйста что мне исправить что бы оно делало все правильно.

[volvo]

Вот именно потому, что ты не работаешь с полем Prev (ну объясни мне, зачем бежать по всему списку от First вперед, если можно одним движением назад получить тот же указатель?), оно и заполняется некорректно. Смотри:

procedure AddElem(var first: List; value: TInf);
var p: List;
begin
  Getmem(p, SizeOf(TList)); { <--- Это делается ВСЕГДА, вот и делаем это снаружи от If }
  p^.data := value;

  if first = nil then begin 
    {
      Первый элемент списка? Указываем "вперед" и "назад" на самого себя и
      запоминаем только что созданный элемент как первый
    }
    p^.next := p;
    p^.prev := p;
    first := p;
  end
  else begin
    {
      Ах, уже не первый? Тогда действовать надо по-другому:
      1) поскольку добавляем в "конец" списка (перед элементом first), то
      новый элемент next-ом указывает на "голову" списка, а prev-ом - туда,
      куда раньше указывал prev "головы"

      2) не забываем и про "бывший последний" элемент. (first^.prev который).
      Его поле next должно указывать куда? Правильно, на добавляемый элемент,
      иначе связи порушатся и при обходе списка будет бред.

      3) ну, и про то, что "голова" списка должна теперь указывать prev-ом на новый
      элемент, он ведь находится в списке ПЕРЕД "головой" - тоже не забываем...
    }
    p^.next := first;
    p^.prev := first^.prev;
    first^.prev^.next := p;
    first^.prev := p;
  end;

end;

Еще раз: берешь несколько листов бумаги и карандаш, чертишь на них списки и меняешь связи, пока не поймешь и не будет от зубов отлетать, что и как и почему именно в этом порядке (сменишь порядок пунктов 1, 2, 3 - будут проблемы)... Иначе так и будешь путаться в кольцевых списках.