unit Listu;
interface
{$I DEFINE.PAS}
uses SysUtils, ListType, WinUtl;

{EXPORT}
function ListInit(lt:TListType; AListInfo:PListInfo; var ALst:TLst):boolean;
{ creates list }
function ListClear(ALst:TLst):boolean;
{ removes all items }
function ListAdd(ALst:TLst; Item:pointer):boolean;
{ add new item at the end of list (indexed from 0)}
function ListRecAdd(ALst:TLst; var Rec):boolean;
{ alloc memory, copy Rec to it Add }
function ListRecGet(ALst:TLst; var Rec):boolean;
{ fifo like get, removes first inserted item
  from the list, copies to Rec and frees mem }
function ListRecPop(ALst:TLst; var Rec):boolean;
{ stack like pop, removes last inserted item
  from the list, copies to Rec and frees mem }
function ListRecAt(ALst:TLst; Index:integer; var Rec):boolean;
{ copies item at Index to Rec }

function ListDelete(ALst:TLst; Index:integer):boolean;
{ delete item at given index
  (destroyed if of known size and ltAutoDestroy option used)}
function ListInsert(ALst:TLst; Index:integer; Item:pointer):boolean;
{ inserts item at given index, items moved up }
function ListReplace(ALst:TLst; Index:integer; Item:pointer):boolean;
{ old item at index replaced by Item
  (old item never destroyed automatically) }
function ListAt(ALst:TLst; Index:integer):Pointer;
{ returns pointer stored in the slot Index }
function ListRemove(ALst:TLst; Item:pointer):boolean;
{ removes first item from list of given value;
  destroyed if of known size and ltAutoDestroy
  option used }
function ListIndexOf(ALst:TLst; Item:pointer):integer;
{ returns index of given pointer in the list (0..Count - 1)
  or -1 if not found }
function ListSort(ALst:TLst; AListSortCompare:TListSortCmp):boolean;
{ sorts the items in the list using AListSortFn }
function ListPack(ALst:TLst):boolean;
{ removes or nil slots in the list }
function ListSetPropInt(ALst:TLst; lp:TListProperty; AValue:integer):boolean;
{ use to set property Capacity (number of slots for items)}
function ListGetPropInt(ALst:TLst; lp:TListProperty):integer;
{ use to get properties Capacity, Count }
function ListCount(ALst:TLst):integer;
{ same as ListGetPropInt(ALst, lpCount), but shorter }
function ListGet(ALst:TLst; var Item:pointer):boolean;
{ FIFO like get of the first added item,
  i.e. combined Item := ListItemAt(ALst, 0);
                ListDelete(ALst, 0) }
function ListPop(ALst:TLst; var Item:pointer):boolean;
{ STACK like get of the last added item,
  i.e. combined Item := ListItemAt(ALst, Count-1);
    LastDelete(ALst, Count -1) }

function ListDone(var ALst:TLst):boolean;
{ destroy the list (and all items if of known
  size and ltAutoDestroy option used); ALst set
  to nil }
{/EXPORT}

implementation
uses classes, msgu;

  function StringsCompare(S1,S2:pointer):integer;
  var a:PString absolute S1; b:PString absolute S2;
  begin
    if S1 = nil then begin
      if S2 = nil then
        StringsCompare := 0
      else
        StringsCompare := -1;
    end else if S2 = nil then begin
      if S1 = nil then
        StringsCompare := 0
      else
        StringsCompare := 1;
    end else begin
      if a^ < b^ then
        StringsCompare := -1
      else if a^ > b^ then
        StringsCompare := 1
      else
        StringsCompare := 0;
    end;
  end;

const
  StringsListInfo:TListInfo = (RecordSize:0; ListSortCmp:StringsCompare; Capacity:0);
  EmptyListInfo:TListInfo = (RecordSize:0; ListSortCmp:nil; Capacity:0);

type
  TMLst = class (TList)
  public
    LT:TListType;
    Info:PListInfo;
    constructor Create;
    destructor Destroy;override;
  end;

constructor TMLst.Create;
begin
  inherited Create;
  LT := 0;
  New(Info);
end;

destructor TMLst.Destroy;
begin
  Dispose(Info);
  inherited Destroy;
end;

