Browse Source

* implemented TengShaderGeneratorEx (to support multiple property configurations at once)

master
Bergmann89 8 years ago
parent
commit
46d9bcc9e4
9 changed files with 308 additions and 25 deletions
  1. +14
    -4
      tests/ShaderFileTests.lpi
  2. +1
    -1
      tests/ShaderFileTests.lpr
  3. +4
    -0
      tests/testfiles/code_Generator_DefaultValues.shdr
  4. +55
    -1
      tests/uShaderFileTestCase.pas
  5. +8
    -6
      uengShaderFile.pas
  6. +1
    -0
      uengShaderFileTypes.pas
  7. +56
    -12
      uengShaderGenerator.pas
  8. +164
    -0
      uengShaderGeneratorEx.pas
  9. +5
    -1
      uengShaderPartKeyValuePair.pas

+ 14
- 4
tests/ShaderFileTests.lpi View File

@@ -9,7 +9,6 @@
<Title Value="ShaderFileTests"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
@@ -39,7 +38,7 @@
<PackageName Value="FCL"/>
</Item3>
</RequiredPackages>
<Units Count="27">
<Units Count="28">
<Unit0>
<Filename Value="ShaderFileTests.lpr"/>
<IsPartOfProject Value="True"/>
@@ -56,14 +55,17 @@
<Unit3>
<Filename Value="..\uengShaderFileTypes.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uengShaderFileTypes"/>
</Unit3>
<Unit4>
<Filename Value="..\uengShaderFile.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uengShaderFile"/>
</Unit4>
<Unit5>
<Filename Value="..\uengShaderGenerator.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uengShaderGenerator"/>
</Unit5>
<Unit6>
<Filename Value="..\uengShaderFileConstants.pas"/>
@@ -76,6 +78,7 @@
<Unit8>
<Filename Value="..\uengShaderFileHelper.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uengShaderFileHelper"/>
</Unit8>
<Unit9>
<Filename Value="..\uengShaderFileParser.pas"/>
@@ -88,15 +91,16 @@
<Unit11>
<Filename Value="..\uengShaderGeneratorArgs.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uengShaderGeneratorArgs"/>
</Unit11>
<Unit12>
<Filename Value="..\uengShaderPartCall.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uengShaderPartCall"/>
</Unit12>
<Unit13>
<Filename Value="..\uengShaderPartClass.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uengShaderPartClass"/>
</Unit13>
<Unit14>
<Filename Value="..\uengShaderPartCntr.pas"/>
@@ -121,6 +125,7 @@
<Unit19>
<Filename Value="..\uengShaderPartKeyValuePair.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uengShaderPartKeyValuePair"/>
</Unit19>
<Unit20>
<Filename Value="..\uengShaderPartMessage.pas"/>
@@ -150,6 +155,11 @@
<Filename Value="..\uengShaderCodePart.pas"/>
<IsPartOfProject Value="True"/>
</Unit26>
<Unit27>
<Filename Value="..\uengShaderGeneratorEx.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uengShaderGeneratorEx"/>
</Unit27>
</Units>
</ProjectOptions>
<CompilerOptions>
@@ -159,7 +169,7 @@
<Filename Value="ShaderFileTests"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir);.."/>
<IncludeFiles Value="$(ProjOutDir);..\inc"/>
<OtherUnitFiles Value="..;..\..\Utils"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>


+ 1
- 1
tests/ShaderFileTests.lpr View File

@@ -3,7 +3,7 @@ program ShaderFileTests;
{$mode objfpc}{$H+}

uses
Interfaces, Forms, GuiTestRunner, uShaderFileTestCase;
Interfaces, Forms, GuiTestRunner, uShaderFileTestCase, uengShaderGeneratorEx;

{$R *.res}



+ 4
- 0
tests/testfiles/code_Generator_DefaultValues.shdr View File

@@ -0,0 +1,4 @@
{$PROPERTY TestProperty1 '0'}
{$PROPERTY TestProperty2 'asd'}
{$PROPERTY TestProperty3 'false'}
{$PROPERTY TestProperty4}

+ 55
- 1
tests/uShaderFileTestCase.pas View File

@@ -6,7 +6,7 @@ interface

uses
Classes, SysUtils, fpcunit, testregistry,
uengShaderFile, uengShaderGenerator, uengShaderFileTypes;
uengShaderFile, uengShaderGenerator, uengShaderFileTypes, uengShaderGeneratorEx;

