ShaderFile/uengShaderPartCall.pas

unit uengShaderPartCall;

{$mode objfpc}{$H+}
{$I uengShaderFile.inc}

interface

uses
  Classes, SysUtils,
  uengShaderPart, uengShaderCodePart, uengShaderFileParser, uengShaderGeneratorArgs;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TengShaderPartCall = class(TengShaderCodePart)
  { Code Loading & Storage }
  private { member }
    fName: String;
    fParameters: TStringList;
  protected { virtual getter }
    function GetText: String; override;
    function ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String; override;

  { Code Generation }
  public
    procedure GenerateCodeIntern(const aArgs: TengShaderGeneratorArgs); override;

  { General }
  private
    function GetParameters: TStrings;
  public
    property Name:       String   read fName;
    property Parameters: TStrings read GetParameters;

    constructor Create(const aParent: TengShaderPart); override;
    destructor Destroy; override;

  { Class Methods }
  public
    class function GetTokenName: String; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TengShaderPartInherited = class(TengShaderPartCall)
  { Class Methods }
  protected
    function ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String; override;

  { Code Generation }
  public
    procedure GenerateCodeIntern(const aArgs: TengShaderGeneratorArgs); override;

  { Class Methods }
  public
    class function GetTokenName: String; override;
    class procedure Validate(const aArgs: TengParseArgs; const aParent: TengShaderPart); override;
  end;

implementation

uses
  uengShaderPartProc, uengShaderPartClass, uengShaderFileConstants, uengShaderFileTypes,
  uengShaderFileHelper, uengShaderGenerator, uengShaderFile;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengShaderPartCall////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartCall.GetText: String;
var
  i: Integer;
begin
  result := TOKEN_CHAR_BEGIN + GetTokenName;
  if (fName <> '') then
    result := result + ' ' + fName;
  for i := 0 to fParameters.Count-1 do begin
    if (PtrInt(fParameters.Objects[i]) <> 0)
      then result := result + ' ' + TOKEN_CHAR_QUOTE + fParameters[i] + TOKEN_CHAR_QUOTE
      else result := result + ' ' + fParameters[i];
  end;
  result := result + TOKEN_CHAR_END;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartCall.ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String;
var
  i: Integer;
begin
  if (aParams[0].Name <> GetTokenName) then
    raise EengInvalidToken.Create(ClassName, aParams[0].Name, Line, Col, Filename, self);
  if (aParams.Count < 2) then
    raise EengInvalidParamterCount.Create(GetTokenName, 2, -1, self);

  result := '';
  fParameters.Clear;
  with aParams[1] do begin
    if not IsValidIdentifier(fName) then
      raise EengInvalidIdentifier.Create(Name, self);
    fName := Name;
  end;
  for i := 2 to aParams.Count-1 do
    fParameters.AddObject(aParams[i].Name, TObject(PtrInt(aParams[i].Quoted)));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderPartCall.GenerateCodeIntern(const aArgs: TengShaderGeneratorArgs);
var
  sr: TengSearchResults;
  walker: TengProcSearchWalker;
  proc: TengShaderPartProc;
begin
  inherited GenerateCodeIntern(aArgs);
  sr := TengSearchResults.Create;
  walker := TengProcSearchWalker.Create(sr);
  try
    walker.Name               := Name;
    walker.SearchFlags        := [sfEvaluateIf, sfSearchChildren, sfSearchInherited];
    walker.ChildrenDoNotLeave := CengShaderPartArr.Create(TengShaderGenerator);
    walker.ChildrenForceLeave := CengShaderPartArr.Create(TengShaderFile);
    walker.Run(aArgs.Root);
    proc := (ExtractSearchResult(self, walker.Name, sr) as TengShaderPartProc);

    aArgs.PushProcParams(fParameters);
    aArgs.PushFlags(aArgs.Flags - [gfGenerateProcedureCode, gfGenerateInlineCode] + [gfGenerateProcedureCall]);
    try
      proc.GenerateCodeIntern(aArgs);
    finally
      aArgs.PopFlags;
      aArgs.PopProcParams;
    end;
  finally
    FreeAndNil(walker);
    FreeAndNil(sr);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartCall.GetParameters: TStrings;