function ListInit(lt:TListType; AListInfo:PListInfo; var ALst:TLst):boolean;
{ creates list }
var als:TMLst absolute ALst;
begin
  ALs := TMLst.Create;

  case (lt and ltTypeMask) of
    ltStrings: begin
      if AListInfo = nil then
        AListInfo := @StringsListInfo
      else begin
        if not Assigned(AListInfo^.ListSortCmp) then
          AListInfo^.ListSortCmp := StringsCompare;
      end;
    end;
  else
    if AListInfo = nil then
      AListInfo := @EmptyListInfo;
  end;
  if AListInfo^.Capacity <> 0 then
    ALs.Capacity := AListInfo^.Capacity;
  ALs.LT := lt;
  ALs.Info^ := AListInfo^;
  ListInit := true;
end;

function ListClear(ALst:TLst):boolean;
{ removes all items }
var als:TMLst absolute ALst;
begin
  ALs.Clear;
  ListClear := true;
end;

function ListAdd(ALst:TLst; Item:pointer):boolean;
{ add new item at the end of list (indexed from 0)}
var als:TMLst absolute ALst;
begin
  ALs.Add(Item);
  if ((ALs.LT and ltAutoSort) <> 0) and (Assigned(ALs.Info^.ListSortCmp)) then
  begin
    ALs.Sort(ALs.Info^.ListSortCmp);
  end;
  ListAdd := true;
end;

function ListRecAdd(ALst:TLst; var Rec):boolean;
{ alloc memory, copy Rec to it Add }
var
  als:TMLst absolute ALst;
  p:pointer;
begin
  ListRecAdd := false;
  {$IFDEF DEBUG}
  if (als.Info = nil) or (als.Info^.RecordSize = 0) then begin
    SysError('ListRecAdd unknown recsize');
    exit;
  end;
  {$ENDIF}
  GetMem(p, als.Info^.RecordSize);
  if p = nil then
    exit;
  move(Rec, p^, als.Info^.RecordSize);
  ListRecAdd := ListAdd(ALst, p);
end;

function ListRecGet(ALst:TLst; var Rec):boolean;
{ fifo like get, removes first inserted item
  from the list, copies to Rec and frees mem }
var
  i:integer;
  als:TMLst absolute ALst;
  p:pointer;
begin
  ListRecGet := false;
  {$IFDEF DEBUG}
  if (als.Info = nil) or (als.Info^.RecordSize = 0) then begin
    SysError('ListRecGet unknown recsize');
    exit;
  end;
  {$ENDIF}
  i := ListCount(ALst);
  if i = 0 then
    exit;
  p := ListAt(ALst, 0);
  move(p^, Rec, als.Info^.RecordSize);
  ListDelete(ALst, 0);
  if (als.LT and ltAutoDestroy) = 0 then
    FreeMem(p, als.Info^.RecordSize);{i.e. ignore autodestroy flag,
      dispose always}
  ListRecGet := true;
end;

function ListRecPop(ALst:TLst; var Rec):boolean;
{ stack like pop, removes last inserted item
  from the list, copies to Rec and frees mem }
var
  i:integer;
  als:TMLst absolute ALst;
  p:pointer;
begin
  ListRecPop := false;
  {$IFDEF DEBUG}
  if (als.Info = nil) or (als.Info^.RecordSize = 0) then begin
    SysError('ListRecPop unknown recsize');
    exit;
  end;
  {$ENDIF}
  i := ListCount(ALst);
  if i = 0 then
    exit;
  p := ListAt(ALst, i-1);
  move(p^, Rec, als.Info^.RecordSize);
  ListDelete(ALst, i-1);
  if (als.LT and ltAutoDestroy) = 0 then
    FreeMem(p, als.Info^.RecordSize);{i.e. ignore autodestroy flag,
      dispose always}
  ListRecPop := true;
end;

function ListRecAt(ALst:TLst; Index:integer; var Rec):boolean;
{ copies item at Index to Rec }
var
  als:TMLst absolute ALst;
  p:pointer;
begin
  ListRecAt := false;
  {$IFDEF DEBUG}
  if (als.Info = nil) or (als.Info^.RecordSize = 0) then begin
    SysError('ListRecPop unknown recsize');
    exit;
  end;
  {$ENDIF}
  p := ListAt(ALst, Index);
  if p = nil then
    exit;
  move(p^, Rec, als.Info^.RecordSize);
  ListRecAt := true;
end;

function ListDelete(ALst:TLst; Index:integer):boolean;
{ delete item at given index
  (destroyed if of known size and ltAutoDestroy option used)}
var Item:pointer;
var als:TMLst absolute ALst;
begin
{  ListDelete := false;
  if (Index < 0) or (Index >= ALst.Count) then
    exit;}
  Item := ALs.Items[Index];
  ListDelete := ListRemove(Als, Item);
  {ALst.Delete(Index);
  ListDelete := true;}
