program hw_1;
uses crt;
type
     PItem=^TItem;
     TItem=record
     Data:integer;
     Prev:PItem;
     end;
var
    P:PItem;
    Head:PItem;
    fl:text;

procedure CreateSame;
var Pnew:PItem;
    Curr:PItem;
begin
Curr:=Head;
while Curr<>nil do begin
if Curr^.Data<0 then begin
   new(Pnew);
   Pnew^.Prev:=Curr^.Prev;
   Pnew^.Data:=Abs(Curr^.Data);
   Curr^.Prev:=Pnew;
end;
Curr:=Curr^.Prev;
end;
end;

procedure DeleteNeg;
var
Del:PItem;
Save:PItem;
Curr:PItem;
begin
Curr:=Head;
While (Head^.Data<0) and (Head<>nil) do
begin
Curr:=Head;
Head:=Head^.Prev;
Dispose(Curr);
end;
Save:=Head;
Curr:=Head^.Prev;
while Curr<>nil do begin
if Curr^.Data>0 then
Save:=Curr
else
begin
Save^.Prev:=Curr^.Prev;
Del:=Curr;
{Dispose(Del);}
end;
Curr:=Curr^.Prev;
end;
end;

procedure ShowList;
var Curr:PItem;
begin
TextColor(15);
Curr:=Head;
while Curr<>nil do begin
write(Curr^.Data,'  ');
Curr:=Curr^.Prev;
end;
end;

procedure CheckList;
begin
       CreateSame;
       writeln;
       Textcolor(5);
       writeln('Созданы равные по модулю отрицательным');
       ShowList;
       DeleteNeg;
end;

procedure MakeList;
  begin
    Head:=nil;
    While not (EOF(fl)) do begin
    new(P);
    readln(fl,P^.Data);
    if Head<>nil then P^.Prev:=Head
    else P^.Prev:=nil;
    Head:=P;
    end;{while}
  end;


Begin
ClrScr;
   Assign(fl,'HW_1.txt');
    {$I-}
    reset(fl);
    {$I+}
    if IOResult=0 then begin
    MakeList;
    TextColor(5);
    writeln('Исходный список');
    ShowList;
    CheckList;
    end
    else writeln('Ошибка открытия файла');
writeln;
TextColor(5);
writeln('Преобразованный список');
ShowList;
readln;
readln;
end.