old/PAS/NumbSort/nmbsrt.pas

Const
  size = 1000;
  fname = 'input.txt';
  oname = 'output.txt';

type Queue = record
  AR:Array [0..size] of Word;
  head,tail:byte;
end;

var
 Alls : array [0..10] of Queue;
{----------------------}
Procedure Add(var Qu:Queue;num:word);
begin
  if (Qu.tail<=size) then begin
    Qu.AR[Qu.tail]:=num;
    inc(Qu.tail);
  end;
end;
{----------------------}
Function Get(var Qu:Queue;var OUT:word):boolean;
begin
  if (Qu.head<>Qu.tail) then begin
    OUT:=Qu.AR[Qu.head];
    Get:=true;
    inc(Qu.head);
    if (Qu.head=qu.tail) then begin
      qu.head:=0;
      qu.tail:=0;
    end;
  end else Get:=false;
end;
{----------------------}
Function GetNum(num:word;pos:byte):byte;
var i:byte;
begin
  for i := 1 to pos do num:=num div 10;
  GetNum:=num mod 10;
end;
{----------------------}
Procedure GetData;
var
 F:text;
 cl:word;
begin
  Assign(F,fname);
  Reset(F);
  while not eof(F) do
   begin
    Read(F,cl);
    Add(Alls[10],cl);
   end;
  Close(F);
end;
{----------------------}
Procedure OutData;
var
 F:text;
 cl:word;
begin
  Assign(F,oname);
  ReWrite(F);
  while Get(Alls[10],cl) do WriteLn(F,cl);
  Close(F);
end;
{----------------------}
var
 Razm : byte;
 i,j  : word;
 vl   : word;

begin
  GetData;
  razm:=0;
  for i := Alls[10].head to Alls[10].tail do
    begin
     if (GetNum(Alls[10].AR[i],razm+1)<>0) then Inc(Razm);
   end;

  for i := 0 to razm do
   begin
     while Get(alls[10],vl) do Add(Alls[GetNum(vl,i)],vl);
     for j:=0 to 9 do
      begin
        While Get(Alls[j],vl) do Add(Alls[10],vl);
      end;
   end;
   OutData;
end.