|
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433 |
- unit uengShaderPartProc;
-
- {$mode objfpc}{$H+}
- {$I uengShaderFile.inc}
-
- interface
-
- uses
- Classes, SysUtils,
- uengShaderPart, uengShaderPartScope, uengShaderFileParser, uengShaderGeneratorArgs
-
- {$IFDEF SHADER_FILE_USE_BITSPACE_UTILS}
- , uutlGenerics;
- {$ELSE}
- , fgl;
- {$ENDIF}
-
- type
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartProcParam = packed record
- Typ: String;
- Name: String;
- end;
- TengShaderPartProcParamList = specialize TutlSimpleList<TengShaderPartProcParam>;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartProc = class(TengShaderPartScope)
- { Code Loading & Storage }
- private
- fName: String;
- fIsInline: Boolean;
- fParameters: TengShaderPartProcParamList;
- function GetParameter(const aIndex: Integer): TengShaderPartProcParam;
- function GetParameterCount: Integer;
- protected
- function GetHeaderText: String; virtual;
- function GetText: String; override;
- function ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String; override;
-
- { Code Generation }
- protected
- function GenerateHeaderCode(const aArgs: TengShaderGeneratorArgs): String; virtual;
- procedure GenerateInlineCode(const aArgs: TengShaderGeneratorArgs); virtual;
- public
- procedure GenerateCodeIntern(const aArgs: TengShaderGeneratorArgs); override;
-
- { General }
- public
- property Name: String read fName;
- property IsInline: Boolean read fIsInline;
- property ParameterCount: Integer read GetParameterCount;
- property Parameters[const aIndex: Integer]: TengShaderPartProcParam read GetParameter;
-
- constructor Create(const aParent: TengShaderPart); override;
- destructor Destroy; override;
-
- { Class Members }
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartMain = class(TengShaderPartProc)
- { Code Loading & Storage }
- protected
- function GetHeaderText: String; override;
- function ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String; override;
-
- { Code Generation }
- protected
- function GenerateHeaderCode(const aArgs: TengShaderGeneratorArgs): String; override;
-
- { General }
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartFunc = class(TengShaderPartProc)
- { Code Loading & Storage }
- private
- fReturnType: String;
- protected
- function GetHeaderText: String; override;
- function ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String; override;
-
- { Code Generation }
- protected
- function GenerateHeaderCode(const aArgs: TengShaderGeneratorArgs): String; override;
- procedure GenerateInlineCode(const aArgs: TengShaderGeneratorArgs); override;
-
- { Class Methods }
- public
- class function GetTokenName: String; override;
- end;
-
- implementation
-
- uses
- RegExpr,
- uengShaderFileConstants, uengShaderFileTypes, uengShaderFileHelper, uengShaderPartClass;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartProc////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartProc.GetParameter(const aIndex: Integer): TengShaderPartProcParam;
- begin
- result := fParameters[aIndex];
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartProc.GetParameterCount: Integer;
- begin
- result := fParameters.Count;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartProc.GetHeaderText: String;
- var
- p: TengShaderPartProcParam;
- begin
- result := TOKEN_CHAR_BEGIN + GetTokenName + ' ' + TOKEN_CHAR_QUOTE + fName + TOKEN_CHAR_QUOTE;
- for p in fParameters do begin
- result := result + ' ' + TOKEN_CHAR_QUOTE + p.Typ + TOKEN_CHAR_QUOTE +
- ' ' + TOKEN_CHAR_QUOTE + p.Name + TOKEN_CHAR_QUOTE;
- end;
- result := result + TOKEN_CHAR_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartProc.GetText: String;
- begin
- result := GetHeaderText +
- inherited GetText +
- TOKEN_CHAR_BEGIN + TOKEN_END + TOKEN_CHAR_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartProc.ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String;
- type
- TParseArgsState = (pasType, pasName);
- var
- i: Integer;
- state: TParseArgsState;
- param: TengShaderPartProcParam;
- 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);
-
- i := 2;
- result := '';
- fName := aParams[1].Name;
- state := pasType;
- fParameters.Clear;
- while (i < aParams.Count) do begin
- case state of
- pasType: begin
- if (aParams[i].Name <> TOKEN_INLINE) then begin
- param.Typ := aParams[i].Name;
- state := pasName;
- end else
- fIsInline := true;
- end;
-
- pasName: begin
- if (aParams[i].Name = TOKEN_INLINE) then begin
- with aParams[i] do
- raise EengInvalidParamter.Create('expected parameter name (found ' + TOKEN_INLINE + ')', Line, Col, Filename, self);
- end else begin
- param.Name := aParams[i].Name;
- fParameters.Add(param);
- state := pasType;
- end;
- end;
- end;
- inc(i);
- end;
- if (state <> pasType) then
- raise EengInvalidParamterCount.Create('invalid parameter count in ' + GetTokenName + '(expected multiple of 2)', self);
- result := inherited ParseIntern(aArgs, aParams);
- result := CheckEndToken(result, aArgs, self);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartProc.GenerateHeaderCode(const aArgs: TengShaderGeneratorArgs): String;
- var
- p: TengShaderPartProcParam;
- c: TengShaderPartClass;
- begin
- result := '';
- for p in fParameters do begin
- if (result <> '') then
- result := result + ', ';
- result := result + p.Typ + ' ' + p.Name;
- end;
- if (result = '') then
- result := 'void';
- if GetParent(TengShaderPartClass, c)
- then result := 'void ' + c.Name + '_' + fName + '(' + result + ')'
- else result := 'void ' + fName + '(' + result + ')';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartProc.GenerateInlineCode(const aArgs: TengShaderGeneratorArgs);
- var
- p: TengShaderPartProcParam;
- old, new: TStringList;
- rx: TRegExpr;
- s: String;
- begin
- aArgs.PushCode;
- rx := TRegExpr.Create;
- old := TStringList.Create;
- new := TStringList.Create;
- try
- inherited GenerateCodeIntern(aArgs);
-
- // prepare old parameters
- for p in fParameters do
- old.Add(p.Name);
-
- // prepate new paramaters
- rx.Expression := '[^A-z0-9_]+';
- for s in aArgs.ProcParams do begin
- if rx.Exec(s)
- then new.Add('(' + s + ')')
- else new.Add(s);
- end;
-
- // replace parameters
- aArgs.ReplaceIdents(old, new);
- finally
- FreeAndNil(rx);
- FreeAndNil(old);
- FreeAndNil(new);
- aArgs.PopCode([pcfAppend]);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartProc.GenerateCodeIntern(const aArgs: TengShaderGeneratorArgs);
- var
- s, params: String;
- c: TengShaderPartClass;
- begin
- // generate inline code
- if (aArgs.Flags * [gfGenerateProcedureCall, gfGenerateProcedureCode] <> []) and
- ((gfGenerateInlineCode in aArgs.Flags) or fIsInline) then
- begin
- GenerateInlineCode(aArgs);
- if (GetTokenName = TOKEN_PROC) then
- aArgs.IgnoreNextCommandEnd;
-
- // generate code
- end else if (gfGenerateProcedureCode in aArgs.Flags) then begin
- aArgs
- .AddLineBreak
- .AddText(GenerateHeaderCode(aArgs))
- .AddLineBreak
- .AddCommandEnd('{')
- .AddLineBreak
- .BeginBlock(4);
- try
- inherited GenerateCodeIntern(aArgs);
- finally
- aArgs
- .EndBlock
- .AddCommandEnd('}')
- .AddLineBreak;
- end;
-
- // generate call
- end else if (gfGenerateProcedureCall in aArgs.Flags) then begin
- params := '';
- for s in aArgs.ProcParams do begin
- if (params <> '') then
- params := params + ', ';
- params := params + s;
- end;
- if GetParent(TengShaderPartClass, c)
- then aArgs.AddText(c.Name + '_' + fName + '(' + params + ')')
- else aArgs.AddText(fName + '(' + params + ')');
- aArgs.AddProcedure(self);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengShaderPartProc.Create(const aParent: TengShaderPart);
- begin
- inherited Create(aParent);
- fParameters := TengShaderPartProcParamList.Create(true);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengShaderPartProc.Destroy;
- begin
- FreeAndNil(fParameters);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartProc.GetTokenName: String;
- begin
- result := TOKEN_PROC;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartMain////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartMain.GetHeaderText: String;
- begin
- result := TOKEN_CHAR_BEGIN + GetTokenName + TOKEN_CHAR_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartMain.ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String;
- var
- p: TengTokenParameter;
- begin
- if (aParams[0].Name <> GetTokenName) then with aParams[0] do
- raise EengInvalidToken.Create(ClassName, Name, Line, Col, Filename, self);
- if (aParams.Count <> 1) then
- raise EengInvalidParamterCount.Create(GetTokenName, 1, self);
-
- result := '';
- p.Name := 'main';
- p.Quoted := false;
- p.Line := Line;
- p.Col := Col + Length(GetTokenName);
- aParams.Add(p);
- inherited ParseIntern(aArgs, aParams);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartMain.GenerateHeaderCode(const aArgs: TengShaderGeneratorArgs): String;
- var
- c: TengShaderPartClass;
- begin
- if not (gfGenerateProcedureMain in aArgs.Flags) and GetParent(TengShaderPartClass, c)
- then result := 'void ' + c.Name + '_main(void)'
- else result := 'void main(void)';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartMain.GetTokenName: String;
- begin
- result := TOKEN_MAIN;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartFunc////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartFunc.GetHeaderText: String;
- var
- p: TengShaderPartProcParam;
- begin
- result := TOKEN_CHAR_BEGIN + GetTokenName + ' ' +
- TOKEN_CHAR_QUOTE + fReturnType + TOKEN_CHAR_QUOTE + ' ' +
- TOKEN_CHAR_QUOTE + fName + TOKEN_CHAR_QUOTE;
- for p in fParameters do
- result := result + ' ' + TOKEN_CHAR_QUOTE + p.Typ + TOKEN_CHAR_QUOTE
- + ' ' + TOKEN_CHAR_QUOTE + p.Name + TOKEN_CHAR_QUOTE;
- result := result + TOKEN_CHAR_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartFunc.ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String;
- begin
- if (aParams[0].Name <> GetTokenName) then with aParams[0] do
- raise EengInvalidToken.Create(ClassName, aParams[0].Name, Line, Col, Filename, self);
- if (aParams.Count < 3) then
- raise EengInvalidParamterCount.Create(GetTokenName, 3, self);
-
- fReturnType := aParams[1].Name;
- aParams.Delete(1);
- result := inherited ParseIntern(aArgs, aParams);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartFunc.GenerateHeaderCode(const aArgs: TengShaderGeneratorArgs): String;
- var
- p: TengShaderPartProcParam;
- c: TengShaderPartClass;
- begin
- result := '';
- for p in fParameters do begin
- if (result <> '') then
- result := result + ', ';
- result := result + p.Typ + ' ' + p.Name;
- end;
- if (result = '') then
- result := 'void';
- if GetParent(TengShaderPartClass, c)
- then result := fReturnType + ' ' + c.Name + '_' + fName + '(' + result + ')'
- else result := fReturnType + ' ' + fName + '(' + result + ')';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartFunc.GenerateInlineCode(const aArgs: TengShaderGeneratorArgs);
- var
- csi: TengShaderGeneratorArgs.TCodeStackItem;
- indent: Integer;
- begin
- csi := TengShaderGeneratorArgs.TCodeStackItem.Create;
- try
- indent := aArgs.ExtractCurrentCommand(csi);
- aArgs
- .PushCode
- .BeginBlock;
- try
- inherited GenerateInlineCode(aArgs);
- finally
- aArgs
- .EndBlock
- .AddText(StringOfChar(' ', indent))
- .ReplaceReturns(csi, fReturnType, fName)
- .PopCode([pcfAppend]);
- end;
- finally
- FreeAndNil(csi);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartFunc.GetTokenName: String;
- begin
- result := TOKEN_FUNC;
- end;
-
- end.
-
|