Browse Source

* implemented unit tests for $INHERITED and fixed some issues

master
Bergmann89 8 years ago
parent
commit
427f7962f1
15 changed files with 429 additions and 128 deletions
  1. +36
    -0
      tests/testfiles/code_Class_InheritedFunc.shdr
  2. +19
    -0
      tests/testfiles/code_Class_InheritedMain.shdr
  3. +27
    -0
      tests/testfiles/result_Class_InheritedFunc.shdr
  4. +16
    -0
      tests/testfiles/result_Class_InheritedMain.shdr
  5. +12
    -0
      tests/uShaderFileTestCase.pas
  6. +1
    -1
      uengShaderFile.inc
  7. +1
    -1
      uengShaderFileConstants.pas
  8. +1
    -1
      uengShaderFileExpression.pas
  9. +52
    -14
      uengShaderFileHelper.pas
  10. +90
    -54
      uengShaderGeneratorArgs.pas
  11. +140
    -36
      uengShaderPartCall.pas
  12. +1
    -1
      uengShaderPartClass.pas
  13. +0
    -1
      uengShaderPartEcho.pas
  14. +0
    -1
      uengShaderPartKeyValuePair.pas
  15. +33
    -18
      uengShaderPartProc.pas

+ 36
- 0
tests/testfiles/code_Class_InheritedFunc.shdr View File

@@ -0,0 +1,36 @@
{$STATIC BaseVec 'vec2(0.0)'}

{$CLASS Base1}
{$FUNC 'vec2' 'TestProc' 'vec2' 'aVec'}
vec2 tmp = aVec;
tmp += vec2(1.0);
return tmp;
{$END}
{$END}

{$CLASS Base2}
{$FUNC 'vec2' 'TestProc' 'vec2' 'aVec'}
return aVec + vec2(1.0);
{$END}
{$END}

{$CLASS SimpleClass $EXTENDS Base1 Base2}
{$UNIFORM 'sampler2D' 'uTexture0'}
{$UNIFORM 'sampler2D' 'uTexture1'}
{$UNIFORM 'vec4' 'uColor'}
{$FUNC 'vec2' 'TestProc' 'vec2' 'aVec'}
vec2 v = aVec;
v = {$INHERITED Base1 TestProc BaseVec $INLINE};
v = {$INHERITED Base2 'v'};
return v;
{$END}
{$MAIN}
vec2 texCoord = {$CALL TestProc 'gl_TexCoord[0]'};
gl_FragColor =
texture2D(uTexture0, texCoord) *
texture2D(uTexture1, texCoord) *
uColor;
{$END}
{$END}

+ 19
- 0
tests/testfiles/code_Class_InheritedMain.shdr View File

@@ -0,0 +1,19 @@
{$CLASS Base1}
{$MAIN}
gl_FragColor.r = 1.0;
{$END}
{$END}

{$CLASS Base2}
{$MAIN}
gl_FragColor.g = 1.0;
{$END}
{$END}

{$CLASS SimpleClass $EXTENDS Base1 Base2}
{$MAIN}
{$INHERITED Base1};
{$INHERITED Base2};
gl_FragColor.ba = vec2(1.0);
{$END}
{$END}

+ 27
- 0
tests/testfiles/result_Class_InheritedFunc.shdr View File

@@ -0,0 +1,27 @@
uniform sampler2D uTexture0;
uniform sampler2D uTexture1;
uniform vec4 uColor;

vec2 Base2_TestProc(vec2 aVec)
{
return aVec + vec2(1.0);
}

vec2 SimpleClass_TestProc(vec2 aVec)
{
vec2 v = aVec;
vec2 tmp = (vec2(0.0));
tmp += vec2(1.0);
v = (tmp);
v = Base2_TestProc(v);
return v;
}

void main(void)
{
vec2 texCoord = SimpleClass_TestProc(gl_TexCoord[0]);
gl_FragColor =
texture2D(uTexture0, texCoord) *
texture2D(uTexture1, texCoord) *
uColor;
}

+ 16
- 0
tests/testfiles/result_Class_InheritedMain.shdr View File

@@ -0,0 +1,16 @@
void Base2_main(void)
{
gl_FragColor.g = 1.0;
}

