ShaderFile/uengShaderPartProc.pas

unit uengShaderPartProc;

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

interface

uses
  Classes, SysUtils,
  uengShaderPart, uengShaderPartScope, uengShaderFileParser, uengShaderGeneratorArgs

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

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TengShaderPartProcParam = packed record
    Typ: String;
    Name: String;
  end;
  TengShaderPartProcParamList = specialize TutlSimpleList<TengShaderPartProcParam>;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TengShaderPartProc = class(TengShaderPartScope)
  { Code Loading & Storage }
  private
    fName: String;
    fIsInline: Boolean;
    fParameters: TengShaderPartProcParamList;
    function GetParameter(const aIndex: Integer): TengShaderPartProcParam;
    function GetParameterCount: Integer;
  protected
    function GetHeaderText: String; virtual;
    function GetText: String; override;
    function ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String; override;

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

  { General }
  public
    property Name:           String  read fName;
    property IsInline:       Boolean read fIsInline;
    property ParameterCount: Integer read GetParameterCount;
    property Parameters[const aIndex: Integer]: TengShaderPartProcParam read GetParameter;

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

  { Class Members }
  public
    class function GetTokenName: String; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TengShaderPartMain = class(TengShaderPartProc)
  { Code Loading & Storage }
  protected
    function GetHeaderText: String; override;
    function ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String; override;

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

  { General }
  public
    class function GetTokenName: String; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TengShaderPartFunc = class(TengShaderPartProc)
  { Code Loading & Storage }
  private
    fReturnType: String;
  protected
    function GetHeaderText: String; override;
    function ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String; override;

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

  { Class Methods }
  public
    class function GetTokenName: String; override;
  end;

implementation

uses
  RegExpr,
  uengShaderFileConstants, uengShaderFileTypes, uengShaderFileHelper, uengShaderPartClass;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengShaderPartProc////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartProc.GetParameter(const aIndex: Integer): TengShaderPartProcParam;
begin
  result := fParameters[aIndex];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartProc.GetParameterCount: Integer;
begin
  result := fParameters.Count;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartProc.GetHeaderText: String;
var
  p: TengShaderPartProcParam;
begin
  result := TOKEN_CHAR_BEGIN + GetTokenName + ' ' + TOKEN_CHAR_QUOTE + fName + TOKEN_CHAR_QUOTE;
  for p in fParameters do begin
    result := result + ' ' + TOKEN_CHAR_QUOTE + p.Typ  + TOKEN_CHAR_QUOTE +
                       ' ' + TOKEN_CHAR_QUOTE + p.Name + TOKEN_CHAR_QUOTE;
  end;
  result := result + TOKEN_CHAR_END;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartProc.GetText: String;
begin
  result := GetHeaderText +
    inherited GetText +
    TOKEN_CHAR_BEGIN + TOKEN_END + TOKEN_CHAR_END;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartProc.ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String;
type
  TParseArgsState = (pasType, pasName);
var
  i: Integer;
  state: TParseArgsState;
  param: TengShaderPartProcParam;
begin
  if (aParams[0].Name <> GetTokenName) then with aParams[0] do
    raise EengInvalidToken.Create(ClassName, Name, Line, Col, Filename, self);
  if (aParams.Count < 2) then
    raise EengInvalidParamterCount.Create(GetTokenName, 2, -1, self);

  i      := 2;
  result := '';
  fName  := aParams[1].Name;
  state  := pasType;
  fParameters.Clear;
  while (i < aParams.Count) do begin
    case state of
      pasType: begin
        if (aParams[i].Name <> TOKEN_INLINE) then begin
          param.Typ := aParams[i].Name;
          state     := pasName;
        end else
          fIsInline := true;
      end;

      pasName: begin
        if (aParams[i].Name = TOKEN_INLINE) then begin
          with aParams[i] do
            raise EengInvalidParamter.Create('expected parameter name (found ' + TOKEN_INLINE + ')', Line, Col, Filename, self);
        end else begin
          param.Name := aParams[i].Name;
          fParameters.Add(param);
          state := pasType;
        end;
      end;
    end;
    inc(i);
  end;
  if (state <> pasType) then
    raise EengInvalidParamterCount.Create('invalid parameter count in ' + GetTokenName + '(expected multiple of 2)', self);
  result := inherited ParseIntern(aArgs, aParams);
  result := CheckEndToken(result, aArgs, self);
end;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderPartProc.GenerateInlineCode(const aArgs: TengShaderGeneratorArgs);
var
  p: TengShaderPartProcParam;
  old, new: TStringList;
  rx: TRegExpr;
  s: String;
begin
  aArgs.PushCode;
  rx := TRegExpr.Create;
  old := TStringList.Create;
  new := TStringList.Create;
  try
    inherited GenerateCodeIntern(aArgs);

    // prepare old parameters
    for p in fParameters do
      old.Add(p.Name);

    // prepate new paramaters
    rx.Expression := '[^A-z0-9_]+';
    for s in aArgs.ProcParams do begin
      if rx.Exec(s)
         then new.Add('(' + s + ')')
         else new.Add(s);
    end;

    // replace parameters
    aArgs.ReplaceIdents(old, new);
  finally
    FreeAndNil(rx);
    FreeAndNil(old);
    FreeAndNil(new);
    aArgs.PopCode([pcfAppend]);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderPartProc.GenerateCodeIntern(const aArgs: TengShaderGeneratorArgs);