type
TShaderFileTestCase = class(TTestCase)
@@ -57,6 +57,11 @@ type
procedure OrderOfMainProcClassContent;
end;

TTestCase_Generator = class(TShaderFileTestCase)
published
procedure DefaultValues;
end;

implementation

uses
@@ -219,12 +224,61 @@ begin
DoTest('code_General_OrderOfMainProcClassContent.shdr', 'TestClass', 'result_General_OrderOfMainProcClassContent.shdr');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TTestCase_Generator//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TTestCase_Generator.DefaultValues;
var
shdr: TengShaderFile;
gen: TengShaderGeneratorEx;
code: TengShaderCode;
v: Variant;
i: Integer;
begin
shdr := TengShaderFile.Create;
code := TengShaderCode.Create;
try
shdr.LoadFromFile(ExpandFileName('testfiles\code_Generator_DefaultValues.shdr'));

for i := 0 to 3 do begin
gen := TengShaderGeneratorEx.Create(shdr, '');
try
AssertEquals(true, gen.TryGetProperty('TestProperty1', v));
AssertEquals(0, v);

AssertEquals(true, gen.TryGetProperty('TestProperty2', v));
AssertEquals('asd', v);

AssertEquals(true, gen.TryGetProperty('TestProperty3', v));
AssertEquals(false, v);

AssertEquals(true, gen.TryGetProperty('TestProperty4', v));
AssertTrue(Unassigned = v);

AssertEquals(true, gen.TrySetProperty('TestProperty1', 101));
AssertEquals(true, gen.TrySetProperty('TestProperty2', 102));
AssertEquals(true, gen.TrySetProperty('TestProperty3', 103));
AssertEquals(true, gen.TrySetProperty('TestProperty4', 104));

gen.Generate(code);
finally
FreeAndNil(gen);
end;
end;
finally
FreeAndNil(code);
FreeAndNil(shdr);
end;
end;


initialization
RegisterTest(TTestCase_IfElifElseEnd);
RegisterTest(TTestCase_FuncProcMain);
RegisterTest(TTestCase_Include);
RegisterTest(TTestCase_Class);
RegisterTest(TTestCase_General);
RegisterTest(TTestCase_Generator);

end.


+ 8
- 6
uengShaderFile.pas View File

@@ -50,10 +50,10 @@ type
protected
procedure LogMsgIntern(const aSender: TengShaderPart; const aLogLevel: TengShaderPartLogLevel; const aMsg: String); override;
public
property Generator [const aName: String]: TengShaderGenerator read GetGenerator;
property GeneratorNames[const aIndex: Integer]: String read GetGeneratorNames;
property GeneratorCount: Integer read GetGeneratorCount;
property OnLog: TengShaderFileLogEvent read fOnLog write fOnLog;
property Generator [const aName: String]: TengShaderGenerator read GetGenerator;
property GeneratorNames[const aIndex: Integer]: String read GetGeneratorNames;
property GeneratorCount: Integer read GetGeneratorCount;
property OnLog: TengShaderFileLogEvent read fOnLog write fOnLog;

procedure Clear; override;
constructor Create; overload;
@@ -71,9 +71,11 @@ uses
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderFile.GetGenerator(const aName: String): TengShaderGenerator;
begin
result := fClasses[aName];
if (aName = '')
then result := self
else result := fClasses[aName];
if not Assigned(result) then
result := self;
raise EengUnknownIdentifier.Create(aName, self);
end;

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


+ 1
- 0
uengShaderFileTypes.pas View File

@@ -68,6 +68,7 @@ type
);

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TStringVariantMap = specialize TutlMap<string, variant>;
TengShaderCode = class(TStringList)

end;


+ 56
- 12
uengShaderGenerator.pas View File

@@ -8,13 +8,23 @@ interface
uses
Classes, SysUtils,
uengShaderPart, uengShaderFileTypes, uengShaderFileParser, uengShaderPartScope,
uengShaderPartKeyValuePair, uengShaderGeneratorArgs;
uengShaderPartKeyValuePair, uengShaderGeneratorArgs

{$IFDEF SHADER_FILE_USE_BITSPACE_UTILS}
, uutlGenerics
{$ELSE}
, uengShaderFileGenerics
{$ENDIF}
;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TengShaderGenerator = class(TengShaderPartScope)
{ Code Loading & Storage }
private type
TNotifyEventList = specialize TutlList<TNotifyEvent>;
private
fOnDestroyEvents: TNotifyEventList;
fPropertyMap: TengShaderPartPropertyMap;

