ShaderFile/uengShaderGenerator.pas

unit uengShaderGenerator;

{$mode objfpc}{$H+}
{$I uengShaderFile.inc}

interface

uses
  Classes, SysUtils,
  uengShaderPart, uengShaderFileTypes, uengShaderFileParser, uengShaderPartScope,
  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;
    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);
  protected
    procedure AddProperty(const aProp: TengShaderPartProperty; const aShowWarning: Boolean = true);
    procedure CopyProperties(const aGen: TengShaderGenerator);
    procedure UpdateProperties; virtual;
    function ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String; override;
  public
    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 DuplicateProperties(const aMap: TStringVariantMap);

  { Generate Shader Code }
  public
    procedure GenerateCode(const aCode: TengShaderCode);

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

    constructor Create(const aParent: TengShaderPart); override;
    destructor Destroy; override;
  end;

implementation

uses
  uengShaderFile, uengShaderFileHelper, uengShaderPartProc, uengShaderPartParameter;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengShaderGenerator///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGenerator.GetPropertyByIndex(const aIndex: Integer): Variant;
begin
  result := fPropertyMap.ValueAt[aIndex].Value;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGenerator.GetPropertyByName(const aName: String): Variant;
var
  l: TengShaderPartPropertyList;
begin
  l := fPropertyMap[aName];
  if not Assigned(l) then
    EengUnknownIdentifier.Create(aName, self);
  result := l.Value;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGenerator.GetPropertyCount: Integer;
begin
  result := fPropertyMap.Count;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGenerator.GetPropertyNames(const aIndex: Integer): String;
begin
  result := fPropertyMap.KeyValuePairs[aIndex].Key;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGenerator.SetPropertyByIndex(const aIndex: Integer; aValue: Variant);
begin
  fPropertyMap.ValueAt[aIndex].Value := aValue;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGenerator.SetPropertyByName(const aName: String; aValue: Variant);
var
  l: TengShaderPartPropertyList;
begin
  l := fPropertyMap[aName];
  if not Assigned(l) then
    raise EengUnknownIdentifier.Create(aName, self);
  l.Value := aValue;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGenerator.AddProperty(const aProp: TengShaderPartProperty; const aShowWarning: Boolean);
var
  i: Integer;
  l: TengShaderPartPropertyList;
  s: String;
begin
  i := -1;
  l := fPropertyMap[aProp.Name];
  if Assigned(l) then begin
    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;
      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;
  l.Add(aProp);
  if (aProp.DefaultValue <> Unassigned) then begin
    l.DefaultValue := aProp.DefaultValue;
    l.Value        := l.DefaultValue;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGenerator.CopyProperties(const aGen: TengShaderGenerator);
var
  l: TengShaderPartPropertyList;
  p: TengShaderPartProperty;
begin
  for l in fPropertyMap do
    for p in l do
      aGen.AddProperty(p, false);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGenerator.UpdateProperties;
begin
  fPropertyMap.Clear;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGenerator.ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String;
begin
  result := inherited ParseIntern(aArgs, aParams);
  UpdateProperties;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGenerator.TryGetProperty(const aName: String; out aValue: Variant): Boolean;
var
  l: TengShaderPartPropertyList;
begin
  l := fPropertyMap[aName];
  result := Assigned(l);
  if result
    then aValue := l.Value
    else aValue := unassigned;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGenerator.TrySetProperty(const aName: String; const aValue: Variant): Boolean;
var
  l: TengShaderPartPropertyList;
begin
  l := fPropertyMap[aName];
  result := Assigned(l);
  if result then
    l.Value := aValue;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGenerator.ListProperties(const aPropertyNames: TStrings);
var
  s: String;
begin
  for s in fPropertyMap.Keys do
    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
  args: TengShaderGeneratorArgs;
  sr: TengSearchResults;
  walker: TengSearchWalker;
  main: TengShaderPartMain;
begin
  args := TengShaderGeneratorArgs.Create(self);
  try
    fPropertyMap.ApplyValues;
    GenerateCodeIntern(args);

    args.PushCode;
    sr := TengSearchResults.Create;
    walker := TengSearchWalker.Create(sr);
    try
      walker.SearchFlags        := [sfSearchChildren, sfEvaluateIf, sfSearchInherited];
      walker.ResultTypes        := CengShaderPartArr.Create(TengShaderPartMain);
      walker.ChildrenDoNotLeave := CengShaderPartArr.Create(TengShaderGenerator);
      walker.ChildrenForceLeave := CengShaderPartArr.Create(TengShaderFile);
      walker.Run(self);
      if (self is TengShaderFile)
        then main := (ExtractSearchResult(self, TengShaderPartMain.GetTokenName, sr, []) as TengShaderPartMain)
        else main := (ExtractSearchResult(self, TengShaderPartMain.GetTokenName, sr) as TengShaderPartMain);
      if Assigned(main) then begin
        args.PushFlags((args.Flags * [gfAddProcedureItem, gfAddParameterItem]) + [gfGenerateProcedureCode, gfGenerateProcedureMain]);
        try
          main.GenerateCodeIntern(args);
        finally
          args.PopFlags;
        end;
      end;

      args.GenerateProcedureCode;
      args.GenerateParameterCode(CengShaderPartArr.Create(TengShaderPartVar));
      args.GenerateParameterCode(CengShaderPartArr.Create(TengShaderPartVarying));
      args.GenerateParameterCode(CengShaderPartArr.Create(TengShaderPartUniform));
    finally
      FreeAndNil(walker);
      FreeAndNil(sr);
      args.PopCode([pcfAppend, pcfAddEmptyLine]);
    end;

    args.PushCode;
    try
      args.GenerateMetaCode;
    finally
      args.PopCode([pcfPrepend, pcfAddEmptyLine]);
    end;

    args.GenerateCode(aCode);
  finally
    FreeAndNil(args);
  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);
  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;

end.