|
- unit uengShaderGeneratorArgs;
-
- {$mode objfpc}{$H+}
- {$I uengShaderFile.inc}
-
- interface
-
- uses
- Classes, SysUtils,
- uengShaderFileTypes, uengShaderPart
-
- {$IFDEF USE_BITSPACE_UTILS}
- , uutlGenerics
- {$ENDIF}
- ;
-
- type
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengGenerateFlag = (
- gfGenerateProcedureMain, // generate main procedure code
- gfGenerateProcedureCode, // generate procedure code
- gfGenerateProcedureCall, // generate procedure call
- gfGenerateInlineCode, // generate procedure as inline code
- gfGenerateParameterCode, // generate code for parameter items
- gfAddProcedureItem, // add procedure item to generator args
- gfAddParameterItem // add parameter items to generator args
- );
- TengGenerateFlags = set of TengGenerateFlag;
- TengGenerateFlagsStack = specialize TutlSimpleList<TengGenerateFlags>;
-
- TengPopCodeFlag = (
- pcfAppend,
- pcfPrepend,
- pcfAddEmptyLine
- );
- TengPopCodeFlags = set of TengPopCodeFlag;
-
- TengShaderGeneratorArgs = class(TObject)
- private type
- TengGeneratorToken = (
- gtNormal = 0, // normal text
- gtLineBreak = 1, // line break
- gtCommandEnd = 2, // command end (like ';')
- gtBlockBegin = 3, // code block begin (to calculate indent)
- gtBlockEnd = 4, // code block end (to calculate indent)
- gtAppendToPrev = 5, // append current line to prev line
- gtToken = 6 // code token (like '$INCLUDE' or '$IF')
- );
-
- TCodePart = class(TObject)
- private
- fText: String;
- fIndent: Integer;
- fToken: TengGeneratorToken;
- function GetDebugText: String;
- function GetCode: String;
- public
- property Text: String read fText write fText;
- property Code: String read GetCode;
- property DebugText: String read GetDebugText;
- property Indent: Integer read fIndent;
- property Token: TengGeneratorToken read fToken;
- constructor Create(const aToken: TengGeneratorToken; const aText: String; const aIndent: Integer = High(Integer));
- end;
- TCodePartList = specialize TutlSimpleList<TCodePart>;
-
- public type
- TCodeStackItem = class(TObject)
- private
- fItems: TCodePartList;
- function GetIsEmpty: Boolean;
- public
- property Items: TCodePartList read fItems;
- property IsEmpty: Boolean read GetIsEmpty;
-
- procedure GenerateCode(const aCode: TengShaderCode);
- procedure Merge(const aItem: TCodeStackItem; aIndex: Integer);
-
- constructor Create;
- destructor Destroy; override;
- end;
-
- private type
- TCodeStack = specialize TutlSimpleList<TCodeStackItem>;
- TParameterMap = specialize TutlMap<string, TengShaderPart>;
- TProcedureList = specialize TutlSimpleList<TengShaderPart>;
- TProcParamStack = specialize TutlSimpleList<TStrings>;
-
- private
- fInlineReturnCounter: Integer;
- fCode: TCodeStack;
- fRoot: TengShaderPart;
- fFlagStack: TengGenerateFlagsStack;
- fMetaDataList: TengMetaDataList;
- fParameters: TParameterMap;
- fProcedures: TProcedureList;
- fProcParams: TProcParamStack;
-
- fMaxParameterLength: Integer;
-
- function GetFlags: TengGenerateFlags;
- function GetProcParams: TStrings;
-
- procedure GenerateParameterCode(const aTypes: CengShaderPartArr);
- procedure GenerateProcedureCode;
- procedure GenerateMetaCode;
- public
- property Root: TengShaderPart read fRoot;
- property Flags: TengGenerateFlags read GetFlags;
- property ProcParams: TStrings read GetProcParams;
- property MaxParameterLength: Integer read fMaxParameterLength;
-
- function PushCode: TengShaderGeneratorArgs;
- function PushFlags(const aFlags: TengGenerateFlags): TengShaderGeneratorArgs;
- function PushProcParams(const aParams: TStrings): TengShaderGeneratorArgs;
-
- function PopCode(const aFlags: TengPopCodeFlags): TengShaderGeneratorArgs;
- function PopFlags: TengShaderGeneratorArgs;
- function PopProcParams: TengShaderGeneratorArgs;
-
- function AddText(const aText: String): TengShaderGeneratorArgs;
- function AddToken(const aToken: String): TengShaderGeneratorArgs;
- function AddCommandEnd(const aToken: String): TengShaderGeneratorArgs;
- function AddLineBreak: TengShaderGeneratorArgs;
- function BeginBlock(const aIndent: Integer = High(Integer)): TengShaderGeneratorArgs;
- function EndBlock(const aCanAppend: Boolean = false): TengShaderGeneratorArgs;
- function AppendToPrevLine: TengShaderGeneratorArgs;
-
- procedure AddMeta(const aMeta: TengMetaData);
- procedure AddParameter(const aParam: TengShaderPart);
- procedure AddProcedure(const aProc: TengShaderPart);
-
- function ExtractCurrentCommand(const aCommand: TCodeStackItem): Integer;
- function ReplaceIdents(const aOld, aNew: TStrings): TengShaderGeneratorArgs;
- function ReplaceReturns(const aCommand: TCodeStackItem; const aRetType, aName: String): TengShaderGeneratorArgs;
-
- procedure GenerateCode(const aCode: TengShaderCode);
-
- constructor Create(const aRoot: TengShaderPart);
- destructor Destroy; override;
- end;
-
- implementation
-
- uses
- Math, RegExpr,
- uengShaderFileHelper, uengShaderFileConstants, uengShaderPartParameter, uengShaderPartProc;
-
- const
- WHITESPACES = [' ', #9];
-
- type
- TCodeBlock = class(TStringList)
- private
- function GetLast: String;
- function GetDepth(const aIndex: Integer): Integer;
- procedure SetLast(aValue: String);
- procedure SetDepth(const aIndex: Integer; aValue: Integer);
- public
- property Last: String read GetLast write SetLast;
- property Depth[const aIndex: Integer]: Integer read GetDepth write SetDepth;
-
- function Add(const aString: String; const aDepth: Integer): Integer; reintroduce;
- procedure Clear; override;
-
- constructor Create;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TCodeBlock////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TCodeBlock.GetLast: String;
- begin
- result := Get(Count-1);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TCodeBlock.GetDepth(const aIndex: Integer): Integer;
- begin
- result := PtrInt(Objects[aIndex]);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TCodeBlock.SetLast(aValue: String);
- begin
- Put(Count-1, aValue);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TCodeBlock.SetDepth(const aIndex: Integer; aValue: Integer);
- begin
- Objects[aIndex] := TObject(PtrInt(aValue));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TCodeBlock.Add(const aString: String; const aDepth: Integer): Integer;
- begin
- result := inherited AddObject(aString, TObject(PtrInt(aDepth)));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TCodeBlock.Clear;
- begin
- inherited Clear;
- Add('', 0);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TCodeBlock.Create;
- begin
- inherited Create;
- Clear;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderGeneratorArgs.TCodePart///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.TCodePart.GetCode: String;
- begin
- case fToken of
- gtNormal,
- gtCommandEnd:
- result := fText;
- gtLineBreak:
- result := sLineBreak;
- else
- result := '';
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.TCodePart.GetDebugText: String;
- begin
- case fToken of
- gtNormal: result := '[N]' + fText;
- gtLineBreak: result := sLineBreak;
- gtCommandEnd: result := '[C]' + fText;
- gtBlockBegin: if (fIndent = High(Integer))
- then result := '[B]'
- else result := format('[B%d]', [fIndent]);
- gtBlockEnd: result := '[E]';
- gtToken: result := '[T' + fText + ']';
- gtAppendToPrev: result := '[A]';
- else
- result := '[' + IntToStr(Integer(fToken)) + ']' + fText
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengShaderGeneratorArgs.TCodePart.Create(const aToken: TengGeneratorToken; const aText: String; const aIndent: Integer);
- begin
- inherited Create;
- fToken := aToken;
- fText := aText;
- fIndent := aIndent;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderGeneratorArgs.TCodeStackItem//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.TCodeStackItem.GetIsEmpty: Boolean;
- begin
- result := (fItems.Count = 0);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderGeneratorArgs.TCodeStackItem.GenerateCode(const aCode: TengShaderCode);
- type
- TGenFlag = (
- gfToken, // current line has a token in it
- gfTokenOnly, // current line has only a token (or whitespaces) in it
- gfPrevIsEmpty, // previouse line was empty (or whitespaces only)
- gfAddToPrev // add current line to previouse line
- );
- TGenFlags = set of TGenFlag;
-
- var
- i: Integer;
- f: TGenFlags;
- cb: TCodeBlock;
-
- {$IFDEF DEBUG}
- procedure GenerateDebugCode;
- var
- cp: TCodePart;
- s: String;
- begin
- s := '';
- for cp in fItems do
- s := s + cp.DebugText;
- aCode.Text := aCode.Text + s + sLineBreak + sLineBreak;
- end;
-
- procedure GenerateCurrentCode(const aHeader: String);
- var
- i: Integer;
- begin
- aCode.Add(aHeader);
- for i := 0 to cb.Count-1 do
- aCode.Add(Format('[%02d]%s|', [cb.Depth[i], cb[i]]));
- aCode.Add('');
- aCode.Add('');
- aCode.Add('');
- end;
- {$ENDIF}
-
- function GetCurrentIndent(const aStr: String; const aIgnoreEmptyLines: Boolean): Integer;
- var
- len: Integer;
- begin
- if (Trim(aStr) <> '') or not aIgnoreEmptyLines then begin
- result := 1;
- len := Length(aStr);
- while (result <= len) and (aStr[result] in WHITESPACES) do
- inc(result);
- dec(result);
- end else
- result := High(Integer);
- end;
-
- function IndentStr(const aStr: String; aIndent: Integer): String;
- var
- i, l: Integer;
- begin
- if (aStr = '') then
- aIndent := 0;
- if (aIndent < 0) then begin
- i := 1;
- l := Length(aStr);
- while (i <= l) and (i <= -aIndent) and (aStr[i] in WHITESPACES) do
- inc(i);
- result := copy(aStr, i, l - i + 1);
- end else if (aIndent > 0) then
- result := StringOfChar(' ', aIndent) + aStr
- else
- result := aStr;
- end;
-
- procedure IndentBlock(aDepth, aAbsIndent: Integer);
- var
- i, indent, minCurIndent: Integer;
- begin
- i := cb.Count-1;
- minCurIndent := High(Integer);
- while (i >= 0) and (cb.Depth[i] = aDepth) do begin
- minCurIndent := min(minCurIndent, GetCurrentIndent(cb[i], true));
- dec(i);
- end;
- inc(i);
- indent := aAbsIndent - minCurIndent;
- while (i < cb.Count) do begin
- cb[i] := IndentStr(cb[i], indent);
- cb.Depth[i] := cb.Depth[i] - 1;
- inc(i);
- end;
- end;
-
- procedure ProgressBlock(const aCurrentBlockIndent, aDepth: Integer);
- var
- cp: TCodePart;
- tmp: Integer;
- begin
- while (i < fItems.Count) do begin
- cp := fItems[i];
- inc(i);
-
- if (Trim(cb.Last) = '') then
- cb.Depth[cb.Count-1] := aDepth;
-
- case cp.Token of
- gtLineBreak: begin
- if (Trim(cb.Last) = '') then begin
- if (f * [gfTokenOnly, gfPrevIsEmpty] = []) then begin
- Include(f, gfPrevIsEmpty);
- cb.Add('', aDepth);
- end else
- cb.Last := '';
- end else begin
- if (gfAddToPrev in f) and (cb.Count >= 2) then begin
- cb[cb.Count-2] := cb[cb.Count-2] + TrimLeft(cb.Last);
- cb.Last := '';
- end else
- cb.Add('', aDepth);
- Exclude(f, gfPrevIsEmpty);
- end;
- f := f - [gfToken, gfTokenOnly, gfAddToPrev];
- end;
-
- gtToken: begin
- Include(f, gfToken);
- if (Trim(cb.Last) = '') then
- Include(f, gfTokenOnly);
- end;
-
- gtBlockBegin: begin
- Include(f, gfPrevIsEmpty);
- tmp := GetCurrentIndent(cb.Last, false);
- if (tmp = High(Integer)) then
- tmp := 0;
- if (Trim(cb.Last) <> '') then
- inc(tmp, 4);
- if (cp.Indent <> High(Integer)) then
- inc(tmp, cp.Indent);
- tmp := max(tmp, aCurrentBlockIndent);
- ProgressBlock(tmp, aDepth + 1);
- end;
-
- gtBlockEnd: begin
- {$IFDEF DEBUG}
- GenerateCurrentCode(Format('------====== DEBUG STEP BEFORE INDENT (%d) ======------', [aCurrentBlockIndent]));
- {$ENDIF}
- IndentBlock(aDepth, aCurrentBlockIndent);
- {$IFDEF DEBUG}
- GenerateCurrentCode(Format('------====== DEBUG STEP AFTER INDENT (%d) ======------', [aCurrentBlockIndent]));
- {$ENDIF}
- exit;
- end;
-
- gtAppendToPrev: begin
- if (Trim(cb.Last) = '') and not (gfPrevIsEmpty in f) then
- include(f, gfAddToPrev);
- end;
- else
- cb.Last := cb.Last + cp.Code;
- end;
- end;
- end;
-
- var
- s, e: Integer;
- begin
- {$IFDEF DEBUG}
- GenerateDebugCode;
- {$ENDIF}
-
- i := 0;
- f := [gfPrevIsEmpty];
- cb := TCodeBlock.Create;
- try
- ProgressBlock(0, 0);
- s := 0;
- e := cb.Count-1;
- while (s < cb.Count) and (Trim(cb[s]) = '') do
- inc(s);
- while (e >= 0) and (Trim(cb[e]) = '') do
- dec(e);
- for i := s to e do
- aCode.Add(
- {$IFDEF DEBUG}
- Format('[%02d]%s|', [cb.Depth[i], cb[i]])
- {$ELSE}
- cb[i]
- {$ENDIF}
- );
- finally
- FreeAndNil(cb);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderGeneratorArgs.TCodeStackItem.Merge(const aItem: TCodeStackItem; aIndex: Integer);
- begin
- if (aIndex < 0) then
- aIndex := 0;
- if (aIndex > fItems.Count) then
- aIndex := fItems.Count;
- while (aItem.Items.Count > 0) do
- fItems.Insert(aIndex, aItem.Items.PopLast(false));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengShaderGeneratorArgs.TCodeStackItem.Create;
- begin
- inherited Create;
- fItems := TCodePartList.Create(true);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengShaderGeneratorArgs.TCodeStackItem.Destroy;
- begin
- FreeAndNil(fItems);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderGeneratorArgs///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.GetFlags: TengGenerateFlags;
- begin
- result := fFlagStack.Last;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.GetProcParams: TStrings;
- begin
- result := fProcParams.Last;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderGeneratorArgs.GenerateParameterCode(const aTypes: CengShaderPartArr);
- var
- m: TParameterMap;
- p: TengShaderPart;
- begin
- PushCode;
- PushFlags(Flags + [gfGenerateParameterCode] - [gfAddParameterItem]);
- m := TParameterMap.Create(false);
- try
- fMaxParameterLength := 0;
- for p in fParameters do begin
- if CheckType(p, aTypes) then with (p as TengShaderPartParameter) do begin
- fMaxParameterLength := Max(fMaxParameterLength, Length(Typ));
- m.Add(Typ+Name, p);
- end;
- end;
- for p in m do begin
- (p as TengShaderPartParameter).GenerateCodeIntern(self);
- AddLineBreak;
- end;
- finally
- FreeAndNil(m);
- PopFlags;
- PopCode([pcfPrepend, pcfAddEmptyLine]);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderGeneratorArgs.GenerateProcedureCode;
- var
- i: Integer;
- begin
- i := 0;
- while (i < fProcedures.Count) do begin
- PushCode;
- PushFlags([gfGenerateProcedureCode, gfAddParameterItem]);
- try
- (fProcedures[i] as TengShaderPartProc).GenerateCodeIntern(self);
- finally
- PopFlags;
- PopCode([pcfPrepend, pcfAddEmptyLine]);
- end;
- inc(i);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderGeneratorArgs.GenerateMetaCode;
- var
- layouts: TStringList;
- m: TengMetaData;
- vCompat: Boolean;
- vMax, i: Integer;
- s: String;
- begin
- PushCode;
- vMax := 0;
- vCompat := false;
- layouts := TStringList.Create;
- try
- for m in fMetaDataList do begin
- case m.MetaType of
- metaVersion: begin
- if (m.Values[0] = VERSION_EXTRA_COMPAT) then
- vCompat := true
- else if TryStrToInt(m.Values[0], i) then
- vMax := max(vMax, i);
- if (m.Count > 1) and (m.Values[1] = VERSION_EXTRA_COMPAT) then
- vCompat := true;
- end;
-
- metaExtension: begin
- AddText(format('#extension %s : %s', [m.Values[0], m.Values[1]]));
- AddLineBreak;
- end;
-
- metaLayout: begin
- layouts.Add('layout' + m.Values[0] + ';');
- end;
- end;
- end;
-
- if (vMax >= LAYOUT_MIN_VERSION) then begin
- for s in layouts do begin
- AddText(s);
- AddLineBreak;
- end;
- end;
-
- if (vMax > 0) then begin
- PushCode;
- try
- AddText('#version ' + IntToStr(vMax));
- if vCompat then
- AddText(' ' + VERSION_EXTRA_COMPAT);
- AddLineBreak;
- finally
- PopCode([pcfPrepend]);
- end;
- end;
- finally
- PopCode([pcfPrepend, pcfAddEmptyLine]);
- FreeAndNil(layouts);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.PushCode: TengShaderGeneratorArgs;
- begin
- fCode.PushLast(TCodeStackItem.Create);
- result := self;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.PushFlags(const aFlags: TengGenerateFlags): TengShaderGeneratorArgs;
- begin
- fFlagStack.PushLast(aFlags);
- result := self;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.PushProcParams(const aParams: TStrings): TengShaderGeneratorArgs;
- begin
- fProcParams.PushLast(aParams);
- result := self;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.PopCode(const aFlags: TengPopCodeFlags): TengShaderGeneratorArgs;
- var
- csi: TCodeStackItem;
- begin
- csi := fCode.PopLast(false);
- try
- if csi.IsEmpty then
- exit;
- if (pcfPrepend in aFlags) then begin
- if (pcfAddEmptyLine in aFlags) then
- csi.Items.Add(TCodePart.Create(gtLineBreak, ''));
- fCode.Last.Merge(csi, 1);
- end else if (pcfAppend in aFlags) then begin
- if (pcfAddEmptyLine in aFlags) then
- fCode.Last.Items.Add(TCodePart.Create(gtLineBreak, ''));
- fCode.Last.Merge(csi, fCode.Last.Items.Count);
- end;
- finally
- FreeAndNil(csi);
- end;
- result := self;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.PopFlags: TengShaderGeneratorArgs;
- begin
- fFlagStack.PopLast(true);
- result := self;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.PopProcParams: TengShaderGeneratorArgs;
- begin
- fProcParams.PopLast;
- result := self;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.AddText(const aText: String): TengShaderGeneratorArgs;
- begin
- fCode.Last.Items.Add(TCodePart.Create(gtNormal, aText));
- result := self;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.AddToken(const aToken: String): TengShaderGeneratorArgs;
- begin
- fCode.Last.Items.Add(TCodePart.Create(gtToken, aToken));
- result := self;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.AddCommandEnd(const aToken: String): TengShaderGeneratorArgs;
- begin
- fCode.Last.Items.Add(TCodePart.Create(gtCommandEnd, aToken));
- result := self;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.AddLineBreak: TengShaderGeneratorArgs;
- begin
- fCode.Last.Items.Add(TCodePart.Create(gtLineBreak, ''));
- result := self;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.BeginBlock(const aIndent: Integer): TengShaderGeneratorArgs;
- begin
- fCode.Last.Items.Add(TCodePart.Create(gtBlockBegin, '', aIndent));
- result := self;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.EndBlock(const aCanAppend: Boolean): TengShaderGeneratorArgs;
- begin
- fCode.Last.Items.Add(TCodePart.Create(gtBlockEnd, ''));
- result := self;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.AppendToPrevLine: TengShaderGeneratorArgs;
- begin
- fCode.Last.Items.Add(TCodePart.Create(gtAppendToPrev, ''));
- result := self;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderGeneratorArgs.AddMeta(const aMeta: TengMetaData);
- begin
- fMetaDataList.Add(aMeta);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderGeneratorArgs.AddParameter(const aParam: TengShaderPart);
- var
- p: TengShaderPart;
- s: String;
- begin
- if not (aParam is TengShaderPartParameter) then
- raise EengShaderPartInternal.Create('parameter (' + aParam.ClassName + ') is not a ' + TengShaderPartParameter.ClassName, aParam);
- with (aParam as TengShaderPartParameter) do begin
- p := fParameters[Name];
- if Assigned(p) then begin
- s := Format('use of duplicate identifier: %s (%s %d:%d)', [Name, Filename, Line + 1, Col]) + sLineBreak +
- 'previously declared here:' + sLineBreak +
- Format(' %s %d:%d', [p.Filename, p.Line + 1, p.Col]) + sLineBreak;
- fRoot.LogMsg(llWarning, s);
- fParameters[Name] := aParam;
- end else
- fParameters.Add(Name, aParam);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderGeneratorArgs.AddProcedure(const aProc: TengShaderPart);
- begin
- if not (aProc is TengShaderPartProc) then
- raise EengShaderPartInternal.Create('parameter (' + aProc.ClassName + ') is not a ' + TengShaderPartProc.ClassName, aProc);
- fProcedures.Add(aProc);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.ExtractCurrentCommand(const aCommand: TCodeStackItem): Integer;
- var
- csi: TCodeStackItem;
- i, len: Integer;
- s: String;
- begin
- csi := fCode.Last;
- if not Assigned(aCommand) then
- exit;
-
- // find last command end token
- while (csi.Items.Last.Token <> gtCommandEnd) do
- aCommand.Items.PushFirst(csi.Items.PopLast(false));
-
- // move forward to first code part with text
- while (aCommand.Items.First.Token <> gtNormal) or (Trim(aCommand.Items.First.Text) = '') do
- csi.Items.PushLast(aCommand.Items.PopFirst(false));
-
- // extract leading whitespaces
- i := 1;
- s := aCommand.Items.First.Text;
- len := Length(s);
- while (s[i] in WHITESPACES) and (i <= len) do
- inc(i);
- csi.Items.PushLast(TCodePart.Create(gtNormal, Copy(s, 1, i-1)));
- aCommand.Items.First.Text := copy(s, i, len-i+1);
- result := i - 1;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.ReplaceIdents(const aOld, aNew: TStrings): TengShaderGeneratorArgs;
- var
- rx: TRegExpr;
- i: Integer;
- cp: TCodePart;
- begin
- if (aOld.Count <> aNew.Count) then
- raise EengShaderPartInternal.Create('old and new ident must have the same size');
- rx := TRegExpr.Create;
- try
- for i := 0 to aOld.Count-1 do begin
- rx.Expression := '([^A-z0-9_]+|^)' + aOld[i] + '([^A-z0-9_]+|$)';
- for cp in fCode.Last.Items do
- cp.Text := rx.Replace(cp.Text, '$1' + aNew[i] + '$2', true);
- end;
- finally
- FreeAndNil(rx);
- end;
- result := self;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderGeneratorArgs.ReplaceReturns(const aCommand: TCodeStackItem; const aRetType, aName: String): TengShaderGeneratorArgs;
- var
- rx: TRegExpr;
- RetCount, i, j: Integer;
- csi: TCodeStackItem;
- cp: TCodePart;
- s: String;
- begin
- rx := TRegExpr.Create;
- try
- rx.Expression := '^(.*?\s+)return\s*(.*)$';
- csi := fCode.Last;
-
- // find number of "return" in code
- RetCount := 0;
- for cp in csi.Items do begin
- s := cp.Code;
- if rx.Exec(s) then
- inc(RetCount);
- end;
-
- // no "return" found
- if (RetCount = 0) then begin
- raise EengShaderPartInternal.Create('expected "return" token in function');
-
- // more than one "return"
- end else if (RetCount > 1) then begin
- // find block begin
- i := 0;
- while (csi.Items[i].Token <> gtBlockBegin) and (i < csi.Items.Count) do
- inc(i);
- if (i < csi.Items.Count)
- then inc(i)
- else i := 0;
-
- // insert temp variable
- s := Format('%s_ret%.4d', [aName, fInlineReturnCounter]);
- inc(fInlineReturnCounter);
- csi.Items.Insert(i+0, TCodePart.Create(gtNormal, aRetType + ' ' + s));
- csi.Items.Insert(i+1, TCodePart.Create(gtCommandEnd, ';'));
- csi.Items.Insert(i+2, TCodePart.Create(gtLineBreak, ''));
-
- // replace "return" with temp variable
- for cp in csi.Items do
- cp.Text := rx.Replace(cp.Text, '$1' + s + ' = $2', true);
-
- // merge code
- csi.Merge(aCommand, csi.Items.Count);
- AddText(s);
-
- // exact one "return"
- end else begin
- i := csi.Items.Count-1;
- while (i > 0) do begin
- cp := csi.Items[i];
- if rx.Exec(cp.Text) then begin
- csi.Items.Insert(i, TCodePart.Create(gtNormal, rx.Match[1]));
- cp.Text := rx.Replace(cp.Text, '($2', true);
-
- // replace last gtCommandEnd with ')' and delete everything code behind
- j := csi.Items.Count-1;
- while (j > i) and not (csi.Items[j].Token = gtCommandEnd) do
- dec(j);
- if (j > i) then
- csi.Items[j] := TCodePart.Create(gtNormal, ')');
- inc(j);
- while (j < csi.Items.Count) do begin
- if (csi.Items[j].Token in [gtNormal, gtLineBreak, gtCommandEnd])
- then csi.Items.Delete(j)
- else inc(j);
- end;
-
- // merge
- csi.Merge(aCommand, i+1);
- end;
- dec(i);
- end;
- end;
- finally
- FreeAndNil(rx);
- end;
- result := self;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderGeneratorArgs.GenerateCode(const aCode: TengShaderCode);
- begin
- GenerateProcedureCode;
- GenerateParameterCode(CengShaderPartArr.Create(TengShaderPartVar));
- GenerateParameterCode(CengShaderPartArr.Create(TengShaderPartVarying));
- GenerateParameterCode(CengShaderPartArr.Create(TengShaderPartUniform));
- GenerateMetaCode;
- fCode.Last.GenerateCode(aCode);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengShaderGeneratorArgs.Create(const aRoot: TengShaderPart);
- begin
- inherited Create;
- fCode := TCodeStack.Create(true);
- fFlagStack := TengGenerateFlagsStack.Create();
- fMetaDataList := TengMetaDataList.Create(false);
- fParameters := TParameterMap.Create(false);
- fProcedures := TProcedureList.Create(false);
- fProcParams := TProcParamStack.Create(false);
- fRoot := aRoot;
- fInlineReturnCounter := 0;
- PushCode;
- PushFlags([ gfAddParameterItem, gfAddProcedureItem ]);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengShaderGeneratorArgs.Destroy;
- begin
- FreeAndNil(fProcParams);
- FreeAndNil(fProcedures);
- FreeAndNil(fParameters);
- FreeAndNil(fMetaDataList);
- FreeAndNil(fFlagStack);
- FreeAndNil(fCode);
- inherited Destroy;
- end;
-
- end.
|