unit JStruct;

//==============================================================================
//  INTERFACE
//==============================================================================
interface
  uses StringHash, Member, TextOnly, Constants, SysUtils, Classes;

  procedure generateMultiArrayPickerBatch(const n:integer; namepref:array of string; namesuf:array of string; const indexspace:integer; const index:string; const indent:integer; commandprefix:array of string; commandsufix:array of string; var outs:string; const inioff:integer=0; const iniindex:integer = 1; const continueif:boolean = false);
  procedure generateMultiArrayPicker(const namepref:string; const namesuf:string; const indexspace:integer; const index:string; const indent:integer; const commandprefix:string; const commandsufix:string; var outs:string);



//==============================================================================
type Tarray = class(Tobject)
public
   decl:integer;
   name:string;
   oftype:string;
end;

//==============================================================================
type Tstruct = class(TObject)
private

   function getOnInit:string;
public
   oninitv:string; //TODO: should be private

   libraryName :string;

   decl:integer;
   endline:integer;
   typeid:integer;

   name:string;

   modulesOnInit:string;


   membershash:TStringHash;
   members:array of Tmember;
   membern:integer;

   delegates:array of Tmember;
   delegateN:integer;


   ondestroy:Tmember;
   ondestroydone:boolean;
   zincstruct:boolean;
   parent:integer;
   parentstruct : integer;
   parentname:string;
   isarraystruct:boolean;
   isinterface:boolean;
   gotstructchildren:boolean;
   gotStubMethods:boolean;
   children:array of integer;
   nchildren:integer;

   customarray:integer;
   customarraytype:string;

   requiredspace: integer;

   maximum:integer;

   lessthan: string;

   forInternalUse:boolean;

   addedArrayControl:boolean;
   containsarraymembers:boolean;
   FunctionInterfacePrototype:integer;

   bigArrayId:integer;

   dofactory:boolean;
   noargumentcreate:boolean;
   customcreate:boolean;

   constructor create(libName:string;d:integer;int:boolean);
   procedure addchild(i:integer);
   function addmember(d:integer; const s:string;accs:integer; sta:boolean; method:boolean):tmember;
   procedure addDelegate(memb:tmember);
   function getmember(const s:string; var res:Tmember):boolean;

   procedure makeArrayStruct();

   procedure dropmember(const s:string);
   procedure addModuleOnInit(const s:string);
   procedure BeforeDestruction; override;

   function GetSuperParentName(StructList: array of Tstruct):string;
   function GetSuperParentNameForMethod(StructList: array of Tstruct; const methodname:string):string;
   property oninit:string read GetOnInit write oninitv;
end;

//==============================================================================
type Tdynamicstructarray = array of Tstruct;

//==============================================================================
type THook = class(Tobject)
   isMethod: boolean;
   funcid: integer;
   memb: Tmember;
   struct:Tstruct;
end;

//==============================================================================
type THookedNative = class(Tobject)
   nativename:string;
   hooks: Tlist;
end;

//==============================================================================
type TLibrary = class(TObject)
public
   name: string;
   req: array of string;
   req_opt: array of boolean;
   reqn: integer;
   contents: string;
   globals: string;
   validatedinit:boolean;
   declaration: integer;
   Init: string;        
end;

//==============================================================================
// globals for struct processing
//==============================================================================
var
   StructHash:Tstringhash;
   RequiredSizeHash:Tstringhash;
   IntegerConstants:Tstringhash;
   IdentifierTypes:Tstringhash;
   LocalIdentifierTypes: Tstringhash;

//==============================================================================
//  IMPLEMENTATION
//==============================================================================
implementation


//==============================================================================
function Tstruct.GetOnInit:string;
var
 i,n:integer;

 anamesuf,anamepref,acommandsuf,acommandpref:array of string;



    procedure add(const np:string; const ns:string; const cp:string; const cs:string);
    begin
        if(Length(anamesuf)<=n) then begin
            SetLength(anamesuf,n*2+2);
            SetLength(anamepref,n*2+2);
            SetLength(acommandsuf,n*2+2);
            SetLength(acommandpref,n*2+2);
        end;
        anamesuf[n]:=ns;
        anamepref[n]:=np;
        acommandsuf[n]:=cs;
        acommandpref[n]:=cp;
        n:=n+1;
    end;

begin
   Result:='';

   SWriteLnSmart(Result,oninitv);

   SetLength(anamesuf,1);
   SetLength(anamepref,1);
   SetLength(acommandsuf,1);
   SetLength(acommandpref,1);

   if(self.requiredspace>=JASS_ARRAY_SIZE) then begin
       n:=0;
       for i := 0 to membern - 1 do if(members[i].oninit_value<>'') then  begin
           add(RConcatenate3('s__',members[i].oninit_struct,'_'),members[i].name, 'set ','='+members[i].oninit_value );
       end;
       if(n<>0) then begin
           GenerateMultiArrayPickerBatch(n,anamepref,anamesuf,Self.requiredspace,'this',4,acommandpref,acommandsuf,Result);
       end;
   end else for i := 0 to membern - 1 do begin
       if(members[i].oninit_value<>'') then  begin
           SWriteLnSmart(Result,RConcatenate6('   set s__',members[i].oninit_struct,'_',members[i].name,'[this]=',members[i].oninit_value));
       end;
   end;




