unit Collection;

interface
uses SysUtils;

CONST
  coIndexError = -1;
  coOverflow   = -2;
  MaxCollectionSize = 65536;

type
  Sw_Integer = integer;

  EFPCollectionError = class(Exception);

  TCollection = class
        Items: array of pointer;
        Count: Sw_Integer;
        Limit: Sw_Integer;
        Delta: Sw_Integer;
     CONSTRUCTOR Create (ALimit, ADelta: Sw_Integer);
     DESTRUCTOR destroy;                                      override;
     FUNCTION At (Index: Sw_Integer): Pointer;
     FUNCTION IndexOf (Item: Pointer): Sw_Integer;                  Virtual;
     PROCEDURE Pack;
     PROCEDURE FreeAll;
     PROCEDURE DeleteAll;
     PROCEDURE Free (Item: Pointer);
     PROCEDURE Insert (Item: Pointer);                              Virtual;
     PROCEDURE Delete (Item: Pointer);
     PROCEDURE AtFree (Index: Sw_Integer);
     PROCEDURE FreeItem (Item: Pointer);                            Virtual;
     PROCEDURE AtDelete (Index: Sw_Integer);
     PROCEDURE SetLimit (ALimit: Sw_Integer);                       Virtual;
     PROCEDURE Error (Code, Info: Integer);                         Virtual;
     PROCEDURE AtPut (Index: Sw_Integer; Item: Pointer);
     PROCEDURE AtInsert (Index: Sw_Integer; Item: Pointer);
  END;
TYPE
  TSortedCollection = class (TCollection)
        Duplicates: Boolean;
     CONSTRUCTOR Create (ALimit, ADelta: Sw_Integer);
     FUNCTION KeyOf (Item: Pointer): Pointer;                       Virtual;
     FUNCTION IndexOf (Item: Pointer): Sw_Integer;                  Virtual;
     FUNCTION Compare (Key1, Key2: Pointer): Sw_Integer;            Virtual;
                                                                    abstract;
     FUNCTION Search (Key: Pointer; Var Index: Sw_Integer): Boolean;Virtual;
     PROCEDURE Insert (Item: Pointer);                              Virtual;
  END;

implementation

CONSTRUCTOR TCollection.Create(ALimit, ADelta: Sw_Integer);
BEGIN
  Inherited Create;
  Delta := ADelta;
  SetLimit(ALimit);
END;

DESTRUCTOR TCollection.Destroy;
BEGIN
  FreeAll;
  SetLimit(0);
  inherited;
END;

FUNCTION TCollection.At (Index: Sw_Integer): Pointer;
BEGIN
  If (Index < 0) OR (Index >= Count) Then Begin
    Error(coIndexError, Index);
    At := Nil;
  End Else At := Items[Index];
END;

FUNCTION TCollection.IndexOf (Item: Pointer): Sw_Integer;
VAR I: Sw_Integer;
BEGIN
  If (Count>0) Then Begin
    For I := 0 To Count-1 Do
      If (Items[I]=Item) Then Begin
        IndexOf := I;
        Exit;
      End;
  End;
  IndexOf := -1;
END;

PROCEDURE TCollection.Pack;
VAR I, J: Sw_Integer;
BEGIN
  I := 0;
  J := 0;
  While (I<Count) AND (J<Limit) Do Begin
    If (Items[J]<>Nil) Then Begin
      If (I<>J) Then Begin
        Items[I] := Items{^}[J];
        Items[J] := Nil;
      End;
      Inc(I);
    End;
    Inc(J);
  End;
  If (I<Count) Then Count := I;
END;

PROCEDURE TCollection.FreeAll;
VAR I: Sw_Integer;
BEGIN
  for I := Count-1 downto 0 do
   FreeItem(At(I));
  Count := 0;
END;

PROCEDURE TCollection.DeleteAll;
BEGIN
  Count := 0;
END;

PROCEDURE TCollection.Free (Item: Pointer);
BEGIN
  Delete(Item);
  FreeItem(Item);
