ShaderFile/uengShaderFile.pas

unit uengShaderFile;

{ Package:      SpaceEngine
  Prefix:       eng - ENGine
  Beschreibung: stellt Klassen zum laden von Shader-Datein zur Verfügung
                beim laden des Codes wird gleichzeitig die Präprozessor-Sprache ausgewertet }

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

interface

uses
  Classes, sysutils,
  uengShaderPart, uengShaderPartClass, uengShaderFileParser, uengShaderFileTypes,
  uengShaderGenerator, uengShaderGeneratorArgs

{$IFDEF USE_BITSPACE_UTILS}
  , uutlSerialization
{$ENDIF}
  ;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TengShaderFileLogEvent = procedure(const aSender: TengShaderPart; const aLogLevel: TengShaderPartLogLevel; const aMsg: String) of object;
  TengShaderFile = class(TengShaderGenerator)
  { Code Loading & Storage }
  private
    fFilename: String;
    fFileReader: IutlFileReader;
    fFileWriter: IutlFileWriter;
    fClasses: TengShaderPartClassMap;
  private
    function GetGenerator(const aName: String): TengShaderGenerator;
    function GetGeneratorCount: Integer;
    function GetGeneratorNames(const aIndex: Integer): String;
    procedure UpdateClasses;
  protected
    function GetFilename: String; override;
    function GetFileReader: IengShaderFileReader; override;
    function GetFileWriter: IengShaderFileWriter; override;
    procedure UpdateProperties; override;
  public
    procedure LoadFromFile(const aFilename: String; const aFileReader: IengShaderFileReader = nil);
    procedure SaveToFile(const aFilename: String; const aFileWriter: IengShaderFileWriter = nil);

  { Code Generation }
  public
    procedure GenerateCodeIntern(const aArgs: TengShaderGeneratorArgs); override;

  { General }
  private
    fOnLog: TengShaderFileLogEvent;
  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;

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

implementation

uses
  uengShaderPartInclude, uengShaderPartKeyValuePair, uengShaderFileHelper, uengShaderPartProc;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengShaderFile////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderFile.GetGenerator(const aName: String): TengShaderGenerator;
begin
  result := fClasses[aName];
  if not Assigned(result) then
    result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderFile.GetGeneratorCount: Integer;
begin
  result := fClasses.Count+1;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderFile.GetGeneratorNames(const aIndex: Integer): String;
begin
  if (aIndex < 0) or (aIndex >= Count) then
    raise EengOutOfRange.Create(0, Count-1, aIndex, self);
  if (aIndex = 0)
    then result := ''
    else result := fClasses.Keys[aIndex-1];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderFile.UpdateClasses;

  procedure AddClass(const aClass: TengShaderPartClass);
  var
    c: TengShaderPartClass;
    s: String;
  begin
    c := fClasses[aClass.Name];
    if Assigned(c) then begin
      s := Format('use of duplicate identifier: %s (%s %d:%d)', [aClass.Name, aClass.Filename, aClass.Line + 1, aClass.Col]) + sLineBreak +
           'previously declared here:' + sLineBreak +
           Format('  %s %d:%d', [c.Filename, c.Line + 1, c.Col]) + sLineBreak;
      LogMsg(llWarning, s);
      fClasses[aClass.Name] := aClass;
    end else
      fClasses.Add(aClass.Name, aClass);
  end;

var
  sr: TengSearchResults;
  walker: TengSearchWalker;
  p: TengShaderPart;
begin
  sr := TengSearchResults.Create;
  walker := TengSearchWalker.Create(sr);
  try
    walker.ResultTypes := CengShaderPartArr.Create(TengShaderPartClass);
    walker.SearchFlags := [sfSearchChildren];
    fClasses.Clear;
    for p in sr do
      AddClass(p as TengShaderPartClass);
  finally
    FreeAndNil(walker);
    FreeAndNil(sr);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderFile.GetFilename: String;
begin
  result := fFilename;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderFile.GetFileReader: IengShaderFileReader;
begin
  result := fFileReader;
  if not Assigned(result) and Assigned(Parent) then
    result := Parent.FileReader;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderFile.GetFileWriter: IengShaderFileWriter;
begin
  result := fFileWriter;
  if not Assigned(result) and Assigned(Parent) then
    result := Parent.FileWriter;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderFile.UpdateProperties;
var
  sr: TengSearchResults;
  walker: TengSearchWalker;
  p: TengShaderPart;
begin
  inherited UpdateProperties;

  sr := TengSearchResults.Create;
  walker := TengSearchWalker.Create(sr);
  try
    walker.Owner              := self;
    walker.SearchFlags        := [sfSearchChildren, sfIgnoreOwner];
    walker.ResultTypes        := CengShaderPartArr.Create(TengShaderFile);
    walker.ChildrenDoNotLeave := CengShaderPartArr.Create(TengShaderGenerator);
    walker.Run(self);
    for p in sr do
      (p as TengShaderFile).CopyProperties(self);

    walker.ResultTypes := CengShaderPartArr.Create(TengShaderPartProperty);
    sr.Clear;
    walker.Run(self);
    for p in sr do
      AddProperty(p as TengShaderPartProperty);
  finally
    FreeAndNil(walker);
    FreeAndNil(sr);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderFile.LoadFromFile(const aFilename: String; const aFileReader: IengShaderFileReader);