end;

//==============================================================================
procedure Tstruct.addModuleOnInit(const s:string);
begin
    SWriteLn(self.modulesOnInit,'call ExecuteFunc("s__'+Self.name+'_'+s+'")' );
end;


//==============================================================================
procedure Tstruct.dropmember(const s:string);
var
   h:integer;
begin
   h:=membershash.valueof(s);
   if(h<0) then exit;
   Members[h].oninit_value:='';
   members[h].oninit_struct:='';
   Members[h].ignore:=true;
   membershash.Remove(s); //no convenience totally getting rid of it.


end;

//==============================================================================
procedure TStruct.makeArrayStruct;
begin
    isArrayStruct:=true;
    dropmember('allocate');
    dropmember('deallocate');
end;

//==============================================================================
function Tstruct.addmember(d:integer; const s:string;accs:integer; sta:boolean; method:boolean):tmember;
begin
    if(membern=Length(members)) then begin
         SetLength(members,membern+5);
    end;
    members[membern]:=Tmember.create(d,s,accs,sta,method);
    Result:=    members[membern];
    membershash.Add(s,membern);
    membern:=membern+1;

end;

//==============================================================================
procedure Tstruct.addDelegate(memb: Tmember);
begin
//it would be odd if someone added much more than two delegates, so provisions to optimize this would be lame.
    delegateN:=delegateN+1;
    SetLength(delegates,delegateN);
    delegates[delegateN-1]:=memb;
end;

//==============================================================================
function Tstruct.getmember(const s:string; var res:Tmember):boolean;
var
   h:integer;
begin
    h:=membershash.valueof(s);
    if(h<0) then begin
        Result:=false;
    end else begin
       res:=members[h];
       Result:=true;
    end;
end;

//==============================================================================
procedure Tstruct.addchild(i:integer);
begin
    SetLength(children,nchildren+1);
    children[nchildren]:=i;
    nchildren:=nchildren+1;
end;

//==============================================================================
constructor Tstruct.create(libName:string;d:integer;int:boolean);
var
   m:tmember;
begin
    libraryName := libName;
    zincstruct:=false;
    parentname:='';
    bigArrayId:=-1; 
    isArrayStruct:=false;
    typeid:=1;
    FunctionInterfacePrototype:=-1;

    nchildren:=0;
    decl:=d;
    endline:=0;
    name:='????';
    isinterface:=int;
    gotstructchildren:=false;
    gotStubMethods:=false;
    lessthan:='';
    forInternalUse:=false;

    oninit:='';
    parent:=-1;
    parentstruct:=-1;
    membershash:=TStringHash.Create;
    membern:=0;
    ondestroy:=nil;
    SetLength(members,5);
    ondestroydone:=false;
    m:=addmember(-1,'allocate',0,true,true);
    m.construct:=true;
    m.access:=ACCESS_PRIVATE;
    m:=addmember(-1,'deallocate',0,false,true);
    m.access:=ACCESS_PRIVATE;
    m.destruct:=true;

    dofactory:=false;
    noargumentcreate:=false;
    customcreate:=false;

    addedArrayControl:=false;
    containsarraymembers:=false;

    customarray:=-1;
    customarraytype:='';

    delegateN:=0;

    requiredspace:=JASS_ARRAY_SIZE-1;
    maximum:=JASS_ARRAY_SIZE-1;
end;

//==============================================================================
function Tstruct.GetSuperParentName(StructList: array of Tstruct):string;
begin
    if(parent<>-1) then result:=StructList[parent].GetSuperParentName(StructList)
    else if(parentstruct<>-1) then result:=StructList[parentstruct].GetSuperParentName(StructList)
    else result:=name;

end;

//==============================================================================
function Tstruct.GetSuperParentNameForMethod(StructList: array of Tstruct; const methodname:string):string;
var memb:tmember;
begin
    self.getmember(methodname, memb);
    if(memb.fromparent) then begin
        if(parent<>-1) then result:=StructList[parent].GetSuperParentName(StructList)
        else if(parentstruct<>-1) then result:=StructList[parentstruct].GetSuperParentName(StructList);
    end else begin
        result:=name;
    end;

end;

//==============================================================================
procedure Tstruct.beforedestruction;
var
   i:integer;
begin
    membershash.destroy;
    for i := 0 to membern - 1 do members[i].free;
end;

