{-------- developed by: --------}
{                               }
{     Vadim Burenkov aka Vad    }
{                               }
{ mail: vadim_burenkov@mail.ru  }
{                               }
{-------------------------------}
unit DataLists;

interface

type
  dl_proc=procedure(p:Pointer);

type
  TDataList = record
   Data: array of pointer;
   DLength: integer;
   Count: integer;
  end;

function DataList_Add( var t: TDataList; Data: pointer ): integer;
procedure DataList_Free( var t: TDataList; h: integer );
procedure DataList_Each( var t: TDataList; p: dl_proc );

function DataList_GetID( var t: TDataList; Data: Pointer ): integer;
function DataList_ID_Get( var t: TDataList; ID: integer ): pointer;

const
  dl_nil = -1;

implementation

function DataList_Add( var t: TDataList; Data: pointer ): integer;
var
  i: integer;
begin
  result:=-1;
  for i:=0 to t.DLength-1 do if t.Data[i]=nil then
  begin
   result:=i;
   break;
  end;

  if result=-1 then
  begin
   result:=t.DLength;
   inc(t.DLength);
   SetLength(t.Data,t.DLength);
  end;

  inc(t.Count);
  t.Data[result]:=Data;
end;

procedure DataList_Free( var t: TDataList; h: integer );
var
  i: integer;
begin
  if h = t.DLength-1 then
  begin
   for i:=t.DLength-2 downto 0 do if t.Data[i]<>nil then break;
   t.DLength:=i+1;
   SetLength(t.Data,t.DLength);
  end
   else t.Data[h]:=nil;
  dec(t.Count);
end;

procedure DataList_Each( var t: TDataList; p:dl_proc );
var
  i:integer;
begin
  for i:=0 to t.DLength-1 do if t.Data[i]<>nil then p(t.Data[i]);
end;

function DataList_GetID( var t: TDataList; Data: Pointer ): integer;
var
  i:integer;
begin
  result := dl_nil;
  for i:=0 to t.DLength-1 do if t.Data[i]=Data then begin result:=i; exit; end;
end;

function DataList_ID_Get( var t: TDataList; ID: integer ): pointer;
begin
  result:=nil;
  if (t.DLength=0) or (ID>t.DLength-1) then exit;
  result := t.Data[ID];
end;

end.