END;

PROCEDURE TCollection.Insert (Item: Pointer);
BEGIN
  AtInsert(Count, Item);
END;

PROCEDURE TCollection.Delete (Item: Pointer);
BEGIN
  AtDelete(IndexOf(Item));
END;

PROCEDURE TCollection.AtFree (Index: Sw_Integer);
VAR Item: Pointer;
BEGIN
  Item := At(Index);
  AtDelete(Index);
  FreeItem(Item);
END;

PROCEDURE TCollection.FreeItem (Item: Pointer);
BEGIN
 TObject(Item).Free;
END;

PROCEDURE TCollection.AtDelete (Index: Sw_Integer);
BEGIN
  If (Index >= 0) AND (Index < Count) Then Begin
    Dec(Count);
    If (Count>Index) Then
     Move(Items[Index+1],
          Items[Index],
          (Count-Index)*Sizeof(Pointer));
  End Else Error(coIndexError, Index);
END;

PROCEDURE TCollection.SetLimit (ALimit: Sw_Integer);
BEGIN
  If (ALimit < Count) Then
    ALimit := Count;
  If (ALimit > MaxCollectionSize) Then
    ALimit := MaxCollectionSize;
  If (ALimit <> Limit) Then
    Begin
      SetLength(Items, ALimit);
      Limit := ALimit;
    End;
END;

PROCEDURE TCollection.Error (Code, Info: Integer);
BEGIN
  raise EFPCollectionError.Create('FP Collection error '+IntToStr(Code)+' '+
                                   IntToStr(Info)
                                 );
END;

PROCEDURE TCollection.AtPut (Index: Sw_Integer; Item: Pointer);
BEGIN
  If (Index >= 0) AND (Index < Count) Then
    Items[Index] := Item
    Else Error(coIndexError, Index);
END;

PROCEDURE TCollection.AtInsert (Index: Sw_Integer; Item: Pointer);
VAR I: Sw_Integer;
BEGIN
  If (Index >= 0) AND (Index <= Count) Then Begin
    If (Count=Limit) Then SetLimit(Limit+Delta);
    If (Limit>Count) Then Begin
      If (Index < Count) Then Begin

         Move(Items[Index], Items[Index+1],
              (Count - Index) * sizeof(Items[0])
             );

      End;
      Items[Index] := Item;
      Inc(Count);
    End Else Error(coOverflow, Index);
  End Else Error(coIndexError, Index);
END;

CONSTRUCTOR TSortedCollection.Create (ALimit, ADelta: Sw_Integer);
BEGIN
  Inherited Create(ALimit, ADelta);
  Duplicates := False;
END;

FUNCTION TSortedCollection.KeyOf (Item: Pointer): Pointer;
BEGIN
  KeyOf := Item;
END;

FUNCTION TSortedCollection.IndexOf (Item: Pointer): Sw_Integer;
VAR I, J: Sw_Integer;
BEGIN
  J := -1;
  If Search(KeyOf(Item), I) Then Begin
    If Duplicates Then
      While (I < Count) AND (Item <> Items[I]) Do
        Inc(I);
    If (I < Count) Then J := I;
  End;
  IndexOf := J;
END;

FUNCTION TSortedCollection.Search (Key: Pointer; Var Index: Sw_Integer): Boolean;
VAR L, H, I, C: Sw_Integer;
BEGIN
  Search := False;
  L := 0;
  H := Count - 1;
  While (L <= H) Do Begin
    I := (L + H) SHR 1;
    C := Compare(KeyOf(Items[I]), Key);
    If (C < 0) Then L := I + 1 Else Begin
      H := I - 1;
      If C = 0 Then Begin
        Search := True;
        If NOT Duplicates Then L := I;
      End;
    End;
  End;
  Index := L;
END;

PROCEDURE TSortedCollection.Insert (Item: Pointer);
VAR I: Sw_Integer;
BEGIN
  If NOT Search(KeyOf(Item), I) OR Duplicates Then
    AtInsert(I, Item);
END;

end.