var
  args: TengParseArgs;
  token: String;
  ms: TMemoryStream;
begin
  fFileReader := aFileReader;
  if not Assigned(fFileReader) then
    fFileReader := GetFileReader;
  if not Assigned(fFileReader) then
    fFileReader := TengShaderFileReader.Create;
  ms := TMemoryStream.Create;
  try
    Clear;
    if not fFileReader.LoadStream(aFilename, ms) then
      raise EengShaderPart.Create('unable to open file: ' + aFilename, Parent);
    ms.Position := 0;
    fFilename   := aFilename;
    args := TengParseArgs.Create(ms, Filename);
    try
      token := ParseText(args);
      if (token <> '') then with args do
        raise EengShaderPart.Create('unknown token ''' + token + '''', Line, Col, Filename, self);
      if (self = Root) then
        UpdateClasses;
    finally
      FreeAndNil(args);
    end;
  finally
    FreeAndNil(ms);
    fFileReader := nil;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderFile.SaveToFile(const aFilename: String; const aFileWriter: IengShaderFileWriter);
var
  i: Integer;
  sr: TengSearchResults;
  sl: TStringList;
  ms: TMemoryStream;
  walker: TengSearchWalker;
begin
  fFileWriter := aFileWriter;
  if not Assigned(fFileWriter) then
    fFileWriter := FileWriter;
  if not Assigned(fFileWriter) then
    fFileWriter := TengShaderFileWriter.Create;

  sr := TengSearchResults.Create;
  sl := TStringList.Create;
  ms := TMemoryStream.Create;
  walker := TengSearchWalker.Create(sr);
  try
    walker.SearchFlags := [sfSearchChildren];
    walker.ResultTypes := CengShaderPartArr.Create(TengShaderPartInclude);
    for i := 0 to sr.Count-1 do
      (sr[i] as TengShaderPartInclude).SaveToFile(aFilename, aFileWriter);
    sl.Text := Text;
    sl.SaveToStream(ms);
    ms.Position := 0;
    fFileWriter.SaveStream(aFilename, ms);
  finally
    FreeAndNil(walker);
    FreeAndNil(sr);
    FreeAndNil(sl);
    FreeAndNil(ms);
    fFileWriter := nil;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderFile.GenerateCodeIntern(const aArgs: TengShaderGeneratorArgs);
var
  sr: TengSearchResults;
  walker: TengSearchWalker;
  main: TengShaderPartMain;
begin
  inherited GenerateCodeIntern(aArgs);
  if (aArgs.Root = self) then begin
    sr := TengSearchResults.Create;
    walker := TengSearchWalker.Create(sr);
    try
      walker.SearchFlags        := [sfSearchChildren, sfEvaluateIf];
      walker.ResultTypes        := CengShaderPartArr.Create(TengShaderPartMain);
      walker.ChildrenDoNotLeave := CengShaderPartArr.Create(TengShaderGenerator);
      walker.ChildrenForceLeave := CengShaderPartArr.Create(TengShaderFile);
      walker.Run(self);
      main := (ExtractSearchResult(self, TengShaderPartMain.GetTokenName, sr, []) as TengShaderPartMain);
      if Assigned(main) then begin
        aArgs.PushFlags((aArgs.Flags * [gfAddProcedureItem, gfAddParameterItem]) + [gfGenerateProcedureCode]);
        try
          main.GenerateCodeIntern(aArgs);
        finally
          aArgs.PopFlags;
        end;
      end;
    finally
      FreeAndNil(walker);
      FreeAndNil(sr);
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderFile.LogMsgIntern(const aSender: TengShaderPart; const aLogLevel: TengShaderPartLogLevel; const aMsg: String);
var
  tmp: TengShaderFileLogEvent;
begin
  inherited LogMsgIntern(aSender, aLogLevel, aMsg);
  tmp := fOnLog;
  if Assigned(tmp) then
    tmp(aSender, aLogLevel, aMsg);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderFile.Clear;
begin
  inherited Clear;
  fClasses.Clear;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TengShaderFile.Create;
begin
  Create(nil);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TengShaderFile.Create(const aParent: TengShaderPart);
begin
  inherited Create(aParent);
  if not Assigned(fRoot) then
    fRoot := self;
  fClasses := TengShaderPartClassMap.Create(false);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TengShaderFile.Destroy;
begin
  FreeAndNil(fClasses);
  inherited Destroy;
  fFileReader := nil;
  fFileWriter := nil;
end;

end.