GLScene/Source/FmShaderUniformEditor.pas

//
// The graphics engine GLScene
//
unit FmShaderUniformEditor;

(* Uniform editor for shaders *)

interface

{$I Stage.Defines.inc}

uses
  System.SysUtils,
  System.Variants,
  System.Classes,
  VCL.Graphics,
  VCL.Controls,
  VCL.Forms,
  VCL.Dialogs,
  VCL.StdCtrls,
  VCL.ExtCtrls,
  VCL.Buttons,
  Stage.Strings,
  GLSL.ShaderParameter,
  Stage.TextureFormat,
  Stage.VectorGeometry;

type
  TGLShaderUniformEditor = class(TForm)
    LBUniforms: TListBox;
    Labe1: TLabel;
    AutoSetBox: TComboBox;
    SamplerBox: TComboBox;
    Panel1: TPanel;
    RedGroup: TRadioGroup;
    GreenGroup: TRadioGroup;
    BlueGroup: TRadioGroup;
    AlphaGroup: TRadioGroup;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    TextureBox: TComboBox;
    Button1: TButton;
    procedure FormDestroy(Sender: TObject);
    procedure LBUniformsClick(Sender: TObject);
    procedure ColorGroupClick(Sender: TObject);
    procedure AutoSetBoxChange(Sender: TObject);
    procedure TextureBoxChange(Sender: TObject);
    procedure SamplerBoxChange(Sender: TObject);
    procedure LBUniformsKeyPress(Sender: TObject; var Key: Char);
  private
    FUniformList: array of IShaderParameter;
  public
    procedure Clear;
    procedure AddTextureName(const S: string);
    procedure AddSamplerName(const S: string);
    procedure AddUniform(AValue: IShaderParameter);
    procedure Execute;
  end;


function GLShaderUniformEditor: TGLShaderUniformEditor;
procedure ReleaseShaderUniformEditor;

//-----------------------------------------------------------------
implementation
//-----------------------------------------------------------------

{$R *.dfm}

var
  vGLShaderUniformEditor: TGLShaderUniformEditor;

function GLShaderUniformEditor: TGLShaderUniformEditor;
begin
  if not Assigned(vGLShaderUniformEditor) then
    vGLShaderUniformEditor := TGLShaderUniformEditor.Create(nil);
  Result := vGLShaderUniformEditor;
end;

procedure ReleaseShaderUniformEditor;
begin
  if Assigned(vGLShaderUniformEditor) then
  begin
    vGLShaderUniformEditor.Free;
    vGLShaderUniformEditor := nil;
  end;
end;

//-----------------------------
// TShaderUniformEditor
//-----------------------------

procedure TGLShaderUniformEditor.AddUniform(AValue: IShaderParameter);
begin
  if AValue <> nil then
  begin
    SetLength(FUniformList, Length(FUniformList)+1);
    FUniformList[High(FUniformList)] := AValue;
  end;
end;

procedure TGLShaderUniformEditor.AutoSetBoxChange(Sender: TObject);
begin
  if LBUniforms.ItemIndex >= 0 then
  begin
    FUniformList[LBUniforms.ItemIndex].AutoSetMethod := AutoSetBox.Items[AutoSetBox.ItemIndex];
  end;
end;

procedure TGLShaderUniformEditor.Clear;
var
  I: Integer;
begin
  for I := 0 to High(FUniformList) do
    FUniformList[I] := nil;
  SetLength(FUniformList, 0);
  LBUniforms.Items.Clear;
  LBUniforms.ItemIndex := -1;
  AutoSetBox.Items.Clear;
  TextureBox.Items.Clear;
  SamplerBox.Items.Clear;
  AutoSetBox.Items.Add(strNothing);
  TextureBox.Items.Add(strNothing);
  SamplerBox.Items.Add(strNothing);
  AutoSetBox.ItemIndex := 0;
  TextureBox.ItemIndex := 0;
  SamplerBox.ItemIndex := 0;
  RedGroup.ItemIndex := -1;
  GreenGroup.ItemIndex := -1;
  BlueGroup.ItemIndex := -1;
  AlphaGroup.ItemIndex := -1;
end;

procedure TGLShaderUniformEditor.Execute;
var
  I: Integer;
  str: AnsiString;