void Base1_main(void)
{
gl_FragColor.r = 1.0;
}

void main(void)
{
Base1_main();
Base2_main();
gl_FragColor.ba = vec2(1.0);
}

+ 12
- 0
tests/uShaderFileTestCase.pas View File

@@ -48,6 +48,8 @@ type
TTestCase_Class = class(TShaderFileTestCase)
published
procedure Simple;
procedure InheritedFunc;
procedure InheritedMain;
end;

implementation
@@ -194,6 +196,16 @@ begin
DoTest('code_Class_Simple.shdr', 'SimpleClass', 'result_Class_Simple.shdr');
end;

procedure TTestCase_Class.InheritedFunc;
begin
DoTest('code_Class_InheritedFunc.shdr', 'SimpleClass', 'result_Class_InheritedFunc.shdr');
end;

procedure TTestCase_Class.InheritedMain;
begin
DoTest('code_Class_InheritedMain.shdr', 'SimpleClass', 'result_Class_InheritedMain.shdr');
end;

initialization
RegisterTest(TTestCase_IfElifElseEnd);
RegisterTest(TTestCase_FuncProcMain);


+ 1
- 1
uengShaderFile.inc View File

@@ -1,3 +1,3 @@
{.$DEFINE EXPRESSION_ADD_BRACKET} // add brackets to expressions
{$DEFINE USE_BITSPACE_UTILS} // use bitSpace Utils
{$DEFINE DEBUG} // enable debug output
{.$DEFINE DEBUG} // enable debug output

+ 1
- 1
uengShaderFileConstants.pas View File

@@ -25,7 +25,7 @@ const

TOKEN_CLASS = TOKEN_CHAR_IDENT + 'CLASS'; //{$CLASS PhongLight $EXTENDS Normal Glow}
TOKEN_EXTENDS = TOKEN_CHAR_IDENT + 'EXTENDS';
TOKEN_INHERITED = TOKEN_CHAR_IDENT + 'INHERITED'; //{$INHERITED BaseClassMethod 'param1' 'param2'}
TOKEN_INHERITED = TOKEN_CHAR_IDENT + 'INHERITED'; //{$INHERITED BaseClass MethodName 'param1' 'param2' $INLINE}

TOKEN_INCLUDE = TOKEN_CHAR_IDENT + 'INCLUDE'; //{$INCLUDE 'Normal.frag'}



+ 1
- 1
uengShaderFileExpression.pas View File

@@ -693,7 +693,7 @@ begin
walker := TengKeyValuePairSearchWalker.Create(sr);
try
walker.Name := param.Name;
walker.SearchFlags := [sfSearchChildrenLazy, sfSearchParents];
walker.SearchFlags := [sfSearchChildren, sfSearchParents];
walker.ResultTypes := CengShaderPartArr.Create(TengShaderPartProperty, TengShaderPartStatic);
walker.ChildrenDoNotLeave := CengShaderPartArr.Create(TengShaderPartScope);
walker.ChildrenForceLeave := CengShaderPartArr.Create(TengShaderFile);


+ 52
- 14
uengShaderFileHelper.pas View File

@@ -6,7 +6,7 @@ unit uengShaderFileHelper;
interface

uses
uengShaderPart, uengShaderFileParser;
uengShaderPart, uengShaderFileParser, uengShaderPartClass;

type
TInfoFlag = (
@@ -83,6 +83,16 @@ type
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;
@@ -98,7 +108,7 @@ implementation
uses
sysutils,
uengShaderFileConstants, uengShaderFileTypes, uengShaderPartKeyValuePair, uengShaderPartProc,
uengShaderPartIf, uengShaderPartClass;
uengShaderPartIf;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function IsValidIdentifier(const aIdent: String): Boolean;
@@ -195,14 +205,12 @@ 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);
result := Assigned(aItem) and (aItem <> aSender);
if not result then
exit;
for c in fChildrenDoNotLeave do
@@ -217,7 +225,7 @@ var
var
c: CengShaderPart;
begin
result := (sfSearchParents in args.Flags) and Assigned(aPart.Parent) and (aPart.Parent <> aSender);
result := Assigned(aPart.Parent) and (aPart.Parent <> aSender);
if not result then
exit;
for c in fParentsDoNotLeave do
@@ -231,6 +239,7 @@ var
var
p: TengShaderPart;
c: TengShaderPartClass;
args: TArgs;
nextArgs: TArgs;
begin
if not Assigned(aPart) then
@@ -240,23 +249,31 @@ begin
else
args.Flags := fSearchFlags;

