Списки

program Hello; // Pascal [fpc 3.0.4]
type
    BT = LongInt; // Тип информации, которую собираемся сохранять
    u = ^Zveno;   //Указатель на запись
    //Структура
    Zveno = record
        inf : BT; //Информация
        next : u ; // Следующий элемент записи
    end;

{***************************************************}
//Процедура добавляет запись с значением X в начало списка
procedure v_nachalo(var First:u;x:BT);
var
    VSP : u; //Указатель на вспомогательный элемент списка
begin
    New(vsp); //выделяем память на новый элемент
    vsp^.inf :=x; //Вставляем значения
    vsp^.Next:=First; // Вставляем ссылку на следующий элемент(который до этого был первым)
    First:=VSP;// Переназначаем первый элемент списка
end;

{***************************************************}
//Процедура удаляет элемент списка из начала
Procedure IZ_nachala(var First:u; var x:BT);
var VSP:U; //Указатель на вспомогательный элемент списка
begin
    vsp:=First; // Теперь VSP - ссылка на первый элемент
    First:=First^.Next; // Достаем адрес второго элемента, теперь второй элемент стал первым
    x:=VSP^.Inf; // На всякий случай получаем значение удаляемого элемента
    Dispose(VSP); // Удаляем
end;

{***************************************************}
// Вставляем новый элемент после определенного элемента
Procedure V_Spisok(Pred:U; x:BT);
var vsp:u; // Указатель на временный элемент
begin
    New(VSP); // СОздаем новый элемент
    Vsp^.Inf:=x; //Помещаем в него значение
    Vsp^.Next := Pred^.Next; //Вставляем ссылку на следующий элемент(на место которого вставляем)
    pred^.Next:=Vsp; // В предыдущий вставляем ссылку на вновь созданный
end;

{***************************************************}
// Удаляем Из списка элемент после указанного( следующий за pred)
Procedure iz_spiska(pred:u; var x: bt);
var vsp:u; // Указатель на временный элемент
begin
    vsp := Pred^.Next; // Указатель на удаляемый элемент
    pred^.next := Pred^.next^.next; // В предыдущем меняем ссылку "перескакивая" через тот, что удаляем
    x:=vsp^.inf; // На всякий случай получаем значение удаляемого элемента
    dispose(vsp); // Удаляем
end;

{***************************************************}
//Возвращает true Если список пустой(первый элемент пустой)
//Вспомогательная
function Pust(first:u): Boolean;
begin
    Pust := first = nil;
end;

{***************************************************}
// Процедура отчистки списка
procedure ochistka(First:u);
var vsp:bt; // Вспомогательная
begin
    while not Pust(First) do //Пока список не пустой
        iz_nachala(First,vsp); //Удаляем первый элемент
end;

{***************************************************}
//Выводим список
procedure Print(First:u);
var Vsp:U; // Временный указатель на элемент списка
begin
    vsp:=first; // Начинаем с первого списка
    while vsp <> Nil do // Пока существует элемент списка
    begin
        write(vsp^.inf:6); // Вывести значение
        vsp:=vsp^.next; //Кладем в VSP ссылку на следующий элемент
    end;
    writeln;
end;

{*************ПЕРЕМЕННЫЕ**************************}
Var
    S1, S2, S3, V1, V2, V3 : U; //S - start; V - now
    A : BT; //information
    I, N : Byte;
Begin
    Randomize;
    N := 1 + Random(20);
    S1 := Nil;
    A := -100 + Random(201);
    V_Nachalo(S1, A);
    V1 := S1;
    For I := 2 To N Do
        Begin
            A := -100 + Random(201);
            V_Spisok(V1, A);
            V1 := V1^.Next
        End;
    WriteLn('Исходный список: ');
    Print(S1);
    V1 := s1; S2 := Nil; S3 := Nil;
    While V1 <> Nil Do
    Begin
        If V1^.Inf > 0 Then
            If S2 = Nil Then
                Begin
                V_Nachalo(S2, V1^.Inf);
                V2 := S2
                End
            Else
                Begin
                V_Spisok(V2, V1^.Inf);
                V2 := V2^.Next
                End;
        If V1^.Inf < 0 Then
            If S3 = Nil Then
                Begin
                V_Nachalo(s3, V1^.Inf);
                V3 := S3
                End
            Else
                Begin
                V_Spisok(V3, V1^.Inf);
                V3 := V3^.Next
                End;
        V1:= V1^.Next
    End;
    WriteLn('Результирующий список из положительных элементов: ');
    Print(S2);
    WriteLn('Результирующий список из отрицательных элементов: ');
    Print(S3);
    Ochistka(S1);
    Ochistka(S2);
    Ochistka(S3);
end.