begin
  for I := 0 to High(FUniformList) do
  begin
    if FUniformList[I].GLSLType <> GLSLTypeUndefined then
      str := cGLSLTypeString[FUniformList[I].GLSLType];
    if FUniformList[I].GLSLSamplerType <> GLSLSamplerUndefined then
      str := cGLSLSamplerString[FUniformList[I].GLSLSamplerType];
    LBUniforms.Items.Add(FUniformList[I].Name+': '+string(str));
  end;
  ShowModal;
end;

procedure TGLShaderUniformEditor.FormDestroy(Sender: TObject);
begin
  FUniformList := nil;
end;

procedure TGLShaderUniformEditor.LBUniformsClick(Sender: TObject);
var
  SV: TglSwizzleVector;
  IParam: IShaderParameter;
begin
  if LBUniforms.ItemIndex >= 0 then
  begin
    AutoSetBox.Items.Clear;
    AutoSetBox.Items.Add(strNothing);
    IParam := FUniformList[LBUniforms.ItemIndex];
    if IParam.GLSLSamplerType <> GLSLSamplerUndefined then
    begin
      FillUniformAutoSetMethodList(AutoSetBox.Items, IParam.GLSLSamplerType);
      AutoSetBox.ItemIndex :=
        MaxInteger(AutoSetBox.Items.IndexOf(IParam.AutoSetMethod), 0);
      TextureBox.Enabled := True;
      SamplerBox.Enabled := True;
      TextureBox.ItemIndex :=
        MaxInteger(TextureBox.Items.IndexOf(IParam.TextureName), 0);
      SamplerBox.ItemIndex :=
        MaxInteger(SamplerBox.Items.IndexOf(IParam.SamplerName), 0);
      SV := IParam.GetTextureSwizzle;
      RedGroup.ItemIndex := Ord(SV[0]);
      GreenGroup.ItemIndex := Ord(SV[1]);
      BlueGroup.ItemIndex := Ord(SV[2]);
      AlphaGroup.ItemIndex := Ord(SV[3]);
    end
    else
    begin
      TextureBox.Enabled := False;
      SamplerBox.Enabled := False;
      FillUniformAutoSetMethodList(AutoSetBox.Items, IParam.GLSLType);
      AutoSetBox.ItemIndex :=
        MaxInteger(AutoSetBox.Items.IndexOf(IParam.AutoSetMethod), 0);
      RedGroup.ItemIndex := -1;
      GreenGroup.ItemIndex := -1;
      BlueGroup.ItemIndex := -1;
      AlphaGroup.ItemIndex := -1;
    end;
  end;
end;

procedure TGLShaderUniformEditor.LBUniformsKeyPress(Sender: TObject; var Key: Char);
begin
  LBUniformsClick(Self);
end;

procedure TGLShaderUniformEditor.SamplerBoxChange(Sender: TObject);
begin
  if LBUniforms.ItemIndex >= 0 then
  begin
    FUniformList[LBUniforms.ItemIndex].SamplerName :=
      SamplerBox.Items[SamplerBox.ItemIndex];
  end;
end;

procedure TGLShaderUniformEditor.TextureBoxChange(Sender: TObject);
begin
  if LBUniforms.ItemIndex >= 0 then
  begin
    FUniformList[LBUniforms.ItemIndex].TextureName :=
      TextureBox.Items[TextureBox.ItemIndex];
  end;
end;

procedure TGLShaderUniformEditor.ColorGroupClick(Sender: TObject);
var
  SV: TglSwizzleVector;
begin
  if LBUniforms.ItemIndex >= 0 then
  begin
    if FUniformList[LBUniforms.ItemIndex].GLSLSamplerType = GLSLSamplerUndefined then
      exit;
    SV := FUniformList[LBUniforms.ItemIndex].GetTextureSwizzle;
    SV[TRadioGroup(Sender).Tag] := TGLTextureSwizzle(TRadioGroup(Sender).ItemIndex);
    FUniformList[LBUniforms.ItemIndex].SetTextureSwizzle(SV);
  end;
end;

procedure TGLShaderUniformEditor.AddTextureName(const S: string);
begin
  TextureBox.Items.Add(S);
end;

procedure TGLShaderUniformEditor.AddSamplerName(const S: string);
begin
  SamplerBox.Items.Add(S);
end;

//---------------------------------
initialization
//---------------------------------

finalization
  ReleaseShaderUniformEditor;

end.