//==============================================================================
//  Loading SLK Structs
//==============================================================================
unit StructsSLK;

//==============================================================================
//  INTERFACE
//==============================================================================
interface

var
    datafunctions: array of string;
    datafunctions_N:integer;
    datafunctions_Current:integer;

procedure DataFunctions_init;
procedure loadStructs(const s:string;sti:integer; linen:integer);
procedure WriteDataFunctions(var secondblock:string);

//==============================================================================
//  IMPLEMENTATION
//==============================================================================
implementation
uses Constants, Slk, TextOnly, TextCommon, Member, JStruct, JASSERException,
    vxFilesys, ImportPaths, JHInterface, SysUtils, Classes, Translate,
    StructVariables;                   

//==============================================================================
// Stuff for SLK loading splitting
//==============================================================================

//==============================================================================
procedure DataFunctions_init;
begin
   SetLength(datafunctions,3);
   datafunctions[0]:='';
   datafunctions_N:=0;
   datafunctions_Current:=0;
end;

//==============================================================================
procedure WriteDataFunctions(var secondblock:string);
var i : integer;
begin
    if(datafunctions_N>0) then begin
        for i := 0 to datafunctions_n-1 do begin

            swrite(secondblock,#13#10'function jasshelper__'+IntToStr(i)+'initdatastructs'+structmagic_time+' takes nothing returns nothing'#13#10);
            swrite(secondblock,' local integer s'#13#10);
            SWriteLn(secondblock,datafunctions[i]);
            SWriteLn(secondblock,'endfunction');
        end;
    end;
end;       

//==============================================================================
function DataFunctions_New: boolean; begin
   if(datafunctions_N=0) then begin
       datafunctions_N:=1;
       datafunctions_Current:=1;
       datafunctions[0]:='';
       Result:=true;
       exit;
   end;

   datafunctions_Current:=datafunctions_Current+1;
   Result:=(datafunctions_Current>SLK_LOADSTRUCTS_BATCHSIZE);
   if(Result) then begin
       if(Length(datafunctions)=datafunctions_N) then begin
           SetLength(Datafunctions, datafunctions_N+3+datafunctions_N div 6);
       end;
       datafunctions[datafunctions_N]:='';
       datafunctions_N:=datafunctions_N+1;
       datafunctions_Current:=1;
       Result:=true;
   end;

end;

//==============================================================================
procedure DataFunctions_Insert(const s:string); begin
   Swrite(Datafunctions[datafunctions_N-1],s);
end;

//==============================================================================
// The structs loader from slk!
//==============================================================================
procedure loadStructs(const s:string;sti:integer; linen:integer);


var a,b,Len,h,k:integer;
var quot,res:boolean;
var path,conc,val:string;
var slk:Tslk;

var structtype:string;
var memb:Tmember;
var struc:Tstruct;
var membtype:array of string;

    procedure readpath;
    begin
            Len:=Length(s);
            a:=sti;
            b:=a;
            while  ((a<=Len) and ((s[a]=' ') or (s[a]=#9))) do a:=a+1;

            if(a>Len) or (a=b) then raise JasserLineException(linen,'Incomplete loaddata command.');
            quot:=(s[a]='"');
            if quot then
                a:=a+1;

            path:='';

            while( (a<=Len) and ((not quot) or (s[a]<>'"') )) do begin
                if (a<Len) and (s[a]='\') and (s[a+1]='\') then begin
                    path:=path+'\';
                    a:=a+1;
                end else path:=path+s[a];
                a:=a+1;
            end;
    end;

    procedure fixInteger(var value:string);
      var isinteger:boolean;
      var i:integer;
    begin
        isinteger:=true;
        for i := 1 to Length(value) do begin
            isinteger:=isinteger and (value[i] in NUMBERS);
        end;
        if(isinteger) then exit;
        if((length(value)=4) or (length(value)=1)) then value:=''''+value+'''';

    end;
    procedure fixBoolean(var value:string);
    begin
        if(value='0') then value:='false'
        else if(value='1') then value:='true';


    end;

    procedure fixString(var value:string);
    begin
        if(Length(value)=0) then value:='""';
        if(value[Length(value)]<>'"') then value:=value+'"';
        if(value[1]<>'"') then value:='"'+value;

    end;

    function isDash(const value:string):boolean;
      var i,L:integer;
    begin
        L:=Length(value);
        i:=1;
        while (L>0) and (value[L]=' ') do L:=L-1;
        while (i<L) and (value[i]=' ') do i:=i+1;
        result := (i=L) and (L>0) and ((value[i]='-') or(value[i]='_')); 
    end;


begin

    slk:=nil;
 try
    readpath;
    if(path='') then raise JasserLineException(linen,'Incomplete loaddata command');
    if(not fetchpath(path)) then begin
        raise JasserLineException(linen,'Unable to find file: '+path);
    end;
    {path holds the file's path}

    //if( isslk(path) ) then begin

       slk:=Tslk.create;
       ProStatus('  SLK Loading : '+path);

       try
           res:=slk.LoadFromFile(path);
       except
          on e:exception do begin
              raise JasserLineDoubleException(linen,'Unable to open file: '+path, linen,'---'+e.Message+'');
          end;

       end;

       if not res then begin
           raise JasserLineDoubleException(linen,'Unable to load file: '+path,linen,'---(slk format error/ read error)');
       end;

       //file has been loaded!

       if(slk.LengthX<2) or (slk.LengthY<1) then begin
           raise JasserLineException(linen,'Too few cells in slk: '+path);
       end;

       //Writing the structs data, first of all, 0,0 is the structtype.

       structtype:=slk.contents[0][0];
       h:=Structhash.ValueOf(structtype);
       if(h=-1) then begin
           raise JASSerLineException(linen,'(row 1, column 1) Undeclared struct type: '+structtype);
       end;
       struc:=StructList[h];
       k:=struc.membershash.ValueOf('getFromKey');
       if (k=-1) then begin
           raise JASSerLineDoubleException(linen,'(row 1, column 1) Struct '+structtype+' does not have a getFromKey static method',struc.decl,'---- (struct declaration)' );
       end;

       memb:=struc.members[k];

       if( not(memb.ismethod) or not(memb.isstatic) ) then begin
           raise JASSerLineDoubleException(memb.decl,'getFromKey must be a static method',
                                           linen,    '---- (row 1, column 1) of SLK instanciates '+struc.name+')');
       end;
       if (memb.argnumber<>1) or (memb.returntype='nothing') then begin
           raise JASSerLineDoubleException(memb.decl,'getFromKey must take one argument and a return value',
                                           linen,    '---- (row 1, column 1) of SLK instanciates '+struc.name+')');
       end;


       SetLength(membtype,slk.LengthX);
       membtype[0]:=memb.argtypes[0];
       //verify the fields are ok: , and setup membtype
       for a := 1 to slk.LengthX-1 do begin
           if(slk.contents[a][0]<>'') then begin
               k:=struc.membershash.ValueOf(slk.contents[a][0]);
               if(k=-1) then begin
                   raise JasserLineDoubleException(linen     ,'(row 1, column '+IntToStr(a)+') '+slk.contents[a][0]+' is not a member of',
                                                   struc.decl,'--- '+struc.name+'');
               end;
               memb:=struc.members[k];
               if( memb.ismethod or memb.isstatic) then begin
                   raise JASSerLineDoubleException(memb.decl,slk.contents[a][0]+' is not an instance variable of '+structtype,
                                                  linen,    '---- (row 1, column '+IntToStr(a)+') of SLK uses '+struc.name+'.'+memb.name+')');
               end;
               membtype[a]:=memb.returntype;
           end;
       end;


       for a := 1 to slk.LengthY - 1 do begin
           if(DataFunctions_New() or (a=1)) then begin
              datafunctions_Insert(#13#10'//Loaded from: '+path+#13#10);
           end;


           val:=slk.contents[0][a];
           if(membtype[0]='integer') then fixInteger(val)
           else if(membtype[0]='boolean') then fixBoolean(val)
           else if(membtype[0]='string') then fixString(val);
           Concatenate5(conc,'    set s=s__',structtype,'_getFromKey(',val,')'#13#10);
           datafunctions_Insert(conc);
           for b := 1 to slk.LengthX - 1 do begin

               if(slk.contents[b][a]<>'') and not(isDash(slk.contents[b][a])) and (slk.contents[b][0]<>'') then begin

                    val:=slk.contents[b][a];
                    if(membtype[b]='integer') then fixInteger(val)
                    else if(membtype[b]='boolean') then fixBoolean(val)
                    else if(membtype[b]='string') then fixString(val);
                    Concatenate7(conc,'    set s__',structtype,'_',slk.contents[b][0],'[s]=',val,#13#10);
                    datafunctions_Insert(conc);
               end;
           end;

       end;

    //end;
    

 finally
     if(slk<>nil) then slk.Destroy;
 end;                 

end;



end.
