ShaderFile/uengShaderFileHelper.pas

unit uengShaderFileHelper;

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

interface

uses
  uengShaderPart, uengShaderFileParser;

type
  TInfoFlag = (
    ifWarning,
    ifRaiseEx
  );
  TInfoFlags = set of TInfoFlag;

function IsValidIdentifier(const aIdent: String): Boolean;
function CheckEndToken(const aToken: String; const aArgs: TengParseArgs; const aShaderPart: TengShaderPart): String;
function CheckType(const aShaderPart: TengShaderPart; const aTypes: array of CengShaderPart): Boolean;
function ExtractSearchResult(
  const aSender: TengShaderPart;
  const aIdent: String;
  const aList: TengShaderPartList;
  const aFlags: TInfoFlags = [ifWarning, ifRaiseEx];
  aLine: Integer = -1;
  aCol: Integer = -1;
  aFilename: String = ''): TengShaderPart;

type
  TengSearchFlag = (
    sfSearchChildren,         // search in children
    sfEvaluateIf,             // evaluate if and search in suitable subtree
    sfIgnoreIf,               // do not search in if items
    sfSearchChildrenLazy,     // set sfSearchChildren in next recursion level
    sfSearchParents,          // search in Parents
    sfSearchInherited,        // search in inherited classes
    sfIgnoreOwner             // ignore owner of search walker
  );
  TengSearchFlags = set of TengSearchFlag;

  TengSearchResults = class(TengShaderPartList)
  public
    constructor Create;
  end;

  TengSearchWalker = class(TengShaderPartWalker)
  private type
    TArgs = packed record
      Flags: TengSearchFlags;
    end;
    PArgs = ^TArgs;
  private
    fOwner: TengShaderPart;
    fResults: TengSearchResults;
    fSearchFlags: TengSearchFlags;
    fResultTypes: CengShaderPartArr;
    fChildrenDoNotLeave: CengShaderPartArr;
    fParentsDoNotLeave:  CengShaderPartArr;
    fChildrenForceLeave: CengShaderPartArr;
    fParentsForceLeave:  CengShaderPartArr;
  protected
    procedure Visit(const aPart, aSender: TengShaderPart; const aArgs: Pointer); override;
    function Check(const aPart: TengShaderPart): Boolean; virtual;
  public
    property Owner:              TengShaderPart    read fOwner              write fOwner;
    property SearchFlags:        TengSearchFlags   read fSearchFlags        write fSearchFlags;
    property ResultTypes:        CengShaderPartArr read fResultTypes        write fResultTypes;
    property ChildrenDoNotLeave: CengShaderPartArr read fChildrenDoNotLeave write fChildrenDoNotLeave;
    property ParentsDoNotLeave:  CengShaderPartArr read fParentsDoNotLeave  write fParentsDoNotLeave;
    property ChildrenForceLeave: CengShaderPartArr read fChildrenForceLeave write fChildrenForceLeave;
    property ParentsForceLeave:  CengShaderPartArr read fParentsForceLeave  write fParentsForceLeave;

    constructor Create(const aResults: TengSearchResults);
  end;

  TengKeyValuePairSearchWalker = class(TengSearchWalker)
  private
    fName: String;
  protected
    function Check(const aPart: TengShaderPart): Boolean; override;
  public
    property Name: String read fName write fName;
  end;

  TengProcSearchWalker = class(TengSearchWalker)
  private
    fName: String;
  protected
    function Check(const aPart: TengShaderPart): Boolean; override;
  public
    property Name: String read fName write fName;
    constructor Create(const aResults: TengSearchResults);
  end;

implementation

uses
  sysutils,
  uengShaderFileConstants, uengShaderFileTypes, uengShaderPartKeyValuePair, uengShaderPartProc,
  uengShaderPartIf, uengShaderPartClass;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function IsValidIdentifier(const aIdent: String): Boolean;
var
  i, len: Integer;
begin
  len := Length(aIdent);
  result := false;
  for i := 1 to len do
    if not (aIdent[i] in VALID_IDENT_CHARS) then
      exit;
  result := true;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function CheckEndToken(const aToken: String; const aArgs: TengParseArgs; const aShaderPart: TengShaderPart): String;
var
  oldLine, oldCol: Integer;
  param: TengTokenParameterList;
begin
  oldLine := aArgs.Line;
  oldCol  := aArgs.Col;
  if (aToken <> TOKEN_END) then
    raise EengUnexpectedToken.Create(aToken, TOKEN_END, oldLine, oldCol, aShaderPart.Filename, aShaderPart);
  param := TengTokenParameterList.Create('');
  try
    if not aArgs.ExtractToken(aShaderPart, param) then
      EengUnexpectedToken.Create(TOKEN_NONE, TOKEN_END, oldLine, oldCol, aShaderPart.Filename, aShaderPart);
    if (param[0].Name <> TOKEN_END) then
      EengUnexpectedToken.Create(param[0].Name, TOKEN_END, oldLine, oldCol, aShaderPart.Filename, aShaderPart);
    if (param.Count <> 1) then
      EengInvalidParamterCount.Create(TOKEN_END, 1, oldLine, oldCol, aShaderPart.Filename, aShaderPart);
    result := '';
  finally
    FreeAndNil(param);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function CheckType(const aShaderPart: TengShaderPart; const aTypes: array of CengShaderPart): Boolean;
