Работа со списком

  program Lab5;
 
type
  List = record
    info: real;
    pred, next: ^List;
  end;
 
var
  head, tail: ^List;
 
// Функция вставляет элемент р в список после элемента last
// Возвращает указатель на вставленный в список элемент
function InsertElementIntoList(last, p: ^List): ^List;
begin{InsertElementIntoList}
  if (last <> nil) and (p <> nil) then
  begin
    p^.pred := last;
    p^.next := last^.next;
    last^.next := p;
    p^.next^.pred := p;
    InsertElementIntoList := p;
  end
  else
    InsertElementIntoList := nil
  
end;{InsertElementIntoList}
 
// Процедура создает двусвязный линейный список с двумя строжами
// head  и tail. Ввод значений - с клавиатуры
procedure CreateList(var head, tail: ^List);
var
  p, last: ^List;
  k: integer;
begin{CreateList}
  new(head); // Создание сторожей
  new(tail);
  head^.next := tail;
  tail^.pred := head;
  
  writeln('Вводите числа до 0');
  readln(k);
  last := head;
  while k <> 0 do
  begin
    new(p);
    p^.info := k;
    last := InsertElementIntoList(last, p);
    readln(k);
  end; 
end;{CreateList}
 
// Процедура выводит двусвязный список с двумя сторожами head и tail на экран
procedure PrintList(head, tail: ^List);
var
  p: ^List;
begin{PrintList}
  p := head^.next;
  while p <> tail do
  begin
    write(p^.info: 4);
    p := p^.next;
  end;
  writeln;
end;{PrintList}
 
// Функция исключает элемент р из списка, возвращает адрес
// элемента, следовавшего после р
function RemoveElement(p: ^list): ^List;
var
  p1, p2: ^List;
begin{RemoveElement}
  if p <> nil then
  begin
    p1 := p^.pred;
    p2 := p^.next;
    p1^.next := p2;
    p2^.pred := p1;
    RemoveElement := p2;
  end
  else
    RemoveElement := nil
end;{RemoveElement}
 
 
// Процедура находит максимальное
// количество подряд идущих положительных элементов
procedure MoveElements(head, tail: ^List);
var
  c: ^List;
  p: ^List;
  mc: ^List;
  count, mx: integer;
begin{MoveElements}
  count := 0;
  mx := 0;
  c := nil;
 
  p := head^.next;
  while (p <> tail) do
  begin
    if p^.info > 0 then
    begin
      if count = 0 then 
      begin
        c := p;
        Inc(Count)
      end
      else 
        Inc(Count);
    end
    Else 
    if Count > 0 then
      if count > mx then 
      begin
        mc := c;
        mx := count;
        count := 0;
      end;
    p := p^.next;
  end;
  Writeln(mx);
end;{MoveElements}
 
begin{program}
  CreateList(head, tail);
  writeln('Исходный список');
  PrintList(head, tail);
  MoveElements(head, tail);
  writeln('Новый список');
  PrintList(head, tail);
  
end.

type
  nComponent = ^Component;
  Component = Record
    i: integer;
    pred, next: nComponent;
  end;
 
var
  head, tail: nComponent;
  i: integer;
 
procedure push_back(var head: nComponent; x: integer);
var
  i: nComponent;
begin
  if head = nil then begin
    new(head);
    head^.i := x;
  end
  else begin
    i := head;
    while i^.next <> nil do
      i := i^.next;
    new(i^.next);
    i^.next^.i := x;
    i^.next^.pred := i;
  end;
end;
 
procedure getList(head: nComponent; var tail: nComponent);
var
  i, maxi: nComponent;
  l, maxl: integer;
begin
  l := 0;
  maxl := 0;
  i := head;
  while head <> nil do begin
    if head^.i > 0 then inc(l)
    else begin
      if maxl < l then begin
        maxi := i;
        maxl := l;
      end;
      l := 0;
      i := head^.next;
    end;
    head := head^.next;
  end;
  for l := 1 to maxl do begin
    push_back(tail, maxi^.i);
    maxi := maxi^.next;
  end;
end;
 
procedure Write(head: nComponent);
begin
  while head <> nil do begin
    write(head^.i, ' ');
    head := head^.next;
  end;
  writeln;
end;
 
begin
  for i := 1 to 20 do
    push_back(head, random(-10, 10));
  Write(head);
  getList(head, tail);
  Write(tail);
end.