// visit parent
// calculate args for next iteration
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
// 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
for c in (aPart as TengShaderPartClass).InheritedClasses do begin
if Check(c) then
fResults.Add(c);
Visit(c, aPart, @nextArgs);
end;
end;

// visit children
// 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
@@ -269,6 +286,7 @@ begin
exit;
end;

// normal children
for p in aPart do begin
if Check(p) then
fResults.Add(p);
@@ -309,6 +327,26 @@ begin
((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//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////


+ 90
- 54
uengShaderGeneratorArgs.pas View File

@@ -17,6 +17,7 @@ uses
type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TengGenerateFlag = (
gfGenerateProcedureMain, // generate main procedure code
gfGenerateProcedureCode, // generate procedure code
gfGenerateProcedureCall, // generate procedure call
gfGenerateInlineCode, // generate procedure as inline code
@@ -59,7 +60,7 @@ type
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 = 0);
constructor Create(const aToken: TengGeneratorToken; const aText: String; const aIndent: Integer = High(Integer));
end;
TCodePartList = specialize TutlSimpleList<TCodePart>;

@@ -109,19 +110,19 @@ type
property ProcParams: TStrings read GetProcParams;
property MaxParameterLength: Integer read fMaxParameterLength;

procedure PushCode;
procedure PushFlags(const aFlags: TengGenerateFlags);
procedure PushProcParams(const aParams: TStrings);
function PushCode: TengShaderGeneratorArgs;
function PushFlags(const aFlags: TengGenerateFlags): TengShaderGeneratorArgs;
function PushProcParams(const aParams: TStrings): TengShaderGeneratorArgs;

procedure PopCode(const aFlags: TengPopCodeFlags);
procedure PopFlags;
procedure PopProcParams;
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 = 0): TengShaderGeneratorArgs;
function BeginBlock(const aIndent: Integer = High(Integer)): TengShaderGeneratorArgs;
function EndBlock(const aCanAppend: Boolean = false): TengShaderGeneratorArgs;
function AppendToPrevLine: TengShaderGeneratorArgs;

@@ -130,8 +131,8 @@ type
procedure AddProcedure(const aProc: TengShaderPart);

function ExtractCurrentCommand(const aCommand: TCodeStackItem): Integer;
procedure ReplaceIdents(const aOld, aNew: TStrings);
procedure ReplaceReturns(const aCommand: TCodeStackItem; const aRetType, aName: String);
function ReplaceIdents(const aOld, aNew: TStrings): TengShaderGeneratorArgs;
function ReplaceReturns(const aCommand: TCodeStackItem; const aRetType, aName: String): TengShaderGeneratorArgs;

procedure GenerateCode(const aCode: TengShaderCode);

@@ -234,7 +235,9 @@ begin
gtNormal: result := '[N]' + fText;
gtLineBreak: result := sLineBreak;
gtCommandEnd: result := '[C]' + fText;
gtBlockBegin: result := format('[B%d]', [fIndent]);
gtBlockBegin: if (fIndent = High(Integer))
then result := '[B]'
else result := format('[B%d]', [fIndent]);
gtBlockEnd: result := '[E]';
gtToken: result := '[T' + fText + ']';
gtAppendToPrev: result := '[A]';
@@ -276,11 +279,36 @@ var
f: TGenFlags;
cb: TCodeBlock;

function GetCurrentIndent(const aStr: String): Integer;
{$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) <> '') then begin
if (Trim(aStr) <> '') or not aIgnoreEmptyLines then begin
result := 1;
len := Length(aStr);
while (result <= len) and (aStr[result] in WHITESPACES) do
@@ -290,10 +318,12 @@ var
result := High(Integer);
end;

function IndentStr(const aStr: String; const aIndent: Integer): String;
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);
@@ -306,26 +336,26 @@ var
result := aStr;
end;

