ShaderFile/uengShaderGeneratorArgs.pas

unit uengShaderGeneratorArgs;

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

interface

uses
  Classes, SysUtils,
  uengShaderFileTypes, uengShaderPart

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

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TengGenerateFlag = (
    gfGenerateProcedureMain,    // generate main procedure code
    gfGenerateProcedureCode,    // generate procedure code
    gfGenerateProcedureCall,    // generate procedure call
    gfGenerateInlineCode,       // generate procedure as inline code
    gfGenerateParameterCode,    // generate code for parameter items
    gfAddProcedureItem,         // add procedure item to generator args
    gfAddParameterItem          // add parameter items to generator args
  );
  TengGenerateFlags = set of TengGenerateFlag;
  TengGenerateFlagsStack = specialize TutlSimpleList<TengGenerateFlags>;

  TengPopCodeFlag = (
    pcfAppend,
    pcfPrepend,
    pcfAddEmptyLine
  );
  TengPopCodeFlags = set of TengPopCodeFlag;

  TengShaderGeneratorArgs = class(TObject)
  private type
    TengGeneratorToken = (
      gtNormal                = 0,  // normal text
      gtLineBreak             = 1,  // line break
      gtCommandEnd            = 2,  // command end (like ';')
      gtBlockBegin            = 3,  // code block begin (to calculate indent)
      gtBlockEnd              = 4,  // code block end (to calculate indent)
      gtAppendToPrev          = 5,  // append current line to prev line
      gtIgnoreNextCommandEnd  = 6,  // ignore next command end
      gtToken                 = 7   // code token (like '$INCLUDE' or '$IF')
    );

    TCodePart = class(TObject)
    private
      fText: String;
      fIndent: Integer;
      fToken: TengGeneratorToken;
      function GetDebugText: String;
      function GetCode: String;
    public
      property Text:      String             read fText write fText;
      property Code:      String             read GetCode;
      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 = High(Integer));
    end;
    TCodePartList = specialize TutlSimpleList<TCodePart>;

  public type
    TCodeStackItem = class(TObject)
    private
      fItems: TCodePartList;
      function GetIsEmpty: Boolean;
    public
      property Items:   TCodePartList read fItems;
      property IsEmpty: Boolean       read GetIsEmpty;

      procedure GenerateCode(const aCode: TengShaderCode);
      procedure Merge(const aItem: TCodeStackItem; aIndex: Integer);

      constructor Create;
      destructor Destroy; override;
    end;

  private type
    TCodeStack = specialize TutlSimpleList<TCodeStackItem>;
    TParameterMap = specialize TutlMap<string, TengShaderPart>;
    TProcedureList = specialize TutlList<TengShaderPart>;
    TProcParamStack = specialize TutlSimpleList<TStrings>;

  private
    fInlineReturnCounter: Integer;
    fCode: TCodeStack;
    fRoot: TengShaderPart;
    fFlagStack: TengGenerateFlagsStack;
    fMetaDataList: TengMetaDataList;
    fParameters: TParameterMap;
    fProcedures: TProcedureList;
    fProcParams: TProcParamStack;

    fMaxParameterLength: Integer;

    function GetFlags: TengGenerateFlags;
    function GetProcParams: TStrings;
  public
    property Root:               TengShaderPart    read fRoot;
    property Flags:              TengGenerateFlags read GetFlags;
    property ProcParams:         TStrings          read GetProcParams;
    property MaxParameterLength: Integer           read fMaxParameterLength;

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

    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 = High(Integer)): TengShaderGeneratorArgs;
    function EndBlock(const aCanAppend: Boolean = false): TengShaderGeneratorArgs;
    function AppendToPrevLine: TengShaderGeneratorArgs;
    function IgnoreNextCommandEnd: TengShaderGeneratorArgs;

    procedure AddMeta(const aMeta: TengMetaData);
    procedure AddParameter(const aParam: TengShaderPart);
    procedure AddProcedure(const aProc: TengShaderPart);

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

    procedure GenerateParameterCode(const aTypes: CengShaderPartArr);
    procedure GenerateProcedureCode;
    procedure GenerateMetaCode;

    procedure GenerateCode(const aCode: TengShaderCode);

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

