LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Shader Uniform Editor
6
   History :  
7
     23/03/11 - Yar - Creation
8
}
9

10
unit FShaderUniformEditor;
11

12
interface
13

14
{$I GLScene.inc}
15

16
uses
17
  lresources,
18
  SysUtils, 
19
  Variants, 
20
  Classes,  
21
  Graphics, 
22
  Controls, 
23
  Forms,
24
  Dialogs, 
25
  StdCtrls, 
26
  ExtCtrls, 
27
  Buttons,
28
  GLSLParameter, 
29
  GLTextureFormat, 
30
  GLVectorGeometry;
31

32
type
33
  TShaderUniformEditor = class(TForm)
34
    LBUniforms: TListBox;
35
    Labe1: TLabel;
36
    AutoSetBox: TComboBox;
37
    SamplerBox: TComboBox;
38
    Panel1: TPanel;
39
    RedGroup: TRadioGroup;
40
    GreenGroup: TRadioGroup;
41
    BlueGroup: TRadioGroup;
42
    AlphaGroup: TRadioGroup;
43
    Label1: TLabel;
44
    Label2: TLabel;
45
    Label3: TLabel;
46
    Label4: TLabel;
47
    TextureBox: TComboBox;
48
    Button1: TButton;
49
    procedure FormDestroy(Sender: TObject);
50
    procedure LBUniformsClick(Sender: TObject);
51
    procedure ColorGroupClick(Sender: TObject);
52
    procedure AutoSetBoxChange(Sender: TObject);
53
    procedure TextureBoxChange(Sender: TObject);
54
    procedure SamplerBoxChange(Sender: TObject);
55
    procedure LBUniformsKeyPress(Sender: TObject; var Key: Char);
56
  private
57
    FUniformList: array of IShaderParameter;
58
  public
59
    procedure Clear;
60
    procedure AddTextureName(const S: string);
61
    procedure AddSamplerName(const S: string);
62
    procedure AddUniform(AValue: IShaderParameter);
63

64
    procedure Execute;
65
  end;
66

67

68
function ShaderUniformEditor: TShaderUniformEditor;
69
procedure ReleaseShaderUniformEditor;
70

71
//============================================
72
implementation
73
//============================================
74

75
{$R *.lfm}
76

77
var
78
  vShaderUniformEditor: TShaderUniformEditor;
79

80
function ShaderUniformEditor: TShaderUniformEditor;
81
begin
82
  if not Assigned(vShaderUniformEditor) then
83
    vShaderUniformEditor := TShaderUniformEditor.Create(nil);
84
  Result := vShaderUniformEditor;
85
end;
86

87
procedure ReleaseShaderUniformEditor;
88
begin
89
  if Assigned(vShaderUniformEditor) then
90
  begin
91
    vShaderUniformEditor.Free;
92
    vShaderUniformEditor := nil;
93
  end;
94
end;
95

96
{ TShaderUniformEditor }
97

98
procedure TShaderUniformEditor.AddUniform(AValue: IShaderParameter);
99
begin
100
  if AValue <> nil then
101
  begin
102
    SetLength(FUniformList, Length(FUniformList)+1);
103
    FUniformList[High(FUniformList)] := AValue;
104
  end;
105
end;
106

107
procedure TShaderUniformEditor.AutoSetBoxChange(Sender: TObject);
108
begin
109
  if LBUniforms.ItemIndex >= 0 then
110
  begin
111
    FUniformList[LBUniforms.ItemIndex].AutoSetMethod := AutoSetBox.Items[AutoSetBox.ItemIndex];
112
  end;
113
end;
114

115
procedure TShaderUniformEditor.Clear;
116
var
117
  I: Integer;
118
begin
119
  for I := 0 to High(FUniformList) do
120
    FUniformList[I] := nil;
121
  SetLength(FUniformList, 0);
122
  LBUniforms.Items.Clear;
123
  LBUniforms.ItemIndex := -1;
124
  AutoSetBox.Items.Clear;
125
  TextureBox.Items.Clear;
126
  SamplerBox.Items.Clear;
127
  AutoSetBox.Items.Add(rstrNothing);
128
  TextureBox.Items.Add(rstrNothing);
129
  SamplerBox.Items.Add(rstrNothing);
130
  AutoSetBox.ItemIndex := 0;
131
  TextureBox.ItemIndex := 0;
132
  SamplerBox.ItemIndex := 0;
133
  RedGroup.ItemIndex := -1;
134
  GreenGroup.ItemIndex := -1;
135
  BlueGroup.ItemIndex := -1;
136
  AlphaGroup.ItemIndex := -1;
137
end;
138

139
procedure TShaderUniformEditor.Execute;
140
var
141
  I: Integer;
142
  str: AnsiString;
143
begin
144
  for I := 0 to High(FUniformList) do
145
  begin