var
  t: CengShaderPart;
begin
  result := true;
  for t in aTypes do
    if (aShaderPart is t) then
      exit;
  result := (Length(aTypes) = 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ExtractSearchResult(const aSender: TengShaderPart; const aIdent: String; const aList: TengShaderPartList;
  const aFlags: TInfoFlags; aLine: Integer; aCol: Integer; aFilename: String): TengShaderPart;
var
  s: String;
  i: Integer;
begin
  result := nil;
  if Assigned(aSender) then begin
    if (aLine < 0) then
      aLine := aSender.Line;
    if (aCol < 0) then
      aCol := aSender.Col;
    if (aFilename = '') then
      aFilename := aSender.Filename;
  end;
  if (aList.Count <= 0) then begin
    if (ifRaiseEx in aFlags) then
      raise EengUnknownIdentifier.Create(aIdent, aLine, aCol, aFilename, aSender);
    exit;
  end;
  result := aList[aList.Count-1];
  if (aList.Count > 1) and Assigned(aSender) and (ifWarning in aFlags) then begin
    s := Format('use of duplicate identifier: %s (%s %d:%d)', [aIdent, result.Filename, result.Line + 1, result.Col]) + sLineBreak +
         'previously declared here:' + sLineBreak;
    i := aList.Count - 2;
    while (i >= 0) do begin
      s := s + Format('  %s %d:%d', [aList[i].Filename, aList[i].Line + 1, aList[i].Col]) + sLineBreak;
      dec(i);
    end;
    aSender.LogMsg(llWarning, s);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengSearchResults/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TengSearchResults.Create;
begin
  inherited Create(false);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengSearchWalker//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengSearchWalker.Visit(const aPart, aSender: TengShaderPart; const aArgs: Pointer);
var
  args: TArgs;

  function VisitChild(const aItem: TengShaderPart): Boolean;
  var
    c: CengShaderPart;
  begin
    result := (sfSearchChildren in args.Flags) and Assigned(aItem) and (aItem <> aSender);
    if not result then
      exit;
    for c in fChildrenDoNotLeave do
      if (aItem is c) then
        result := false;
    for c in fChildrenForceLeave do
      if (aItem is c) then
        result := true;
  end;

  function VisitParent: Boolean;
  var
    c: CengShaderPart;
  begin
    result := (sfSearchParents in args.Flags) and Assigned(aPart.Parent) and (aPart.Parent <> aSender);
    if not result then
      exit;
    for c in fParentsDoNotLeave do
      if (aPart is c) then
        result := false;
    for c in fParentsForceLeave do
      if (aPart is c) then
        result := true;
  end;

var
  p: TengShaderPart;
  c: TengShaderPartClass;
  nextArgs: TArgs;
begin
  if not Assigned(aPart) then
    exit;
  if Assigned(aArgs) then
    args := PArgs(aArgs)^
  else
    args.Flags := fSearchFlags;

  // visit parent
  nextArgs := args;
  if (sfSearchChildrenLazy in nextArgs.Flags) then
    nextArgs.Flags := nextArgs.Flags + [sfSearchChildren] - [sfSearchChildrenLazy];
  if Check(aPart.Parent) then
    fResults.Add(aPart.Parent);
  if VisitParent then
    Visit(aPart.Parent, aPart, @nextArgs);

  // visit inherited
  if (sfSearchInherited in args.Flags) and (aPart is TengShaderPartClass) then begin
    for c in (aPart as TengShaderPartClass).InheritedClasses do
      Visit(c, aPart, @nextArgs);
  end;

  // visit children
  if (sfSearchChildren in args.Flags) then begin
    if (aPart is TengShaderPartIf) then with (aPart as TengShaderPartIf) do begin
      if (sfEvaluateIf in args.Flags) then begin
        if Expression.GetValue
          then p := IfPart
          else p := ElsePart;
        if Assigned(p) then
          Visit(p, aPart, @nextArgs);
        exit;
      end else if (sfIgnoreIf in args.Flags) then
        exit;
    end;

    for p in aPart do begin
      if Check(p) then
        fResults.Add(p);
      if VisitChild(p) then
        Visit(p, aPart, @nextArgs);
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengSearchWalker.Check(const aPart: TengShaderPart): Boolean;
var
  c: CengShaderPart;
begin
  result := (aPart <> fOwner) or not (sfIgnoreOwner in fSearchFlags);
  if result then
    for c in fResultTypes do
      if (aPart is c) then
        exit;
  result := false;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TengSearchWalker.Create(const aResults: TengSearchResults);
begin
  inherited Create;
  fResults := aResults;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengKeyValuePairSearchWalker//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengKeyValuePairSearchWalker.Check(const aPart: TengShaderPart): Boolean;
begin
  result :=
    inherited Check(aPart) and
    (aPart is TengShaderPartKeyValuePair) and
    ((aPart as TengShaderPartKeyValuePair).Name = fName);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengProcSearchWalker//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengProcSearchWalker.Check(const aPart: TengShaderPart): Boolean;
begin
  result :=
    inherited Check(aPart) and
    (aPart is TengShaderPartProc) and
    ((aPart as TengShaderPartProc).Name = fName);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TengProcSearchWalker.Create(const aResults: TengSearchResults);
begin
  inherited Create(aResults);
  ResultTypes := CengShaderPartArr.Create(TengShaderPartProc);
end;

end.