//=========================================================================
procedure generateMultiArrayPickerBatch(const n:integer; namepref:array of string; namesuf:array of string; const indexspace:integer; const index:string; const indent:integer; commandprefix:array of string; commandsufix:array of string; var outs:string; const inioff:integer=0; const iniindex:integer = 1; const continueif:boolean = false);
 var indentstr,tmp,tsuf, tsub:string;
	 i,re,k,u:integer;
	 newini, newlim:integer;
begin
//        Writeln('Initial index '+IntToStr(indexspace));
//      if(indent > 40) then raise Exception.Create('OMG');

	SetLength(indentstr,indent); for i:=1 to indent do indentstr[i]:=' ';
	//WriteLn( indentstr + IntTostr(inioff)+' -> '+IntTostr(indexspace));
	re:=(indexSpace-inioff);
	if(re<=0) then raise Exception.Create('Internal error (re<=0) contact vexorian');

	u:=(indexSpace-inioff);
	if(u mod JASS_ARRAY_SIZE <> 0) then u:=u div JASS_ARRAY_SIZE+1
	else u:=u div JASS_ARRAY_SIZE;

	i:=0;
	while((re>=1) and ((i<JASS_ARRAYS_BEFORE_SPLIT) or ( (u-i) <=2 ) {or ((u-i) mod 2 <>0 )} ) ) do begin
		i:=i+1;
		if(indexSpace - iniOff > JASS_ARRAY_SIZE) or(continueif) then begin
			if(re<=JASS_ARRAY_SIZE) then begin
				SWriteLn(outs,indentstr+'else');
			end else begin
				if( i=1) and not(continueif) then tsuf := 'if('
				else tsuf:='elseif(';
				Concatenate6(tmp,indentstr,tsuf,index,'<',IntToStr(JASS_ARRAY_SIZE*i+inioff),') then');SWriteLn(outs,tmp);
			end;
		end;

		if(JASS_ARRAY_SIZE*(i-1)+inioff > 0) then
			tsub:='-'+IntToStr(JASS_ARRAY_SIZE*(i-1)+inioff)
		else
			tsub:='';

		for k := 0 to n-1 do begin
			if(i+iniindex-1=1) then
				tsuf:=namesuf[k]
			else
				tsuf:=IntToStr(i+iniindex-1)+namesuf[k];
			Concatenate10(tmp,indentstr,'    ',commandprefix[k],namepref[k],tsuf,'[',index,tsub,']',commandsufix[k]);SWriteLn(outs,tmp);
		end;
		re:=re-JASS_ARRAY_SIZE;
		if(re<0) then re:=0;
	end;
	//split
	if (re>=1) then begin
		if( i=0) and not (continueif) then tsuf := 'if('
		else          tsuf:='elseif(';

		Concatenate6(tmp,indentstr,tsuf,index,'<',IntToStr(JASS_ARRAY_SIZE*(i+(u-i) div 2)+inioff), ') then');
		SWriteLn(outs,tmp);
		//writeln(indentstr+'#'+IntTostr(i)+' of '+Inttostr(u) );
		newini := inioff + i*JASS_ARRAY_SIZE;
		newlim:= inioff + (i+ (u-i) div 2) * JASS_ARRAY_SIZE;
		generateMultiArrayPickerBatch(n,namepref,namesuf, newlim, index,indent+4,commandprefix,commandsufix,outs, newini, i+iniindex);

		//SWriteLn(outs,indentstr+'else');
		newini := newlim;
		newlim:= indexspace;
		generateMultiArrayPickerBatch(n,namepref,namesuf, newlim, index,indent,commandprefix,commandsufix,outs, newini, i+iniindex+(u-i) div 2 , true);

//            SWriteLn(outs,tmp);

	end;
	if(indexspace - inioff > JASS_ARRAY_SIZE) and not(continueif) then
		SWriteLn(outs,indentstr+'endif');
end;

//=========================================================================
var
   array_namepref,array_namesuf,array_commandprefix, array_commandsufix: array of string;
   generateMultiArrayPicker_doinit : boolean = true;

procedure generateMultiArrayPicker(const namepref:string; const namesuf:string; const indexspace:integer; const index:string; const indent:integer; const commandprefix:string; const commandsufix:string; var outs:string);
begin

	if(generateMultiArrayPicker_doinit) then begin
		generateMultiArrayPicker_doinit:=false;
		SetLength(array_namepref,1);
		SetLength(array_namesuf,1);
		SetLength(array_commandprefix,1);
		SetLength(array_commandsufix,1);
	end;
	array_namepref[0]:=namepref;
	array_namesuf[0]:=namesuf;
	array_commandprefix[0]:=commandprefix;
	array_commandsufix[0]:=commandsufix;
	generateMultiArrayPickerBatch(1,array_namepref,array_namesuf,indexspace,index,indent,array_commandprefix,array_commandsufix,outs);
end;


end.

