ShaderFile/uengShaderPartClass.pas

unit uengShaderPartClass;

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

interface

uses
  Classes, SysUtils,
  uengShaderPart, uengShaderGenerator, uengShaderGeneratorArgs, uengShaderFileParser

{$IFDEF USE_BITSPACE_UTILS}
  , uutlGenerics
{$ENDIF}
  ;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TengShaderPartClass = class;
  TengShaderPartClassList = specialize TutlSimpleList<TengShaderPartClass>;
  TengShaderPartClass = class(TengShaderGenerator)
  { Code Loading & Storage }
  private { member }
    fName: String;
    fExtends: TStringList;
    fInherited: TengShaderPartClassList;
  private { getter }
    function GetExtends: TStrings;
    procedure UpdateInherited;
  protected { virtual getter }
    function GetText: String; override;
    function ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String; override;
    procedure UpdateProperties; override;

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

  { General }
  public
    property Name:             String                  read fName;
    property Extends:          TStrings                read GetExtends;
    property InheritedClasses: TengShaderPartClassList read fInherited;

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

  { Class Methods }
  public
    class function GetTokenName: String; override;
    class procedure Validate(const aArgs: TengParseArgs; const aParent: TengShaderPart); override;
  end;
  TengShaderPartClassMap = specialize TutlMap<string, TengShaderPartClass>;

implementation

uses
  uengShaderFileConstants, uengShaderFileTypes, uengShaderFileHelper, uengShaderPartKeyValuePair,
  uengShaderPartScope, uengShaderFile, uengShaderPartProc;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengShaderPartClass///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartClass.GetExtends: TStrings;
begin
  result := fExtends;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderPartClass.UpdateInherited;

  procedure FilterResults(const aName: String; const aResults, aNewResults: TengShaderPartList);
  var
    p: TengShaderPart;
  begin
    aNewResults.Clear;
    for p in aResults do
      if ((p as TengShaderPartClass).Name = aName) then
        aNewResults.Add(p);
  end;

var
  sr, res: TengSearchResults;
  walker: TengSearchWalker;
  s: String;
begin
  if (fExtends.Count <= 0) then
    exit;
  sr := TengSearchResults.Create;
  res := TengSearchResults.Create;
  walker := TengSearchWalker.Create(sr);
  try
    walker.Owner              := self;
    walker.ResultTypes        := CengShaderPartArr.Create(TengShaderPartClass);
    walker.ChildrenDoNotLeave := CengShaderPartArr.Create(TengShaderPartScope);
    walker.ChildrenForceLeave := CengShaderPartArr.Create(TengShaderFile);
    walker.ParentsDoNotLeave  := CengShaderPartArr.Create(TengShaderFile);
    walker.SearchFlags := [
      sfIgnoreOwner,
      sfSearchChildrenLazy,
      sfSearchChildren,
      sfSearchParents
    ];
    fInherited.Clear;
    walker.Run(self);
    for s in fExtends do begin
      FilterResults(s, sr, res);
      fInherited.Add(ExtractSearchResult(self, s, res) as TengShaderPartClass);
    end;
  finally
    FreeAndNil(walker);
    FreeAndNil(res);
    FreeAndNil(sr);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartClass.GetText: String;
var
  s: String;
begin
  result := TOKEN_CHAR_BEGIN + GetTokenName + ' ' + fName;
  if (fExtends.Count > 0) then begin
    result := result + ' ' + TOKEN_EXTENDS;
    for s in fExtends do
      result := result + ' ' + s;
  end;
  result := result + TOKEN_CHAR_END +
    inherited GetText +
    TOKEN_CHAR_BEGIN + TOKEN_END + TOKEN_CHAR_END;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartClass.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);
  if (aParams.Count < 2) then
    raise EengInvalidParamterCount.Create(GetTokenName, 2, -1, self);
  with aParams[1] do begin
    if not IsValidIdentifier(Name) then
      raise EengInvalidIdentifier.Create(Name, self);
    fName := Name;
  end;
  if (aParams.Count > 2) then begin
    if (aParams.Count < 4) then
      raise EengInvalidParamterCount.Create(GetTokenName, 4, -1, self);
    if (aParams[2].Name <> TOKEN_EXTENDS) then with aParams[2] do
      raise EengInvalidParamter.Create(aParams[2].Name, TOKEN_EXTENDS, Line, Col, Filename, self);
    fExtends.Clear;
    for i := 3 to aParams.Count-1 do
      fExtends.Add(aParams[i].Name);
  end;
  UpdateInherited;
  result := inherited ParseIntern(aArgs, aParams);
  result := CheckEndToken(result, aArgs, self);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderPartClass.UpdateProperties;
var
  sr: TengSearchResults;
  walker: TengSearchWalker;
  p: TengShaderPart;
  c: TengShaderPartClass;
begin
  inherited UpdateProperties;

  for c in fInherited do
    c.CopyProperties(self);

  sr := TengSearchResults.Create;
  walker := TengSearchWalker.Create(sr);
  try
    walker.ResultTypes        := CengShaderPartArr.Create(TengShaderPartProperty);
    walker.ChildrenDoNotLeave := CengShaderPartArr.Create(TengShaderGenerator);
    walker.ChildrenForceLeave := CengShaderPartArr.Create(TengShaderFile);
    walker.Run(self);
    for p in sr.GetReverseEnumerator do
      AddProperty(p as TengShaderPartProperty);
  finally
    FreeAndNil(walker);
    FreeAndNil(sr);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderPartClass.GenerateCodeIntern(const aArgs: TengShaderGeneratorArgs);
var
  c: TengShaderPartClass;
  sr: TengSearchResults;
  walker: TengSearchWalker;
  main: TengShaderPartMain;
begin
  if (aArgs.Root <> self) then
    exit;
  for c in fInherited do
    c.GenerateCodeIntern(aArgs);
  inherited GenerateCodeIntern(aArgs);

  sr := TengSearchResults.Create;
  walker := TengSearchWalker.Create(sr);
  try
    walker.SearchFlags := [sfSearchChildren, sfEvaluateIf];
    walker.ResultTypes := CengShaderPartArr.Create(TengShaderPartMain);
    walker.Run(self);
    main := (ExtractSearchResult(self, TengShaderPartMain.GetTokenName, sr) as TengShaderPartMain);
    aArgs.PushFlags([gfGenerateProcedureCode]);
    try
      main.GenerateCodeIntern(aArgs);
    finally
      aArgs.PopFlags;
    end;
  finally
    FreeAndNil(walker);
    FreeAndNil(sr);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TengShaderPartClass.Create(const aParent: TengShaderPart);
begin
  inherited Create(aParent);
  fExtends := TStringList.Create;
  fInherited := TengShaderPartClassList.Create(false);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TengShaderPartClass.Destroy;
begin
  FreeAndNil(fInherited);
  FreeAndNil(fExtends);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TengShaderPartClass.GetTokenName: String;
begin
  result := TOKEN_CLASS;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TengShaderPartClass.Validate(const aArgs: TengParseArgs; const aParent: TengShaderPart);

  procedure RaiseEx(const aToken: String);
  begin
    with aArgs do
      raise EengShaderPart.Create('token ' + GetTokenName + ' is not allowed in ' + aToken, Line, Col, Filename, aParent);
  end;

begin
  inherited Validate(aArgs, aParent);
  if aParent.HasParent(TengShaderPartClass, true) then
    RaiseEx(TengShaderPartClass.GetTokenName);
end;

end.