ShaderFile/uengShaderPartCall.pas

unit uengShaderPartCall;

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

interface

uses
  Classes, SysUtils,
  uengShaderPart, uengShaderCodePart, uengShaderFileParser, uengShaderGeneratorArgs, uengShaderPartClass,
  uengShaderPartProc, uengShaderPartKeyValuePair;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TengShaderPartCall = class(TengShaderCodePart)
  { Code Loading & Storage }
  private { member }
    fName: String;
    fParameters: TStringList;

    function FindKeyValuePair(const aName: String): TengShaderPartKeyValuePair;
  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 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)
  { Code Loading & Storage }
  private
    fInline: Boolean;
    fClass: TengShaderPartClass;
  protected
    function GetText: String; override;
    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
  uengShaderFileConstants, uengShaderFileTypes, uengShaderFileHelper, uengShaderGenerator,
  uengShaderFile, uengShaderPartScope;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengShaderPartCall////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartCall.FindKeyValuePair(const aName: String): TengShaderPartKeyValuePair;
var
  sr: TengSearchResults;
  walker: TengKeyValuePairSearchWalker;
begin
  sr := TengSearchResults.Create;
  walker := TengKeyValuePairSearchWalker.Create(sr);
  try
    walker.Name               := aName;
    walker.SearchFlags        := [sfSearchChildren, sfSearchParents];
    walker.ResultTypes        := CengShaderPartArr.Create(TengShaderPartProperty, TengShaderPartStatic);
    walker.ChildrenDoNotLeave := CengShaderPartArr.Create(TengShaderPartScope);
    walker.ChildrenForceLeave := CengShaderPartArr.Create(TengShaderFile);
    walker.ParentsDoNotLeave  := CengShaderPartArr.Create(TengShaderFile);
    walker.Run(fParent);
    result := (ExtractSearchResult(self, aName, sr) as TengShaderPartKeyValuePair);
  finally
    FreeAndNil(walker);
    FreeAndNil(sr);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartCall.GetText: String;
var
  i: Integer;
begin
  result := TOKEN_CHAR_BEGIN + GetTokenName + ' ' + fName;
  for i := 0 to fParameters.Count-1 do begin
    if Assigned(fParameters.Objects[i])
      then result := result + ' ' + TengShaderPartKeyValuePair(fParameters.Objects[i]).Name
      else result := result + ' ' + TOKEN_CHAR_QUOTE + fParameters[i] + TOKEN_CHAR_QUOTE;
  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);

  fParameters.Clear;

  result := '';
  fName := aParams[1].Name;
  if not IsValidIdentifier(fName) then
    raise EengInvalidIdentifier.Create(fName, aParams[1].Line, aParams[1].Col, Filename, self);

  for i := 2 to aParams.Count-1 do begin
    if not aParams[i].Quoted
      then fParameters.AddObject(aParams[i].Name, FindKeyValuePair(aParams[i].Name))
      else fParameters.AddObject(aParams[i].Name, nil);
  end;
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               := fName;
    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.GetText: String;
begin
  result := inherited GetText;
  if fInline then
    Insert(' ' + TOKEN_INLINE, result, Length(result) - 1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartInherited.ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String;

  function FindInheritedClass(const aName: string): TengShaderPartClass;
  var
    sr: TengSearchResults;
    walker: TengInheritedSearchWalker;
  begin
    sr := TengSearchResults.Create;
    walker := TengInheritedSearchWalker.Create((GetParent(TengShaderPartClass) as TengShaderPartClass), sr);
    try
      walker.Name := aName;
      walker.Run(walker.Owner);
      result := (ExtractSearchResult(self, aName, sr, [ifWarning]) as TengShaderPartClass);
    finally
      FreeAndNil(walker);
      FreeAndNil(sr);
    end;
  end;

type
  TExpectedPart = (epClass, epProc, epParam);
  TExpectedParts = set of TExpectedPart;

var
  i: Integer;
  expected: TExpectedParts;
begin
  if (aParams[0].Name <> GetTokenName) then with aParams[0] do
    raise EengInvalidToken.Create(ClassName, Name, Line, Col, Filename, self);

  fName    := '';
  result   := '';
  fClass   := nil;
  fInline  := false;
  expected := [epClass, epProc, epParam];
  fParameters.Clear;
  for i := 1 to aParams.Count-1 do begin

    // quoted parameter
    if aParams[i].Quoted then begin
      if not (epParam in expected) then
        raise EengUnexpectedToken.Create(aParams[i].Name, '[none]', aParams[i].Line, aParams[i].Col, Filename, self);
      fParameters.AddObject(aParams[i].Name, nil);
      expected := expected - [epClass, epProc];
      continue;
    end;

    // inline
    if (aParams[i].Name = TOKEN_INLINE) then begin
      fInline := true;
      continue;
    end;

    // class
    if (epClass in expected) then begin
      fClass := FindInheritedClass(aParams[i].Name);
      if Assigned(fClass) then begin
        expected := expected - [epClass];
        continue;
      end;
    end;

    // proc
    if (epProc in expected) then begin
      fName := aParams[i].Name;
      expected := expected - [epClass, epProc];
      continue;
    end;

    // unquoted param
    if (epParam in expected) then begin
      fParameters.AddObject(aParams[i].Name, FindKeyValuePair(aParams[i].Name));
      continue;
    end;

    raise EengUnexpectedToken.Create(aParams[i].Name, '[none]', aParams[i].Line, aParams[i].Col, Filename, self);
  end;
end;

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

  function FindProc: TengShaderPartProc;
  var
    sr: TengSearchResults;
    walker: TengProcSearchWalker;
    c: TengShaderPartClass;
  begin
    sr := TengSearchResults.Create;
    walker := TengProcSearchWalker.Create(sr);
    try
      walker.Name := fName;
      if (walker.Name = '') then
        walker.Name := (GetParent(TengShaderPartProc) as TengShaderPartProc).Name;
      walker.SearchFlags        := [sfEvaluateIf, sfSearchChildren, sfSearchInherited];
      walker.ParentsDoNotLeave  := CengShaderPartArr.Create(TengShaderPartClass);
      walker.ChildrenDoNotLeave := CengShaderPartArr.Create(TengShaderPartClass);
      if not Assigned(fClass) then begin
        for c in (GetParent(TengShaderPartClass) as TengShaderPartClass).InheritedClasses do
          walker.Run(c);
      end else
        walker.Run(fClass);
      result := (ExtractSearchResult(self, walker.Name, sr) as TengShaderPartProc);
    finally
      FreeAndNil(walker);
      FreeAndNil(sr);
    end;
  end;

  procedure GenCode(const aProc: TengShaderPartProc; const aParams: TStrings);
  begin
    if fInline
      then aArgs.PushFlags(aArgs.Flags + [gfGenerateInlineCode, gfGenerateProcedureCall] - [gfGenerateProcedureCode])
      else aArgs.PushFlags(aArgs.Flags + [gfGenerateProcedureCall] - [gfGenerateProcedureCode]);
    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);
    for i := 0 to fParameters.Count-1 do
      if Assigned(fParameters.Objects[i]) then
        fParameters[i] := TengShaderPartKeyValuePair(fParameters.Objects[i]).Value;
    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.