{
    This file is part of Chentrah,
    Copyright (C) 2004-2008 Anton Rzheshevski (chebmaster@mail.ru).

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see http://www.gnu.org/licenses/

 **********************************************************************

    This  contains a template for dynamic array wrapper classes.

 **********************************************************************}
 
{$ifdef header}
  typename = Class(TDyna)
    Function Add(i: typeofit): integer;
    procedure ClearMem; override;
  Protected
    {$ifdef cl_objecttype}
    a: array of pointer
    {$else}
    m: packed array of typeofit
    {$endif};
    function _Read(ind: cardinal): typeofit;
    procedure _Write(ind: cardinal; p: typeofit);
    function _ReadDPTR: pointer; override;
    function _ReadLast: typeofit;
    procedure _WriteLast(p: typeofit);
    procedure _Resize(L: integer); override;
  Public
    {$ifdef cl_objecttype}
    Container: boolean;
    {$endif}
    property D[index: cardinal]:typeofit read _Read write _Write; DEFAULT;
    property Last:typeofit read _ReadLast write _WriteLast;
  End;

{$else header}

function typename.Add(i: typeofit):integer;
begin
  Increment;
  Last:=i;
  Result:=High;
end;

procedure typename.ClearMem;
var j: integer;
begin
  For j:=0 to High do
  {$ifdef cl_objecttype}
    begin
      if Container and Assigned(a[j]) then TObject(a[j]).Free;
      a[j]:= NIL;
    end;
  {$else}
    {$ifdef cl_stringtype}
       m[j]:='';
    {$else}
       FillChar(m[j], SizeOf(m[0]), 0);
    {$endif}
  {$endif}
end;

procedure typename._Resize(L: integer);
var j, os: integer;
begin
  {$ifdef cl_objecttype}
    if (L < s) and Container then For j:=L to s - 1 do begin
      if Assigned(D[j]) then begin
        TObject(D[j]).Free;
        D[j]:=nil;
      end;
    end;
    SetLength(a, sm);
  {$else}
    {$ifdef cl_stringtype}
      if L < s then For j:=L to s - 1 do D[j]:='';
    {$endif}
    SetLength(m, sm);
  {$endif}
  os:=s;
  s:=L;
  if L > os then
  {$ifdef cl_objecttype}
    For j:=os to L - 1 do D[j]:= NIL;
  {$else}
    {$ifdef cl_stringtype}
      For j:=os to L - 1 do D[j]:='';
    {$else}
      For j:=os to L - 1 do FillChar(m[j], SizeOf(m[0]), 0);
    {$endif}
  {$endif}
end;


function typename._Read(ind: cardinal): typeofit;
begin
  Assert(s > 0, 'reading from one-dimensional TDyna descendant, which length is zero');
  Assert((integer(ind) >= 0) and (integer(ind) < s),
    'reading from one-dimensional TDyna descendant: invalid index, out of array boundaries');
  {$ifdef cl_objecttype}
    Result:=typeofit(a[ind]);
  {$else}
    Result:=m[ind];
  {$endif}
end;

{$ifndef cl_stringtype}
function typename._ReadDPTR: pointer;
begin
  if s=0 then Result:=nil else result:=@({$ifdef cl_objecttype}a{$else}m{$endif}[0]);
end;
{$else}
function typename._ReadDPTR: pointer;
begin
  Assert(False, 'attempt to read DPTR property of one-dimensional TDyna descendant which is a string array');
  Result:=nil;
end;
{$endif}


function typename._ReadLast: typeofit;
begin
  Assert(s > 0, 'reading from one-dimensional TDyna descendant, which length is zero');
  {$ifdef cl_objecttype}
  Result:= typeofit(a[s-1]);
  {$else}
  Result:=m[s-1];
  {$endif}
end;

procedure typename._Write(ind: cardinal; p: typeofit);
begin
  Assert(s > 0, 'writing to one-dimensional TDyna descendant, which length is zero');
  Assert((integer(ind) >= 0) and (integer(ind) < s),
    'writing to one-dimensional TDyna descendant: invalid index, out of array boundaries');
  {$ifdef cl_objecttype}
  a[ind]:=pointer(p);
  {$else}
  m[ind]:=p;
  {$endif}
end;

procedure typename._WriteLast(p: typeofit);
begin
  Assert(s > 0, 'writing to one-dimensional TDyna descendant, which length is zero');
  {$ifdef cl_objecttype}
  a[s-1]:=pointer(p);
  {$else}
  m[s-1]:=p;
  {$endif}
end;


{$endif header}

