|
- 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.
|