146
    if FUniformList[I].GLSLType <> GLSLTypeUndefined then
147
      str := cGLSLTypeString[FUniformList[I].GLSLType];
148
    if FUniformList[I].GLSLSamplerType <> GLSLSamplerUndefined then
149
      str := cGLSLSamplerString[FUniformList[I].GLSLSamplerType];
150
    LBUniforms.Items.Add(FUniformList[I].Name+': '+string(str));
151
  end;
152
  ShowModal;
153
end;
154

155
procedure TShaderUniformEditor.FormDestroy(Sender: TObject);
156
begin
157
  FUniformList := nil;
158
end;
159

160
procedure TShaderUniformEditor.LBUniformsClick(Sender: TObject);
161
var
162
  SV: TSwizzleVector;
163
  IParam: IShaderParameter;
164
begin
165
  if LBUniforms.ItemIndex >= 0 then
166
  begin
167
    AutoSetBox.Items.Clear;
168
    AutoSetBox.Items.Add(rstrNothing);
169
    IParam := FUniformList[LBUniforms.ItemIndex];
170
    if IParam.GLSLSamplerType <> GLSLSamplerUndefined then
171
    begin
172
      FillUniformAutoSetMethodList(AutoSetBox.Items, IParam.GLSLSamplerType);
173
      AutoSetBox.ItemIndex :=
174
        MaxInteger(AutoSetBox.Items.IndexOf(IParam.AutoSetMethod), 0);
175
      TextureBox.Enabled := True;
176
      SamplerBox.Enabled := True;
177
      TextureBox.ItemIndex :=
178
        MaxInteger(TextureBox.Items.IndexOf(IParam.TextureName), 0);
179
      SamplerBox.ItemIndex :=
180
        MaxInteger(SamplerBox.Items.IndexOf(IParam.SamplerName), 0);
181
      SV := IParam.GetTextureSwizzle;
182
      RedGroup.ItemIndex := Ord(SV[0]);
183
      GreenGroup.ItemIndex := Ord(SV[1]);
184
      BlueGroup.ItemIndex := Ord(SV[2]);
185
      AlphaGroup.ItemIndex := Ord(SV[3]);
186
    end
187
    else
188
    begin
189
      TextureBox.Enabled := False;
190
      SamplerBox.Enabled := False;
191
      FillUniformAutoSetMethodList(AutoSetBox.Items, IParam.GLSLType);
192
      AutoSetBox.ItemIndex :=
193
        MaxInteger(AutoSetBox.Items.IndexOf(IParam.AutoSetMethod), 0);
194
      RedGroup.ItemIndex := -1;
195
      GreenGroup.ItemIndex := -1;
196
      BlueGroup.ItemIndex := -1;
197
      AlphaGroup.ItemIndex := -1;
198
    end;
199
  end;
200
end;
201

202
procedure TShaderUniformEditor.LBUniformsKeyPress(Sender: TObject; var Key: Char);
203
begin
204
  LBUniformsClick(Self);
205
end;
206

207
procedure TShaderUniformEditor.SamplerBoxChange(Sender: TObject);
208
begin
209
  if LBUniforms.ItemIndex >= 0 then
210
  begin
211
    FUniformList[LBUniforms.ItemIndex].SamplerName :=
212
      SamplerBox.Items[SamplerBox.ItemIndex];
213
  end;
214
end;
215

216
procedure TShaderUniformEditor.TextureBoxChange(Sender: TObject);
217
begin
218
  if LBUniforms.ItemIndex >= 0 then
219
  begin
220
    FUniformList[LBUniforms.ItemIndex].TextureName :=
221
      TextureBox.Items[TextureBox.ItemIndex];
222
  end;
223
end;
224

225
procedure TShaderUniformEditor.ColorGroupClick(Sender: TObject);
226
var
227
  SV: TSwizzleVector;
228
begin
229
  if LBUniforms.ItemIndex >= 0 then
230
  begin
231
    if FUniformList[LBUniforms.ItemIndex].GLSLSamplerType = GLSLSamplerUndefined then
232
      exit;
233
    SV := FUniformList[LBUniforms.ItemIndex].GetTextureSwizzle;
234
    SV[TRadioGroup(Sender).Tag] := TGLTextureSwizzle(TRadioGroup(Sender).ItemIndex);
235
    FUniformList[LBUniforms.ItemIndex].SetTextureSwizzle(SV);
236
  end;
237
end;
238

239
procedure TShaderUniformEditor.AddTextureName(const S: string);
240
begin
241
  TextureBox.Items.Add(S);
242
end;
243

244
procedure TShaderUniformEditor.AddSamplerName(const S: string);
245
begin
246
  SamplerBox.Items.Add(S);
247
end;
248

249
initialization
250

251
{$i FShaderUniformEditor.lrs}
252

253
finalization
254

255
   ReleaseShaderUniformEditor;
256

257
end.
258