unit ScopeStack;

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

//==============================================================================
//Not really an stack, it was going to be an stack but I found out I needed more
//options than push and pop.
//==============================================================================
type Tscopestack = class(TObject)
private
  ascope: array of string;
  adecl: array of integer;
  aprivpref:array of string;
  apblicpref:array of string;
  adescope: array of string;
  n:integer;
public
   constructor create;
   procedure push(const scope:string; const descope:string; const decl:integer; const privpref:string; const pblicpref:string);
   procedure top(var scope:string; var descope:string; var decl:integer; var privpref:string; var pblicpref:string);
   procedure pop;
   function empty:boolean;
   procedure makeprivate(d:integer;var s:string; id:integer);
   procedure makepublic(d:integer;var s:string; id:integer);
   function bottomline:integer;
   function GetScopeDecl(d:integer): string;
   function list(ignoretop:boolean=false ) :string;
   function GetScopeId(d:integer): integer;
   function MakePrefix(pri:boolean):string;
   function size:integer;
end;


//==============================================================================
//  IMPLEMENTATION
//==============================================================================
implementation
uses SysUtils, Constants;

//<TSCOPESTACK>
constructor TScopeStack.Create;
begin
    n:=0;
end;
procedure TScopeStack.push (const scope:string; const descope:string; const decl:integer; const privpref:string; const pblicpref:string);
begin
    n:=n+1;
    SetLength(ascope,n);
    SetLength(adescope,n);
    SetLength(adecl,n);
    SetLength(aprivpref,n);
    SetLength(apblicpref,n);
    ascope[n-1]:=scope;
    adescope[n-1]:=descope;
    adecl[n-1]:=decl;
    aprivpref[n-1]:=privpref;
    apblicpref[n-1]:=pblicpref;
end;
procedure TScopeStack.top(var scope:string;var descope:string; var decl:integer; var privpref:string; var pblicpref:string);
begin
   scope:=ascope[n-1];
   descope:=adescope[n-1];
   privpref:=aprivpref[n-1];
   pblicpref:=apblicpref[n-1];
   decl:=adecl[n-1];
end;
function TScopeStack.size:integer;
begin
   Result := n;
end;

procedure TScopeStack.pop;
begin
   n:=n-1;
end;
function TScopeStack.empty:boolean;
begin
    Result:=(n<=0);
end;
procedure TScopeStack.MakePrivate(d:integer;var s:string; id:integer);
begin
    if(d>=n) or (adecl[d]<>id) then Exit;        
    s:=aprivpref[d]+s;
end;

function TScopeStack.MakePrefix(pri:boolean):string;
begin
   if(pri) then result:='"'+aprivpref[n-1]+'"'
   else result:='"'+apblicpref[n-1]+'"';
end;


function TScopeStack.GetScopeDecl(d:integer): string;
begin
     if(d>=n) then begin
         Result:='';
     end else
         Result:=adescope[d];
end;
function TScopeStack.GetScopeId(d:integer): integer;
begin
     if(d>=n) then begin
         Result:=0;
     end else
         Result:=adecl[d];
end;

procedure TScopeStack.MakePublic(d:integer;var s:string; id:integer);
begin
    if(d>=n) or (adecl[d]<>id) then Exit;
    if (s='InitTrig') then begin
        // InitTrig shit is no longer supported
        s:=s+'_'+Copy(apblicpref[d],1,Length(apblicpref[d])-1);
        raise Exception.Create(s+CRLF
                              +'public InitTrig functions are no longer supported.'+CRLF
                              +'Change function name and use initializer command.');
    end else begin
        s:=apblicpref[d]+s;
    end;
end;

function TScopeStack.bottomline:integer;
begin
    Result:=adecl[0];
end;
function TScopeStack.list(ignoretop:boolean=false ):string;
var
   i:integer;
begin
    Result:=ascope[0];
    if(ignoretop) then
    for i := 1 to n - 2 do begin
        Result:=Result+', '+ascope[i];
    end
    else
    for i := 1 to n - 1 do begin
        Result:=Result+', '+ascope[i];
    end;

end;
//</TSCOPESTACK>

end.
