|
- unit uengShaderFileHelper;
-
- {$mode objfpc}{$H+}
- {$I uengShaderFile.inc}
-
- interface
-
- uses
- uengShaderPart, uengShaderFileParser, uengShaderPartClass;
-
- 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
- function Add(const aItem: TengShaderPart): Integer; reintroduce;
- 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;
-
- TengInheritedSearchWalker = class(TengSearchWalker)
- private
- fName: String;
- protected
- function Check(const aPart: TengShaderPart): Boolean; override;
- public
- property Name: String read fName write fName;
- constructor Create(const aClass: TengShaderPartClass; const aResults: TengSearchResults);
- 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;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- 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;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengSearchResults.Add(const aItem: TengShaderPart): Integer;
- var
- i: Integer;
- begin
- result := -1;
- for i := 0 to Count-1 do
- if (Items[i] = aItem) then
- exit;
- result := inherited Add(aItem);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengSearchResults/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengSearchResults.Create;
- begin
- inherited Create(false);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengSearchWalker//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengSearchWalker.Visit(const aPart, aSender: TengShaderPart; const aArgs: Pointer);
-
- function VisitChild(const aItem: TengShaderPart): Boolean;
- var
- c: CengShaderPart;
- begin
- result := 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 := 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;
- args: TArgs;
- nextArgs: TArgs;
- begin
- if not Assigned(aPart) then
- exit;
- if Assigned(aArgs) then
- args := PArgs(aArgs)^
- else
- args.Flags := fSearchFlags;
-
- // calculate args for next iteration
- nextArgs := args;
- if (sfSearchChildrenLazy in nextArgs.Flags) then
- nextArgs.Flags := nextArgs.Flags + [sfSearchChildren] - [sfSearchChildrenLazy];
-
- // sfSearchParents
- if (sfSearchParents in args.Flags) then begin
- if Check(aPart.Parent) then
- fResults.Add(aPart.Parent);
- if VisitParent then
- Visit(aPart.Parent, aPart, @nextArgs);
- end;
-
- // sfSearchInherited
- if (sfSearchInherited in args.Flags) and (aPart is TengShaderPartClass) then begin
- for c in (aPart as TengShaderPartClass).InheritedClasses do begin
- if Check(c) then
- fResults.Add(c);
- Visit(c, aPart, @nextArgs);
- end;
- end;
-
- // sfSearchChildren
- if (sfSearchChildren in args.Flags) then begin
- // sfEvaluateIf, sfIgnoreIf
- 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;
-
- // normal children
- 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;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengInheritedSearchWalker/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengInheritedSearchWalker.Check(const aPart: TengShaderPart): Boolean;
- begin
- result :=
- inherited Check(aPart) and
- (aPart is TengShaderPartClass) and
- ((aPart as TengShaderPartClass).Name = fName);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengInheritedSearchWalker.Create(const aClass: TengShaderPartClass; const aResults: TengSearchResults);
- begin
- inherited Create(aResults);
- ResultTypes := CengShaderPartArr.Create(TengShaderPartClass);
- SearchFlags := [sfSearchInherited, sfIgnoreOwner];
- Owner := aClass;
- 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.
|