end;

function ListInsert(ALst:TLst; Index:integer; Item:pointer):boolean;
{ inserts item at given index, items moved up }
var als:TMLst absolute ALst;
begin
  ALs.Insert(Index, Item);
  ListInsert := true;
end;

function ListReplace(ALst:TLst; Index:integer; Item:pointer):boolean;
{ old item at index replaced by Item
  (old item never destroyed automatically) }
var als:TMLst absolute ALst;
begin
  ListReplace := true;
  ALs.Items[Index] := Item;
end;

function ListAt(ALst:TLst; Index:integer):Pointer;
{ returns pointer stored in the slot Index }
var als:TMLst absolute ALst;
begin
  ListAt := ALs.Items[Index];
end;

function ListRemove(ALst:TLst; Item:pointer):boolean;
{ removes first item from list of given value;
  destroyed if of known size and ltAutoDestroy
  option used }
var als:TMLst absolute ALst;
begin
  ALs.Remove(Item);
  if (ALs.LT and ltAutoDestroy) <> 0 then begin
    case (ALs.LT and ltTypeMask) of
      ltStrings: begin
        DisposeStr(Item);
      end;
      ltRecords: begin
        {if ALst.Info^.RecordSize > 0 then begin}
          FreeMem(Item, ALs.Info^.RecordSize);
        {end;}
      end;
      ltObjects: begin
        ClassFree(Item){FreeObject(@Item};{winutl}
      end;
    end;
  end;
  ListRemove := true;
end;

function ListIndexOf(ALst:TLst; Item:pointer):integer;
{ returns index of given pointer in the list (0..Count - 1)
  or -1 if not found }
var als:TMLst absolute ALst;
begin
  ListIndexOf := ALs.IndexOf(Item);
end;

function ListSort(ALst:TLst; AListSortCompare:TListSortCmp):boolean;
{ sorts the items in the list using AListSortFn }
var als:TMLst absolute ALst;
begin
  ALs.Sort(AListSortCompare);
  ListSort := true;
end;

function ListPack(ALst:TLst):boolean;
{ removes or nil slots in the list }
var als:TMLst absolute ALst;
begin
  ALs.Pack;
  ListPack := true;
end;

function ListSetPropInt(ALst:TLst; lp:TListProperty; AValue:integer):boolean;
{ use to set property Capacity (number of slots for items)}
var als:TMLst absolute ALst;
begin
  ListSetPropInt := true;
  case lp of
    lpCapacity : ALs.Capacity := AValue;
  else
    ListSetPropInt := false;
  end;
end;

function ListGetPropInt(ALst:TLst; lp:TListProperty):integer;
{ use to get properties Capacity, Count }
var als:TMLst absolute ALst;
begin
  ListGetPropInt := 0;
  case lp of
    lpCount: ListGetPropInt := ALs.Count;
    lpCapacity: ListGetPropInt := ALs.Capacity;
  else
    exit;
  end;
end;
function ListCount(ALst:TLst):integer;
{ same as ListGetPropInt(ALst, lpCount), but shorter }
var als:TMLst absolute ALst;
begin
  ListCount := als.Count;
end;

function ListGet(ALst:TLst; var Item:pointer):boolean;
{ FIFO like get of the first added item,
  i.e. combined Item := ListItemAt(ALst, 0);
                ListDelete(ALst, 0) }
var als:TMLst absolute ALst;
begin
  ListGet := false;
  if ALs.Count = 0 then
    exit;
  ListGet := true;
  Item := ALs.Items[0];
  ALs.Delete(0);
end;

function ListPop(ALst:TLst; var Item:pointer):boolean;
{ STACK like get of the last added item,
  i.e. combined Item := ListItemAt(ALst, Count-1);
    LastDelete(ALst, Count -1) }
var als:TMLst absolute ALst;
begin
  ListPop := false;
  if ALs.Count = 0 then
    exit;
  ListPop := true;
  Item := ALs.Items[ALs.Count - 1];
  ALs.Delete(ALs.Count - 1);
end;

function ListDone(var ALst:TLst):boolean;
{ destroy the list (and all items if of known
  size and ltAutoDestroy option used); ALst set
  to nil }
var als:TMLst absolute ALst;
begin
  ListDone := false;
  if ALst = nil then
    exit;
  ALs.Free;
  ALs := nil;
  ListDone := true;
end;


end.