begin
  result := fParameters;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TengShaderPartCall.Create(const aParent: TengShaderPart);
begin
  inherited Create(aParent);
  fParameters := TStringList.Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TengShaderPartCall.Destroy;
begin
  FreeAndNil(fParameters);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TengShaderPartCall.GetTokenName: String;
begin
  result := TOKEN_CALL;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengShaderPartInherited///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartInherited.ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String;
var
  i: Integer;
begin
  if (aParams[0].Name <> GetTokenName) then with aParams[0] do
    raise EengInvalidToken.Create(ClassName, Name, Line, Col, Filename, self);

  fName := '';
  fParameters.Clear;
  if (aParams.Count >= 2) then begin
    if not IsValidIdentifier(aParams[1].Name) and (aParams[1].Name <> TOKEN_MAIN) then
      with aParams[1] do
        raise EengInvalidIdentifier.Create(Name, Line, Col, Filename, self);
    fName := aParams[1].Name;
    for i := 2 to aParams.Count-1 do
      fParameters.AddObject(aParams[i].Name, TObject(PtrInt(aParams[i].Quoted)));
  end;
  result := '';
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderPartInherited.GenerateCodeIntern(const aArgs: TengShaderGeneratorArgs);

  function FindProc: TengShaderPartProc;
  var
    sr: TengSearchResults;
    walker: TengProcSearchWalker;
    ParentProc: TengShaderPartProc;
  begin
    sr := TengSearchResults.Create;
    walker := TengProcSearchWalker.Create(sr);
    try
      ParentProc := (GetParent(TengShaderPartProc) as TengShaderPartProc);
      walker.Name := Name;
      if (walker.Name = '') then
        walker.Name := ParentProc.Name;
      walker.Owner              := ParentProc;
      walker.SearchFlags        := [sfEvaluateIf, sfIgnoreOwner, sfSearchChildrenLazy, sfSearchInherited];
      walker.ParentsDoNotLeave  := CengShaderPartArr.Create(TengShaderPartClass);
      walker.ChildrenDoNotLeave := CengShaderPartArr.Create(TengShaderPartClass);
      walker.Run(ParentProc);
      result := (ExtractSearchResult(self, walker.Name, sr) as TengShaderPartProc);
    finally
      FreeAndNil(walker);
      FreeAndNil(sr);
    end;
  end;

  procedure GenCode(const aProc: TengShaderPartProc; const aParams: TStrings);
  begin
    aArgs.PushFlags(aArgs.Flags + [gfGenerateInlineCode]);
    aArgs.PushProcParams(aParams);
    try
      aProc.GenerateCodeIntern(aArgs);
    finally
      aArgs.PopProcParams;
      aArgs.PopFlags;
    end;
  end;

var
  proc: TengShaderPartProc;
  i: Integer;
  params: TStringList;
begin
  aArgs.AddToken(GetTokenName);
  proc := FindProc;
  if (fParameters.Count > 0) then begin
    if (fParameters.Count <> proc.ParameterCount) then
      raise EengInvalidParamterCount.Create(proc.name + ' expexts ' + IntToStr(proc.ParameterCount) + ' parameters', self);
    GenCode(proc, fParameters);
  end else begin
    params := TStringList.Create;
    try
      for i := 0 to proc.ParameterCount-1 do
        params.Add(proc.Parameters[i].Name);
      GenCode(proc, params);
    finally
      FreeAndNil(params);
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TengShaderPartInherited.GetTokenName: String;
begin
  result := TOKEN_INHERITED;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TengShaderPartInherited.Validate(const aArgs: TengParseArgs; const aParent: TengShaderPart);
begin
  inherited Validate(aArgs, aParent);
  if not aParent.HasParent(TengShaderPartProc, true) or
     not aParent.HasParent(TengShaderPartClass, true) then
       raise EengShaderPart.Create(GetTokenName + ' is not allowed outside of ' +
        TOKEN_PROC + ', ' + TOKEN_FUNC + ', ' + TOKEN_MAIN + ' or ' + TOKEN_CLASS);
end;

end.