function GetPropertyByIndex(const aIndex: Integer): Variant;
@@ -38,6 +48,7 @@ type
function TryGetProperty(const aName: String; out aValue: Variant): Boolean;
function TrySetProperty(const aName: String; const aValue: Variant): Boolean;
procedure ListProperties(const aPropertyNames: TStrings);
procedure DuplicateProperties(const aMap: TStringVariantMap);

{ Generate Shader Code }
public
@@ -45,6 +56,9 @@ type

{ General }
public
procedure AddOnDestroyEvent(const aEvent: TNotifyEvent);
procedure RemoveOnDestroyEvent(const aEvent: TNotifyEvent);

constructor Create(const aParent: TengShaderPart); override;
destructor Destroy; override;
end;
@@ -107,28 +121,31 @@ procedure TengShaderGenerator.AddProperty(const aProp: TengShaderPartProperty; c
var
i: Integer;
l: TengShaderPartPropertyList;
p: TengShaderPartProperty;
s: String;
begin
i := -1;
l := fPropertyMap[aProp.Name];
if Assigned(l) then begin
i := l.IndexOf(aProp);
if aShowWarning and (i >= 0) then begin
p := l.Last;
if (l.IndexOf(aProp) >= 0) then
exit;
if aShowWarning and (l.Count > 0) then begin
s := Format('use of duplicate identifier: %s (%s %d:%d)', [aProp.Name, aProp.Filename, aProp.Line + 1, aProp.Col]) + sLineBreak +
'previously declared here:' + sLineBreak +
Format(' %s %d:%d', [p.Filename, p.Line + 1, p.Col]) + sLineBreak;
'previously declared here:' + sLineBreak;
i := l.Count-1;
while (i >= 0) do begin
s := s + Format(' %s %d:%d', [l[i].Filename, l[i].Line + 1, l[i].Col]) + sLineBreak;
dec(i);
end;
LogMsg(llWarning, s);
end;
end else begin
l := TengShaderPartPropertyList.Create;
fPropertyMap.Add(aProp.Name, l);
end;
if (i < 0) then begin
l.Add(aProp);
if (aProp.Value <> Unassigned) then
l.Value := aProp.Value;
l.Add(aProp);
if (aProp.DefaultValue <> Unassigned) then begin
l.DefaultValue := aProp.DefaultValue;
l.Value := l.DefaultValue;
end;
end;

@@ -188,6 +205,15 @@ begin
aPropertyNames.Add(s);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGenerator.DuplicateProperties(const aMap: TStringVariantMap);
var
kvp: TengShaderPartPropertyMap.TKeyValuePair;
begin
for kvp in fPropertyMap.KeyValuePairs do
aMap.Add(kvp.Key, kvp.Value.DefaultValue);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGenerator.GenerateCode(const aCode: TengShaderCode);
var
@@ -245,17 +271,35 @@ begin
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGenerator.AddOnDestroyEvent(const aEvent: TNotifyEvent);
begin
fOnDestroyEvents.Add(aEvent);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGenerator.RemoveOnDestroyEvent(const aEvent: TNotifyEvent);
begin
fOnDestroyEvents.Remove(aEvent);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TengShaderGenerator.Create(const aParent: TengShaderPart);
begin
inherited Create(aParent);
fPropertyMap := TengShaderPartPropertyMap.Create(true);
fPropertyMap := TengShaderPartPropertyMap.Create(true);
fOnDestroyEvents := TNotifyEventList.Create(true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TengShaderGenerator.Destroy;
var
e: TNotifyEvent;
begin
for e in fOnDestroyEvents do
e(self);
FreeAndNil(fPropertyMap);
FreeAndNil(fOnDestroyEvents);
inherited Destroy;
end;



+ 164
- 0
uengShaderGeneratorEx.pas View File

@@ -0,0 +1,164 @@
unit uengShaderGeneratorEx;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils,
uengShaderFile, uengShaderGenerator, uengShaderFileTypes;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{ almost the same as TengShaderGenerator, but this is the extended version, that creates a copy of
all properties. So you can keep more then one gerator configurations at once. It is a little bit slower
than the normal generator. If you not need multiple configurations at once, use the simple one (TengShaderGenerator) }
TengShaderGeneratorEx = class(TObject)
private
fName: String;
fGeneratorPart: TengShaderGenerator;

function GetPropertyByIndex(const aIndex: Integer): Variant;
function GetPropertyByName(const aName: String): Variant;
function GetPropertyCount: Integer;
function GetPropertyNames(const aIndex: Integer): String;

procedure SetPropertyByIndex(const aIndex: Integer; aValue: Variant);
procedure SetPropertyByName(const aName: String; aValue: Variant);

procedure GeneratorPartDestroy(aSender: TObject);
protected
fProperties: TStringVariantMap;
public
property Name: String read fName write fName;
property PropertyByName [const aName: String]: Variant read GetPropertyByName write SetPropertyByName;
property PropertyByIndex[const aIndex: Integer]: Variant read GetPropertyByIndex write SetPropertyByIndex;
property PropertyNames [const aIndex: Integer]: String read GetPropertyNames;
property PropertyCount: Integer read GetPropertyCount;

function TryGetProperty(const aName: String; out aValue: Variant): Boolean;
function TrySetProperty(const aName: String; const aValue: Variant): Boolean;
procedure ListProperties(const aPropertyNames: TStrings);

procedure GenerateCode(const aCode: TengShaderCode);

constructor Create(const aShaderFile: TengShaderFile; const aName: String);
destructor Destroy; override;
end;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengShaderGeneratorEx///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorEx.GetPropertyByIndex(const aIndex: Integer): Variant;
begin
result := fProperties.ValueAt[aIndex];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorEx.GetPropertyByName(const aName: String): Variant;
var
i: Integer;
begin
i := fProperties.IndexOf(aName);
if (i < 0) then
raise EengUnknownIdentifier.Create(aName, self);
result := fProperties.ValueAt[i];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorEx.GetPropertyCount: Integer;
begin
result := fProperties.Count;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorEx.GetPropertyNames(const aIndex: Integer): String;
begin
result := fProperties.Keys[aIndex];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorEx.SetPropertyByIndex(const aIndex: Integer; aValue: Variant);
begin
fProperties.ValueAt[aIndex] := aValue;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorEx.SetPropertyByName(const aName: String; aValue: Variant);
var
i: Integer;
begin
i := fProperties.IndexOf(aName);
if (i < 0) then
raise EengUnknownIdentifier.Create(aName, self);
fProperties.ValueAt[i] := aValue;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorEx.GeneratorPartDestroy(aSender: TObject);
begin
fGeneratorPart := nil;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorEx.TryGetProperty(const aName: String; out aValue: Variant): Boolean;
var
i: Integer;
begin
i := fProperties.IndexOf(aName);
result := (i >= 0);
if result then
aValue := fProperties.ValueAt[i];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorEx.TrySetProperty(const aName: String; const aValue: Variant): Boolean;
var
i: Integer;
begin
i := fProperties.IndexOf(aName);
result := (i >= 0);
if result then
fProperties.ValueAt[i] := aValue;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorEx.ListProperties(const aPropertyNames: TStrings);
var
s: String;
begin
for s in fProperties.Keys do
aPropertyNames.Add(s);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorEx.GenerateCode(const aCode: TengShaderCode);
var
kvp: TStringVariantMap.TKeyValuePair;
begin
if not Assigned(fGeneratorPart) then
EengShaderPartInternal.Create('unable to generate code: generator is not available anymore');
for kvp in fProperties.KeyValuePairs do
fGeneratorPart.TrySetProperty(kvp.Key, kvp.Value);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TengShaderGeneratorEx.Create(const aShaderFile: TengShaderFile; const aName: String);
begin
inherited Create;
fProperties := TStringVariantMap.Create;
fGeneratorPart := aShaderFile.Generator[aName];
fGeneratorPart.DuplicateProperties(fProperties);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TengShaderGeneratorEx.Destroy;
begin
FreeAndNil(fProperties);
inherited Destroy;
end;

end.


+ 5
- 1
uengShaderPartKeyValuePair.pas View File

@@ -55,9 +55,13 @@ type
TengShaderPartPropertyList = class(specialize TutlList<TengShaderPartProperty>)
private
fValue: Variant;
fDefaultValue: Variant;
public
property Value: Variant read fValue write fValue;
property Value: Variant read fValue write fValue;
property DefaultValue: Variant read fDefaultValue write fDefaultValue;

procedure ApplyValue;

constructor Create;
end;



Loading…
Cancel
Save