Создание 2-х новых списков из элементов данного Опции

[MRK]

Требуется описать процедуру, которая по списку L строит два новых списка:
L1- из положительных элементов и L2-изостальных элементов списка L
(Т.э.=real). 10 раз перечитал FAQ, но всё равно запутался и никак не могу разобраться. Застрял при написании процедуры 'vibor'. Хотя, наверное, лучше выбор сделать в самой программе, а не в процедуре. Помогите плииз.

program spiski;
uses crt;
type tinf=real; tp=^tel;
     tel=record
          inf:tinf;
          psled:tp;
         end;
var head:tp; m:real; otvet2:char; pe:tp;
{------------------------------------------}
procedure vsp(var iel:tinf; var head:tp);  {создание списка L}
var pe:tp; otvet:char;
  begin
    writeln ('Vedite elementi spiska L');
    writeln('Dlya zaversheniya vvoda nazmite "E"');
    repeat
     read(m);
     new(pe);
     pe^.inf:=iel;
     pe^.psled:=head;
     head:=pe;
     otvet:=readkey;
    until otvet='e';
  end;
{------------------------------------------}
procedure print(head1:tp);     {вывод  списка}
var pk:tp;
  begin
    writeln('Spisok');
    pk:=head;
    while pk<>nil do
      begin
        write(pk^.inf:5:2,' | ');
        pk:=pk^.psled
      end;
    writeln
  end;
{------------------------------------------}
procedure vibor(iel1:tinf;head2:tp);   {выбор из L и создание L1 и L2}
var pl1:tp; k:real;
  begin
    pl1:=head2;
    while pl1<>nil do
      begin
        if pl1^.inf>0 then
          new(pl1);
          pl1^.inf:=iel1;
          k:=iel1;
          pl1^.psled:=head2;
          head2:=pl1;
      end;
    writeln
  end;
{------------------------------------------}
begin
  repeat
  clrscr;
  vsp(m,head);
  print(head);
  vibor(head2);
  writeln ('Dlya vihoda iz programmi nazmite " Y "');
  otvet2:=readkey
  until otvet2='y';
end. 

[volvo]

Вот пример процедуры, создающей из одного списка еще 2 (старый список остается !!!) по заданному тобой критерию:

procedure split(l: tp; var first, second: tp);
var p: tp;
begin
  first := nil; second := nil;

  while l <> nil do begin
    new(p);
    p^.inf := l^.inf;

    if l^.inf > 0 then begin
      p^.psled := first;
      first := p
    end
    else begin
      p^.psled := second;
      second := p
    end;
    l := l^.psled;
  end;
end;

Кроме того, у тебя в программе есть явный недочет:

procedure print(head1:tp);     {вывод  списка}
var pk:tp;
  begin
    writeln('Spisok');
    pk:=head; { <--- Здесь !!! }
    while pk<>nil do
      begin
        write(pk^.inf:5:2,' | ');
        pk:=pk^.psled
      end;
    writeln
  end;

Если уж ты передаешь в процедуру указатель на список, который нужно распечатать, то будь добр и печатать его, а не то, на что указывает глобальная переменная...

Со вводом тоже какая-то морока, я так и не разобрался, чего ты хотел, для теста набросал свою процедуру ввода списка...

[MRK]

Спасибо тебе огромное Всё получилось!