procedure IndentBlock(aDepth, aIndent: Integer);
procedure IndentBlock(aDepth, aAbsIndent: Integer);
var
i, minCurIndent: Integer;
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]));
minCurIndent := min(minCurIndent, GetCurrentIndent(cb[i], true));
dec(i);
end;
inc(i);
aIndent := aIndent - minCurIndent;
indent := aAbsIndent - minCurIndent;
while (i < cb.Count) do begin
cb[i] := IndentStr(cb[i], aIndent);
cb[i] := IndentStr(cb[i], indent);
cb.Depth[i] := cb.Depth[i] - 1;
inc(i);
end;
end;

procedure ProgressBlock(const aIndent, aDepth: Integer);
procedure ProgressBlock(const aCurrentBlockIndent, aDepth: Integer);
var
cp: TCodePart;
tmp: Integer;
@@ -364,18 +394,25 @@ var

gtBlockBegin: begin
Include(f, gfPrevIsEmpty);
tmp := GetCurrentIndent(cb.Last);
if (tmp <> High(Integer))
then tmp := aIndent + tmp
else tmp := aIndent;
tmp := GetCurrentIndent(cb.Last, false);
if (tmp = High(Integer)) then
tmp := 0;
if (Trim(cb.Last) <> '') then
inc(tmp, 4);
inc(tmp, cp.Indent);
if (cp.Indent <> High(Integer)) then
inc(tmp, cp.Indent);
tmp := max(tmp, aCurrentBlockIndent);
ProgressBlock(tmp, aDepth + 1);
end;

