Unit sorter;
{кФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФП
 Г This unit provides a tool for sorting arrays                             Г
 Г The array may be of any data type! all you have to do is to provide      Г
 Г a 'key function' by which the array elements are compared                Г
 Г such key functions are provided for the standard data types              Г
 Г You may write your own key functions in order to sort complex data types Г
 Г such as records, to reverse the sort order or to create multipile sort   Г
 Г keys for record elements.                                                Г
 Г Note: the key function must be compiled with $F+ (far calls on)          Г
 УФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФД
 Г Written by: Erez Amir CompuServe ID: 100274,701    Fax. (+9723)517-1077  Г
 Г May be used freely, as long as this notice is kept!                      Г
 УФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФД
 Г           M O D I F I C A T I O N    H I S T O R Y                       Г
 Г                                                                          Г
 Г Ver   Date        By             what                                    Г
 Г ---   ------      -------------- -------------------------------         Г
 Г 1.0   Sep-94      Erez Amir      Written, Debugged                       Г
 Г Add your update details here...                                          Г
 Г                                                                          Г
 УФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФД
 Г Examples:                                                                Г
 Г    /* Simple char array */                                               Г
 Г    Var a:array[1..m] of char                                             Г
 Г ->   Sort(a,n,SizeOf(a[1]),CharComp);                                    Г
 Г                                                                          Г
 Г    Type MyRec=Record Month,Day:integer end;                              Г
 Г         MyRecPtr=^MyRec;                                                 Г
 Г    Var MyArray: array[1..100] of MyRec;                                  Г
 Г    /* have to write your oun key */                                      Г
 Г     Function MyComp(p1,p2:Pointer):Boolean;                              Г
 Г       Var                                                                Г
 Г         v1:MyRecPtr absolute p1;                                         Г
 Г         v2:MyRecPtr absolute p2;                                         Г
 Г       Begin                                                              Г
 Г         MyComp:=(V1^.Month>V2^.Month) or                                 Г
 Г                 (V1^.Month=V2^.Month) and (V1^.Day=V2^.day);             Г
 Г       End;                                                               Г
 Г ->   Sort(MyArray,100,SizeOf(MyRec),MyComp);                             Г
 РФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФФй}
Interface
Type
  CompFunc=Function(V1,V2:Pointer):Boolean;

Procedure Sort(Var Struct;      { array of any Type }
               Num,             { Number of elements }
               Size:Integer;    { Size of each element ( byte ) }
               Comp:CompFunc);

{ Basic type compare functions }
Function IntComp(I1,I2:Pointer):Boolean;   far;
Function RealComp(r1,r2:Pointer):Boolean;  far;
Function ByteComp(b1,b2:Pointer):Boolean;  far;
Function CharComp(c1,c2:Pointer):Boolean;  far;
Function StringComp(s1,s2:Pointer):Boolean;far;

Implementation

Procedure Sort{...};

  var
    Temp:Pointer;
    StructBase:Array[0..0] of Byte Absolute Struct;

  Function VLoc(n:integer):Pointer;
    { Note that no range check is performed! }
    Begin
      {$R-}
      VLoc:=Addr(structBase[n*Size]);
      {$R+}
    End;

  Procedure Swap(n1,n2:Integer);
    { swap two elements }
    Begin
      Move(VLoc(n1)^,Temp^,Size);
      Move(VLoc(n2)^,VLoc(n1)^,Size);
      Move(Temp^,VLoc(n2)^,Size);
    End;

  { Quick sort routine }
  Procedure Qsort(l,r:Integer);
    Var
      i,j:Integer;
      Pivot:Pointer;
    Begin
      i:=l;
      j:=r;
      GetMem(Pivot,Size);  { Hopefully, the midpoint}
      Move(Vloc((L+r) div 2)^,Pivot^,Size);
      Repeat
        while Comp(Pivot,Vloc(i)) do inc(i);
        while Comp(Vloc(J),pivot) do Dec(j);
        if i<=j then
          Begin
            Swap(i,j);
            Inc(i);
            Dec(j);
          End;
      until i>j;
      if j>l then Qsort(l,j); { recoursive call }
      if i<r then Qsort(i,r);
      FreeMem(Pivot,Size);
    End;
  begin
    GetMem(Temp,Size);   { Temp is used for swap }
    if num>1 then
      Qsort(0,Num-1);
    FreeMem(Temp,Size);
  end;

Function IntComp(I1,I2:Pointer):Boolean;
  Type
    IntPtr=^Integer;
  Var
    v1:IntPtr absolute I1;
    v2:IntPtr absolute I2;
  Begin
    IntComp:=V1^>V2^;
  End;
Function RealComp(r1,r2:Pointer):Boolean;
  Type
    RealPtr=^Real;
  Var
    v1:RealPtr absolute r1;
    v2:RealPtr absolute r2;
  Begin
    RealComp:=V1^>V2^;
  End;
Function ByteComp(b1,b2:Pointer):Boolean;
  Type
    BytePtr=^Byte;
  Var
    v1:BytePtr absolute b1;
    v2:BytePtr absolute b2;
  Begin
    ByteComp:=V1^>V2^;
  End;
Function CharComp(c1,c2:Pointer):Boolean;
  Begin
    CharComp:=ByteComp(c1,c2); { Byte and char are the same! }
  End;
Function StringComp(s1,s2:Pointer):Boolean;
  Type
    StringPtr=^String;
  Var
    v1:StringPtr absolute s1;
    v2:StringPtr absolute s2;
  Begin
    StringComp:=V1^>V2^;
  End;

end.