var
  s, params: String;
  c: TengShaderPartClass;
begin
  // generate inline code
  if (aArgs.Flags * [gfGenerateProcedureCall, gfGenerateProcedureCode] <> []) and
     ((gfGenerateInlineCode in aArgs.Flags) or fIsInline) then
  begin
    GenerateInlineCode(aArgs);
    if (GetTokenName = TOKEN_PROC) then
      aArgs.IgnoreNextCommandEnd;

  // generate code
  end else if (gfGenerateProcedureCode in aArgs.Flags) then begin
    aArgs
      .AddLineBreak
      .AddText(GenerateHeaderCode(aArgs))
      .AddLineBreak
      .AddCommandEnd('{')
      .AddLineBreak
      .BeginBlock(4);
    try
      inherited GenerateCodeIntern(aArgs);
    finally
      aArgs
        .EndBlock
        .AddCommandEnd('}')
        .AddLineBreak;
    end;

  // generate call
  end else if (gfGenerateProcedureCall in aArgs.Flags) then begin
    params := '';
    for s in aArgs.ProcParams do begin
      if (params <> '') then
        params := params + ', ';
      params := params + s;
    end;
    if GetParent(TengShaderPartClass, c)
      then aArgs.AddText(c.Name + '_' + fName + '(' + params + ')')
      else aArgs.AddText(fName + '(' + params + ')');
    aArgs.AddProcedure(self);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TengShaderPartProc.Create(const aParent: TengShaderPart);
begin
  inherited Create(aParent);
  fParameters := TengShaderPartProcParamList.Create(true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TengShaderPartProc.Destroy;
begin
  FreeAndNil(fParameters);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TengShaderPartProc.GetTokenName: String;
begin
  result := TOKEN_PROC;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengShaderPartMain////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartMain.GetHeaderText: String;
begin
  result := TOKEN_CHAR_BEGIN + GetTokenName + TOKEN_CHAR_END;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartMain.ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String;
var
  p: TengTokenParameter;
begin
  if (aParams[0].Name <> GetTokenName) then with aParams[0] do
    raise EengInvalidToken.Create(ClassName, Name, Line, Col, Filename, self);
  if (aParams.Count <> 1) then
    raise EengInvalidParamterCount.Create(GetTokenName, 1, self);

  result   := '';
  p.Name   := 'main';
  p.Quoted := false;
  p.Line   := Line;
  p.Col    := Col + Length(GetTokenName);
  aParams.Add(p);
  inherited ParseIntern(aArgs, aParams);
end;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TengShaderPartMain.GetTokenName: String;
begin
  result := TOKEN_MAIN;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengShaderPartFunc////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartFunc.GetHeaderText: String;
var
  p: TengShaderPartProcParam;
begin
  result := TOKEN_CHAR_BEGIN + GetTokenName + ' ' +
            TOKEN_CHAR_QUOTE + fReturnType + TOKEN_CHAR_QUOTE + ' ' +
            TOKEN_CHAR_QUOTE + fName + TOKEN_CHAR_QUOTE;
  for p in fParameters do
    result := result + ' ' + TOKEN_CHAR_QUOTE + p.Typ  + TOKEN_CHAR_QUOTE
                     + ' ' + TOKEN_CHAR_QUOTE + p.Name + TOKEN_CHAR_QUOTE;
  result := result + TOKEN_CHAR_END;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderPartFunc.ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String;
begin
  if (aParams[0].Name <> GetTokenName) then with aParams[0] do
    raise EengInvalidToken.Create(ClassName, aParams[0].Name, Line, Col, Filename, self);
  if (aParams.Count < 3) then
    raise EengInvalidParamterCount.Create(GetTokenName, 3, self);

  fReturnType := aParams[1].Name;
  aParams.Delete(1);
  result := inherited ParseIntern(aArgs, aParams);
end;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderPartFunc.GenerateInlineCode(const aArgs: TengShaderGeneratorArgs);
var
  csi: TengShaderGeneratorArgs.TCodeStackItem;
  indent: Integer;
begin
  csi := TengShaderGeneratorArgs.TCodeStackItem.Create;
  try
    indent := aArgs.ExtractCurrentCommand(csi);
    aArgs
      .PushCode
      .BeginBlock;
    try
      inherited GenerateInlineCode(aArgs);
    finally
      aArgs
        .EndBlock
        .AddText(StringOfChar(' ', indent))
        .ReplaceReturns(csi, fReturnType, fName)
        .PopCode([pcfAppend]);
    end;
  finally
    FreeAndNil(csi);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TengShaderPartFunc.GetTokenName: String;
begin
  result := TOKEN_FUNC;
end;

end.