gtBlockEnd: begin
IndentBlock(aDepth, aIndent);
{$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;

@@ -389,19 +426,6 @@ var
end;
end;

{$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;
{$ENDIF}

var
s, e: Integer;
begin
@@ -423,7 +447,7 @@ begin
for i := s to e do
aCode.Add(
{$IFDEF DEBUG}
Format('[%02d]%s', [cb.Depth[i], cb[i]])
Format('[%02d]%s|', [cb.Depth[i], cb[i]])
{$ELSE}
cb[i]
{$ENDIF}
@@ -580,25 +604,28 @@ begin
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorArgs.PushCode;
function TengShaderGeneratorArgs.PushCode: TengShaderGeneratorArgs;
begin
fCode.PushLast(TCodeStackItem.Create);
result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorArgs.PushFlags(const aFlags: TengGenerateFlags);
function TengShaderGeneratorArgs.PushFlags(const aFlags: TengGenerateFlags): TengShaderGeneratorArgs;
begin
fFlagStack.PushLast(aFlags);
result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorArgs.PushProcParams(const aParams: TStrings);
function TengShaderGeneratorArgs.PushProcParams(const aParams: TStrings): TengShaderGeneratorArgs;
begin
fProcParams.PushLast(aParams);
result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorArgs.PopCode(const aFlags: TengPopCodeFlags);
function TengShaderGeneratorArgs.PopCode(const aFlags: TengPopCodeFlags): TengShaderGeneratorArgs;
var
csi: TCodeStackItem;
begin
@@ -618,18 +645,21 @@ begin
finally
FreeAndNil(csi);
end;
result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorArgs.PopFlags;
function TengShaderGeneratorArgs.PopFlags: TengShaderGeneratorArgs;
begin
fFlagStack.PopLast(true);
result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorArgs.PopProcParams;
function TengShaderGeneratorArgs.PopProcParams: TengShaderGeneratorArgs;
begin
fProcParams.PopLast;
result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -747,7 +777,7 @@ begin
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorArgs.ReplaceIdents(const aOld, aNew: TStrings);
function TengShaderGeneratorArgs.ReplaceIdents(const aOld, aNew: TStrings): TengShaderGeneratorArgs;
var
rx: TRegExpr;
i: Integer;
@@ -765,10 +795,11 @@ begin
finally
FreeAndNil(rx);
end;
result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorArgs.ReplaceReturns(const aCommand: TCodeStackItem; const aRetType, aName: String);
function TengShaderGeneratorArgs.ReplaceReturns(const aCommand: TCodeStackItem; const aRetType, aName: String): TengShaderGeneratorArgs;
var
rx: TRegExpr;
RetCount, i, j: Integer;
@@ -778,7 +809,7 @@ var
begin
rx := TRegExpr.Create;
try
rx.Expression := '([^A-z0-9_]+|^)return([^A-z0-9_]+|$)';
rx.Expression := '^(.*?\s+)return\s*(.*)$';
csi := fCode.Last;

// find number of "return" in code
@@ -812,7 +843,7 @@ begin

// replace "return" with temp variable
for cp in csi.Items do
cp.Text := rx.Replace(cp.Text, '$1' + s + ' =$2', true);
cp.Text := rx.Replace(cp.Text, '$1' + s + ' = $2', true);

// merge code
csi.Merge(aCommand, csi.Items.Count);
@@ -825,16 +856,20 @@ 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, '(', true);
cp.Text := rx.Replace(cp.Text, '($2', true);

// replace last gtCommandEnd with ')' and delete everything behind
// 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, ')');
while (csi.Items.Count-1 > j) do
csi.Items.PopLast(true);
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);
@@ -845,6 +880,7 @@ begin
finally
FreeAndNil(rx);
end;
result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////


+ 140
- 36
uengShaderPartCall.pas View File

@@ -7,7 +7,8 @@ interface

uses
Classes, SysUtils,
uengShaderPart, uengShaderCodePart, uengShaderFileParser, uengShaderGeneratorArgs;
uengShaderPart, uengShaderCodePart, uengShaderFileParser, uengShaderGeneratorArgs, uengShaderPartClass,
uengShaderPartProc, uengShaderPartKeyValuePair;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -16,6 +17,8 @@ type
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;
@@ -28,7 +31,6 @@ type
private
function GetParameters: TStrings;
public
property Name: String read fName;
property Parameters: TStrings read GetParameters;

constructor Create(const aParent: TengShaderPart); override;
@@ -41,8 +43,12 @@ type

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TengShaderPartInherited = class(TengShaderPartCall)
{ Class Methods }
{ 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 }
@@ -58,23 +64,44 @@ type
implementation

uses
uengShaderPartProc, uengShaderPartClass, uengShaderFileConstants, uengShaderFileTypes,
uengShaderFileHelper, uengShaderGenerator, uengShaderFile;
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;
if (fName <> '') then
result := result + ' ' + fName;
result := TOKEN_CHAR_BEGIN + GetTokenName + ' ' + fName;
for i := 0 to fParameters.Count-1 do begin
if (PtrInt(fParameters.Objects[i]) <> 0)
then result := result + ' ' + TOKEN_CHAR_QUOTE + fParameters[i] + TOKEN_CHAR_QUOTE
else result := result + ' ' + fParameters[i];
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;
@@ -89,15 +116,18 @@ begin
if (aParams.Count < 2) then
raise EengInvalidParamterCount.Create(GetTokenName, 2, -1, self);

result := '';
fParameters.Clear;
with aParams[1] do begin
if not IsValidIdentifier(fName) then
raise EengInvalidIdentifier.Create(Name, self);
fName := Name;

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;
for i := 2 to aParams.Count-1 do
fParameters.AddObject(aParams[i].Name, TObject(PtrInt(aParams[i].Quoted)));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -111,7 +141,7 @@ begin
sr := TengSearchResults.Create;
walker := TengProcSearchWalker.Create(sr);
try
walker.Name := Name;
walker.Name := fName;
walker.SearchFlags := [sfEvaluateIf, sfSearchChildren, sfSearchInherited];
walker.ChildrenDoNotLeave := CengShaderPartArr.Create(TengShaderGenerator);
walker.ChildrenForceLeave := CengShaderPartArr.Create(TengShaderFile);
@@ -160,25 +190,92 @@ 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 := '';
fName := '';
result := '';
fClass := nil;
fInline := false;
expected := [epClass, epProc, epParam];
fParameters.Clear;
if (aParams.Count >= 2) then begin
if not IsValidIdentifier(aParams[1].Name) and (aParams[1].Name <> TOKEN_MAIN) then
with aParams[1] do
raise EengInvalidIdentifier.Create(Name, Line, Col, Filename, self);
fName := aParams[1].Name;
for i := 2 to aParams.Count-1 do
fParameters.AddObject(aParams[i].Name, TObject(PtrInt(aParams[i].Quoted)));
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;
result := '';
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -188,20 +285,22 @@ procedure TengShaderPartInherited.GenerateCodeIntern(const aArgs: TengShaderGene
var
sr: TengSearchResults;
walker: TengProcSearchWalker;
ParentProc: TengShaderPartProc;
c: TengShaderPartClass;
begin
sr := TengSearchResults.Create;
walker := TengProcSearchWalker.Create(sr);
try
ParentProc := (GetParent(TengShaderPartProc) as TengShaderPartProc);
walker.Name := Name;
walker.Name := fName;
if (walker.Name = '') then
walker.Name := ParentProc.Name;
walker.Owner := ParentProc;
walker.SearchFlags := [sfEvaluateIf, sfIgnoreOwner, sfSearchChildrenLazy, sfSearchInherited];
walker.Name := (GetParent(TengShaderPartProc) as TengShaderPartProc).Name;
walker.SearchFlags := [sfEvaluateIf, sfSearchChildren, sfSearchInherited];
walker.ParentsDoNotLeave := CengShaderPartArr.Create(TengShaderPartClass);
walker.ChildrenDoNotLeave := CengShaderPartArr.Create(TengShaderPartClass);
walker.Run(ParentProc);
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);
@@ -211,7 +310,9 @@ procedure TengShaderPartInherited.GenerateCodeIntern(const aArgs: TengShaderGene

procedure GenCode(const aProc: TengShaderPartProc; const aParams: TStrings);
begin
aArgs.PushFlags(aArgs.Flags + [gfGenerateInlineCode]);
if fInline
then aArgs.PushFlags(aArgs.Flags + [gfGenerateInlineCode, gfGenerateProcedureCall] - [gfGenerateProcedureCode])
else aArgs.PushFlags(aArgs.Flags + [gfGenerateProcedureCall] - [gfGenerateProcedureCode]);
aArgs.PushProcParams(aParams);
try
aProc.GenerateCodeIntern(aArgs);
@@ -231,6 +332,9 @@ begin
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;


+ 1
- 1
uengShaderPartClass.pas View File

@@ -207,7 +207,7 @@ begin
walker.ResultTypes := CengShaderPartArr.Create(TengShaderPartMain);
walker.Run(self);
main := (ExtractSearchResult(self, TengShaderPartMain.GetTokenName, sr) as TengShaderPartMain);
aArgs.PushFlags([gfGenerateProcedureCode]);
aArgs.PushFlags([gfGenerateProcedureCode, gfGenerateProcedureMain]);
try
main.GenerateCodeIntern(aArgs);
finally


+ 0
- 1
uengShaderPartEcho.pas View File

@@ -68,7 +68,6 @@ begin
walker.ParentsDoNotLeave := CengShaderPartArr.Create(TengShaderFile);
walker.SearchFlags := [
sfSearchChildrenLazy,
sfSearchChildren,
sfSearchParents
];
walker.Run(self);


+ 0
- 1
uengShaderPartKeyValuePair.pas View File

@@ -147,7 +147,6 @@ begin
walker.ParentsDoNotLeave := CengShaderPartArr.Create(TengShaderFile);
walker.SearchFlags := [
sfSearchChildrenLazy,
sfSearchChildren,
sfSearchParents
];
walker.Run(self);


+ 33
- 18
uengShaderPartProc.pas View File

@@ -39,7 +39,7 @@ type

{ Code Generation }
protected
function GenerateHeaderCode: String; virtual;
function GenerateHeaderCode(const aArgs: TengShaderGeneratorArgs): String; virtual;
procedure GenerateInlineCode(const aArgs: TengShaderGeneratorArgs); virtual;
public
procedure GenerateCodeIntern(const aArgs: TengShaderGeneratorArgs); override;
@@ -68,7 +68,7 @@ type

{ Code Generation }
protected
function GenerateHeaderCode: String; override;
function GenerateHeaderCode(const aArgs: TengShaderGeneratorArgs): String; override;

{ General }
public
@@ -86,7 +86,7 @@ type

{ Code Generation }
protected
function GenerateHeaderCode: String; override;
function GenerateHeaderCode(const aArgs: TengShaderGeneratorArgs): String; override;
procedure GenerateInlineCode(const aArgs: TengShaderGeneratorArgs); override;

{ Class Methods }
@@ -98,7 +98,7 @@ implementation

uses
RegExpr,
uengShaderFileConstants, uengShaderFileTypes, uengShaderFileHelper;
uengShaderFileConstants, uengShaderFileTypes, uengShaderFileHelper, uengShaderPartClass;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengShaderPartProc////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -184,9 +184,10 @@ begin
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartProc.GenerateHeaderCode: String;
function TengShaderPartProc.GenerateHeaderCode(const aArgs: TengShaderGeneratorArgs): String;
var
p: TengShaderPartProcParam;
c: TengShaderPartClass;
begin
result := '';
for p in fParameters do begin
@@ -196,7 +197,9 @@ begin
end;
if (result = '') then
result := 'void';
result := 'void ' + fName + '(' + result + ')';
if GetParent(TengShaderPartClass, c)
then result := 'void ' + c.Name + '_' + fName + '(' + result + ')'
else result := 'void ' + fName + '(' + result + ')';
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -240,6 +243,7 @@ end;
procedure TengShaderPartProc.GenerateCodeIntern(const aArgs: TengShaderGeneratorArgs);
var
s, params: String;
c: TengShaderPartClass;
begin
// generate inline code
if (aArgs.Flags * [gfGenerateProcedureCall, gfGenerateProcedureCode] <> []) and
@@ -252,7 +256,7 @@ begin
end else if (gfGenerateProcedureCode in aArgs.Flags) then begin
aArgs
.AddLineBreak
.AddText(GenerateHeaderCode)
.AddText(GenerateHeaderCode(aArgs))
.AddLineBreak
.AddCommandEnd('{')
.AddLineBreak
@@ -274,7 +278,9 @@ begin
params := params + ', ';
params := params + s;
end;
aArgs.AddText(fName + '(' + params + ')');
if GetParent(TengShaderPartClass, c)
then aArgs.AddText(c.Name + '_' + fName + '(' + params + ')')
else aArgs.AddText(fName + '(' + params + ')');
aArgs.AddProcedure(self);
end;
end;
@@ -327,9 +333,13 @@ begin
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartMain.GenerateHeaderCode: String;
function TengShaderPartMain.GenerateHeaderCode(const aArgs: TengShaderGeneratorArgs): String;
var
c: TengShaderPartClass;
begin
result := 'void main(void)';
if not (gfGenerateProcedureMain in aArgs.Flags) and GetParent(TengShaderPartClass, c)
then result := 'void ' + c.Name + '_main(void)'
else result := 'void main(void)';
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -368,9 +378,10 @@ begin
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartFunc.GenerateHeaderCode: String;
function TengShaderPartFunc.GenerateHeaderCode(const aArgs: TengShaderGeneratorArgs): String;
var
p: TengShaderPartProcParam;
c: TengShaderPartClass;
begin
result := '';
for p in fParameters do begin
@@ -380,7 +391,9 @@ begin
end;
if (result = '') then
result := 'void';
result := fReturnType + ' ' + fName + '(' + result + ')';
if GetParent(TengShaderPartClass, c)
then result := fReturnType + ' ' + c.Name + '_' + fName + '(' + result + ')'
else result := fReturnType + ' ' + fName + '(' + result + ')';
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -392,15 +405,17 @@ begin
csi := TengShaderGeneratorArgs.TCodeStackItem.Create;
try
indent := aArgs.ExtractCurrentCommand(csi);
aArgs.PushCode;
aArgs.BeginBlock;
aArgs
.PushCode
.BeginBlock;
try
inherited GenerateInlineCode(aArgs);
finally
aArgs.EndBlock;
aArgs.AddText(StringOfChar(' ', indent));
aArgs.ReplaceReturns(csi, fReturnType, fName);
aArgs.PopCode([pcfAppend]);
aArgs
.EndBlock
.AddText(StringOfChar(' ', indent))
.ReplaceReturns(csi, fReturnType, fName)
.PopCode([pcfAppend]);
end;
finally
FreeAndNil(csi);


Loading…
Cancel
Save