implementation

uses
  Math, RegExpr,
  uengShaderFileHelper, uengShaderFileConstants, uengShaderPartParameter, uengShaderPartProc;

const
  WHITESPACES = [' ', #9];

type
  TCodeBlock = class(TStringList)
  private
    function GetLast: String;
    function GetDepth(const aIndex: Integer): Integer;
    procedure SetLast(aValue: String);
    procedure SetDepth(const aIndex: Integer; aValue: Integer);
  public
    property Last:                         String  read GetLast  write SetLast;
    property Depth[const aIndex: Integer]: Integer read GetDepth write SetDepth;

    function Add(const aString: String; const aDepth: Integer): Integer; reintroduce;
    procedure Clear; override;

    constructor Create;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TCodeBlock////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TCodeBlock.GetLast: String;
begin
  result := Get(Count-1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TCodeBlock.GetDepth(const aIndex: Integer): Integer;
begin
  result := PtrInt(Objects[aIndex]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TCodeBlock.SetLast(aValue: String);
begin
  Put(Count-1, aValue);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TCodeBlock.SetDepth(const aIndex: Integer; aValue: Integer);
begin
  Objects[aIndex] := TObject(PtrInt(aValue));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TCodeBlock.Add(const aString: String; const aDepth: Integer): Integer;
begin
  result := inherited AddObject(aString, TObject(PtrInt(aDepth)));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TCodeBlock.Clear;
begin
  inherited Clear;
  Add('', 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TCodeBlock.Create;
begin
  inherited Create;
  Clear;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengShaderGeneratorArgs.TCodePart///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorArgs.TCodePart.GetCode: String;
begin
  case fToken of
    gtNormal,
    gtCommandEnd:
      result := fText;
    gtLineBreak:
      result := sLineBreak;
  else
    result := '';
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorArgs.TCodePart.GetDebugText: String;
begin
  case fToken of
    gtNormal:         result := '[N]' + fText;
    gtLineBreak:      result := sLineBreak;
    gtCommandEnd:     result := '[C]' + fText;
    gtBlockBegin:     if (fIndent = High(Integer))
                        then result := '[B]'
                        else result := format('[B%d]', [fIndent]);
    gtBlockEnd:       result := '[E]';
    gtToken:          result := '[T' + fText + ']';
    gtAppendToPrev:   result := '[A]';
  else
    result := '[' + IntToStr(Integer(fToken)) + ']' + fText
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TengShaderGeneratorArgs.TCodePart.Create(const aToken: TengGeneratorToken; const aText: String; const aIndent: Integer);
begin
  inherited Create;
  fToken  := aToken;
  fText   := aText;
  fIndent := aIndent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengShaderGeneratorArgs.TCodeStackItem//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorArgs.TCodeStackItem.GetIsEmpty: Boolean;
begin
  result := (fItems.Count = 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorArgs.TCodeStackItem.GenerateCode(const aCode: TengShaderCode);
type
  TGenFlag = (
    gfToken,                // current line has a token in it
    gfTokenOnly,            // current line has only a token (or whitespaces) in it
    gfPrevIsEmpty,          // previouse line was empty (or whitespaces only)
    gfAddToPrev,            // add current line to previouse line
    gfIgnoreNextCommandEnd
  );
  TGenFlags = set of TGenFlag;

var
  i: Integer;
  f: TGenFlags;
  cb: TCodeBlock;

{$IFDEF SHADER_FILE_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) <> '') or not aIgnoreEmptyLines then begin
      result := 1;
      len    := Length(aStr);
      while (result <= len) and (aStr[result] in WHITESPACES) do
        inc(result);
      dec(result);
    end else
      result := High(Integer);
  end;

  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);
      while (i <= l) and (i <= -aIndent) and (aStr[i] in WHITESPACES) do
        inc(i);
      result := copy(aStr, i, l - i + 1);
    end else if (aIndent > 0) then
      result := StringOfChar(' ', aIndent) + aStr
    else
      result := aStr;
  end;

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

  procedure ProgressBlock(const aCurrentBlockIndent, aDepth: Integer);
  var
    cp: TCodePart;
    tmp: Integer;
    s: String;
  begin
    while (i < fItems.Count) do begin
      cp := fItems[i];
      inc(i);

      if (Trim(cb.Last) = '') then
        cb.Depth[cb.Count-1] := aDepth;

      case cp.Token of
        gtLineBreak: begin
          if (Trim(cb.Last) = '') then begin
            if (f * [gfTokenOnly, gfPrevIsEmpty] = []) then begin
              Include(f, gfPrevIsEmpty);
              cb.Add('', aDepth);
            end else
              cb.Last := '';
          end else begin
            if (gfAddToPrev in f) and (cb.Count >= 2) then begin
              cb[cb.Count-2] := cb[cb.Count-2] + TrimLeft(cb.Last);
              cb.Last := '';
            end else
              cb.Add('', aDepth);
            Exclude(f, gfPrevIsEmpty);
          end;
          f := f - [gfToken, gfTokenOnly, gfAddToPrev];
        end;

        gtToken: begin
          Include(f, gfToken);
          if (Trim(cb.Last) = '') then
            Include(f, gfTokenOnly);
        end;

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

        gtBlockEnd: begin
          {$IFDEF SHADER_FILE_DEBUG}
            GenerateCurrentCode(Format('------====== DEBUG STEP BEFORE INDENT (%d) ======------', [aCurrentBlockIndent]));
          {$ENDIF}
          IndentBlock(aDepth, aCurrentBlockIndent);
          {$IFDEF SHADER_FILE_DEBUG}
            GenerateCurrentCode(Format('------====== DEBUG STEP AFTER INDENT (%d) ======------', [aCurrentBlockIndent]));
          {$ENDIF}
          exit;
        end;

        gtIgnoreNextCommandEnd: begin
          include(f, gfIgnoreNextCommandEnd);
        end;

        gtAppendToPrev: begin
          if (Trim(cb.Last) = '') and not (gfPrevIsEmpty in f) then
            include(f, gfAddToPrev);
        end;

        gtCommandEnd: begin
          if (gfIgnoreNextCommandEnd in f)
            then exclude(f, gfIgnoreNextCommandEnd)
            else cb.Last := cb.Last + cp.Code;
        end;

      else
        s := cp.Code;
        if (Trim(s) <> '') then
          exclude(f, gfIgnoreNextCommandEnd);
        cb.Last := cb.Last + s;
      end;
    end;
  end;

var
  s, e: Integer;
begin
{$IFDEF SHADER_FILE_DEBUG}
  GenerateDebugCode;
{$ENDIF}

  i  := 0;
  f  := [gfPrevIsEmpty];
  cb := TCodeBlock.Create;
  try
    ProgressBlock(0, 0);
    s := 0;
    e := cb.Count-1;
    while (s < cb.Count) and (Trim(cb[s]) = '') do
      inc(s);
    while (e >= 0) and (Trim(cb[e]) = '') do
      dec(e);
    for i := s to e do
      aCode.Add(
        {$IFDEF SHADER_FILE_DEBUG}
          Format('[%02d]%s|', [cb.Depth[i], cb[i]])
        {$ELSE}
          cb[i]
        {$ENDIF}
      );
  finally
    FreeAndNil(cb);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorArgs.TCodeStackItem.Merge(const aItem: TCodeStackItem; aIndex: Integer);
begin
  if (aIndex < 0) then
    aIndex := 0;
  if (aIndex > fItems.Count) then
    aIndex := fItems.Count;
  while (aItem.Items.Count > 0) do
    fItems.Insert(aIndex, aItem.Items.PopLast(false));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TengShaderGeneratorArgs.TCodeStackItem.Create;
begin
  inherited Create;
  fItems := TCodePartList.Create(true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TengShaderGeneratorArgs.TCodeStackItem.Destroy;
begin
  FreeAndNil(fItems);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengShaderGeneratorArgs///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorArgs.GetFlags: TengGenerateFlags;
begin
  result := fFlagStack.Last;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorArgs.GetProcParams: TStrings;
begin
  result := fProcParams.Last;
end;

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

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

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorArgs.PopCode(const aFlags: TengPopCodeFlags): TengShaderGeneratorArgs;
var
  csi: TCodeStackItem;
begin
  csi := fCode.PopLast(false);
  try
    if csi.IsEmpty then
      exit;
    if (pcfPrepend in aFlags) then begin
      if (pcfAddEmptyLine in aFlags) then
        csi.Items.Add(TCodePart.Create(gtLineBreak, ''));
      fCode.Last.Merge(csi, 1);
    end else if (pcfAppend in aFlags) then begin
      if (pcfAddEmptyLine in aFlags) then
        fCode.Last.Items.Add(TCodePart.Create(gtLineBreak, ''));
      fCode.Last.Merge(csi, fCode.Last.Items.Count);
    end;
  finally
    FreeAndNil(csi);
  end;
  result := self;
end;

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

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorArgs.AddText(const aText: String): TengShaderGeneratorArgs;
begin
  fCode.Last.Items.Add(TCodePart.Create(gtNormal, aText));
  result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorArgs.AddToken(const aToken: String): TengShaderGeneratorArgs;
begin
  fCode.Last.Items.Add(TCodePart.Create(gtToken, aToken));
  result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorArgs.AddCommandEnd(const aToken: String): TengShaderGeneratorArgs;
begin
  fCode.Last.Items.Add(TCodePart.Create(gtCommandEnd, aToken));
  result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorArgs.AddLineBreak: TengShaderGeneratorArgs;
begin
  fCode.Last.Items.Add(TCodePart.Create(gtLineBreak, ''));
  result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorArgs.BeginBlock(const aIndent: Integer): TengShaderGeneratorArgs;
begin
  fCode.Last.Items.Add(TCodePart.Create(gtBlockBegin, '', aIndent));
  result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorArgs.EndBlock(const aCanAppend: Boolean): TengShaderGeneratorArgs;
begin
  fCode.Last.Items.Add(TCodePart.Create(gtBlockEnd, ''));
  result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorArgs.AppendToPrevLine: TengShaderGeneratorArgs;
begin
  fCode.Last.Items.Add(TCodePart.Create(gtAppendToPrev, ''));
  result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorArgs.IgnoreNextCommandEnd: TengShaderGeneratorArgs;
begin
  fCode.Last.Items.Add(TCodePart.Create(gtIgnoreNextCommandEnd, ''));
  result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorArgs.AddMeta(const aMeta: TengMetaData);
begin
  fMetaDataList.Add(aMeta);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorArgs.AddParameter(const aParam: TengShaderPart);
var
  p: TengShaderPart;
  s: String;
begin
  if not (aParam is TengShaderPartParameter) then
    raise EengShaderPartInternal.Create('parameter (' + aParam.ClassName + ') is not a ' + TengShaderPartParameter.ClassName, aParam);
  with (aParam as TengShaderPartParameter) do begin
    p := fParameters[Name];
    if Assigned(p) and (p <> aParam) then begin
      s := Format('use of duplicate identifier: %s (%s %d:%d)', [Name, Filename, Line + 1, Col]) + sLineBreak +
                  'previously declared here:' + sLineBreak +
                  Format('  %s %d:%d', [p.Filename, p.Line + 1, p.Col]) + sLineBreak;
      fRoot.LogMsg(llWarning, s);
      fParameters[Name] := aParam;
    end else if (p <> aParam) then
      fParameters.Add(Name, aParam);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorArgs.AddProcedure(const aProc: TengShaderPart);
begin
  if not (aProc is TengShaderPartProc) then
    raise EengShaderPartInternal.Create('parameter (' + aProc.ClassName + ') is not a ' + TengShaderPartProc.ClassName, aProc);
  if (fProcedures.IndexOf(aProc) < 0) then
    fProcedures.Add(aProc);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorArgs.ExtractCurrentCommand(const aCommand: TCodeStackItem): Integer;
var
  csi: TCodeStackItem;
  i, len: Integer;
  s: String;
begin
  csi    := fCode.Last;
  result := 0;
  if not Assigned(aCommand) then
    exit;

  // find last command end token
  while (csi.Items.Last.Token <> gtCommandEnd) do
    aCommand.Items.PushFirst(csi.Items.PopLast(false));

  // move forward to first code part with text
  while (aCommand.Items.First.Token <> gtNormal) or (Trim(aCommand.Items.First.Text) = '') do
    csi.Items.PushLast(aCommand.Items.PopFirst(false));

  // extract leading whitespaces
  i := 1;
  s := aCommand.Items.First.Text;
  len := Length(s);
  while (s[i] in WHITESPACES) and (i <= len) do
    inc(i);
  csi.Items.PushLast(TCodePart.Create(gtNormal, Copy(s, 1, i-1)));
  aCommand.Items.First.Text := copy(s, i, len-i+1);
  result := i - 1;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorArgs.ReplaceIdents(const aOld, aNew: TStrings): TengShaderGeneratorArgs;
var
  rx: TRegExpr;
  i: Integer;
  cp: TCodePart;
begin
  if (aOld.Count <> aNew.Count) then
    raise EengShaderPartInternal.Create('old and new ident must have the same size');
  rx := TRegExpr.Create;
  try
    for i := 0 to aOld.Count-1 do begin
      rx.Expression := '([^A-z0-9_]+|^)' + aOld[i] + '([^A-z0-9_]+|$)';
      for cp in fCode.Last.Items do
        cp.Text := rx.Replace(cp.Text, '$1' + aNew[i] + '$2', true);
    end;
  finally
    FreeAndNil(rx);
  end;
  result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengShaderGeneratorArgs.ReplaceReturns(const aCommand: TCodeStackItem; const aRetType, aName: String): TengShaderGeneratorArgs;
var
  rx: TRegExpr;
  RetCount, i, j: Integer;
  csi: TCodeStackItem;
  cp: TCodePart;
  s: String;
begin
  rx := TRegExpr.Create;
  try
    rx.Expression := '^(.*?\s+)return\s*(.*)$';
    csi := fCode.Last;

    // find number of "return" in code
    RetCount := 0;
    for cp in csi.Items do begin
      s := cp.Code;
      if rx.Exec(s) then
        inc(RetCount);
    end;

    // no "return" found
    if (RetCount = 0) then begin
      raise EengShaderPartInternal.Create('expected "return" token in function');

    // more than one "return"
    end else if (RetCount > 1) then begin
      // find block begin
      i := 0;
      while (csi.Items[i].Token <> gtBlockBegin) and (i < csi.Items.Count) do
        inc(i);
      if (i < csi.Items.Count)
        then inc(i)
        else i := 0;

      // insert temp variable
      s := Format('%s_ret%.4d', [aName, fInlineReturnCounter]);
      inc(fInlineReturnCounter);
      csi.Items.Insert(i+0, TCodePart.Create(gtNormal, aRetType + ' ' + s));
      csi.Items.Insert(i+1, TCodePart.Create(gtCommandEnd, ';'));
      csi.Items.Insert(i+2, TCodePart.Create(gtLineBreak, ''));

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

      // merge code
      csi.Merge(aCommand, csi.Items.Count);
      AddText(s);

    // exact one "return"
    end else begin
      i := csi.Items.Count-1;
      while (i > 0) do 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, '($2', true);

          // 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, ')');
          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);
        end;
        dec(i);
      end;
    end;
  finally
    FreeAndNil(rx);
  end;
  result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorArgs.GenerateParameterCode(const aTypes: CengShaderPartArr);
var
  m: TParameterMap;
  p: TengShaderPart;
begin
  PushCode;
  PushFlags(Flags + [gfGenerateParameterCode] - [gfAddParameterItem]);
  m := TParameterMap.Create(false);
  try
    fMaxParameterLength := 0;
    for p in fParameters do begin
      if CheckType(p, aTypes) then with (p as TengShaderPartParameter) do begin
        fMaxParameterLength := Max(fMaxParameterLength, Length(Typ));
        m.Add(Typ+Name, p);
      end;
    end;
    for p in m do begin
      (p as TengShaderPartParameter).GenerateCodeIntern(self);
      AddLineBreak;
    end;
  finally
    FreeAndNil(m);
    PopFlags;
    PopCode([pcfPrepend, pcfAddEmptyLine]);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorArgs.GenerateProcedureCode;
var
  i: Integer;
begin
  i := 0;
  while (i < fProcedures.Count) do begin
    PushCode;
    PushFlags([gfGenerateProcedureCode, gfAddParameterItem]);
    try
      (fProcedures[i] as TengShaderPartProc).GenerateCodeIntern(self);
    finally
      PopFlags;
      PopCode([pcfPrepend, pcfAddEmptyLine]);
    end;
    inc(i);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorArgs.GenerateMetaCode;
var
  layouts: TStringList;
  m: TengMetaData;
  vCompat: Boolean;
  vMax, i: Integer;
  s: String;
begin
  PushCode;
  vMax    := 0;
  vCompat := false;
  layouts := TStringList.Create;
  try
    for m in fMetaDataList do begin
      case m.MetaType of
        metaVersion: begin
          if (m.Values[0] = VERSION_EXTRA_COMPAT) then
            vCompat := true
          else if TryStrToInt(m.Values[0], i) then
            vMax := max(vMax, i);
          if (m.Count > 1) and (m.Values[1] = VERSION_EXTRA_COMPAT) then
            vCompat := true;
        end;

        metaExtension: begin
          AddText(format('#extension %s : %s', [m.Values[0], m.Values[1]]));
          AddLineBreak;
        end;

        metaLayout: begin
          layouts.Add('layout' + m.Values[0] + ';');
        end;
      end;
    end;

    if (vMax >= LAYOUT_MIN_VERSION) then begin
      for s in layouts do begin
        AddText(s);
        AddLineBreak;
      end;
    end;

    if (vMax > 0) then begin
      PushCode;
      try
        AddText('#version ' + IntToStr(vMax));
        if vCompat then
          AddText(' ' + VERSION_EXTRA_COMPAT);
        AddLineBreak;
      finally
        PopCode([pcfPrepend]);
      end;
    end;
  finally
    PopCode([pcfPrepend, pcfAddEmptyLine]);
    FreeAndNil(layouts);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TengShaderGeneratorArgs.GenerateCode(const aCode: TengShaderCode);
begin
  fCode.Last.GenerateCode(aCode);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TengShaderGeneratorArgs.Create(const aRoot: TengShaderPart);
begin
  inherited Create;
  fCode         := TCodeStack.Create(true);
  fFlagStack    := TengGenerateFlagsStack.Create();
  fMetaDataList := TengMetaDataList.Create(false);
  fParameters   := TParameterMap.Create(false);
  fProcedures   := TProcedureList.Create(false);
  fProcParams   := TProcParamStack.Create(false);
  fRoot         := aRoot;
  fInlineReturnCounter := 0;
  PushCode;
  PushFlags([ gfAddParameterItem, gfAddProcedureItem ]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TengShaderGeneratorArgs.Destroy;
begin
  FreeAndNil(fProcParams);
  FreeAndNil(fProcedures);
  FreeAndNil(fParameters);
  FreeAndNil(fMetaDataList);
  FreeAndNil(fFlagStack);
  FreeAndNil(fCode);
  inherited Destroy;
end;

end.