old/PAS/!SPbSTU/bsort.pas

type
 PRec = ^TRec;
 TRec = record
  key : integer;
  N,P : PRec;
 end;

procedure Insert(a,b:Prec);
begin
 b^.p^.n := b^.n;
 if (b^.n <> nil) then b^.n^.p := b^.p;

 a^.n^.p := b;
 b^.n := a^.n;

 a^.n := b;
 b^.p := a;
end;

procedure Bsort(L:PRec);
var
 i,j,m : PRec;
begin
 i := L;
 while (I^.N <> nil) do
 begin
  j := i^.N;
  M := J;
  while J <> NIL do
   begin
    if j^.key < m^.key then m:=j;
    j := j^.n;
   end;
  Insert(i,m);
  I := I^.n;
 end;
end;

procedure PrintN(L:Prec);
begin
 while L <> nil do
  begin
   WriteLn(L^.Key);
   L := L^.N;
  end;
end;

procedure PrintP(L:PRec);
var
 c : Prec;
begin
 c := L;
 while c^.n <> nil do c:=c^.n;
 while c^.p <> nil do begin WriteLn(C^.key);c:=c^.p;end;
end;

var 
 Li,eLi : PRec;
 mN : PRec;
begin
 New(Li);
 Li^.n:=nil;Li^.p:=nil;
 eLi := Li;
 Assign(Input,'bsort.txt');
 Reset(Input);
 while not eof do
 begin
   New(mN);Read(mN^.key);
   mN^.p := eLi;
   mN^.n := nil;
   eLi^.n := mN;
   eLi := mN;
 end;
 Close(Input);
 Assign(OutPut,'bsort.out');
 Rewrite(Output);
 WriteLn('Not sorted, strait order:');
 PrintN(Li^.N);
 WriteLn('Not sorted, reverse  order:');
 PrintP(Li);
 BSort(li);
 WriteLn('Sorted, strait order:');
 PrintN(Li^.N);
 WriteLn('Sorted, reverse  order:');
 PrintP(Li);
 Close(OutPut);
 while Li<> nil do 
  begin
   eLi := Li^.N;
   Dispose(Li);
   Li:=eLi;
  end;
end.