Luxophia

1
unit LIB.Material;
2

3
interface
4

5
uses
6
  System.Classes,
7
  System.UITypes,
8
  System.Math.Vectors,
9
  System.SysUtils,
10
  System.RTLConsts,
11

12
  FMX.Types3D,
13
  FMX.Controls3D,
14
  FMX.MaterialSources,
15
  LUX,
16
  LUX.FMX.Material,
17
  LUX.FMX.Types3D;
18

19
type
20
  // TMyMaterial
21

22
  TMyMaterial = class(TLuxMaterial)
23
  private
24
  protected
25
    _MatrixLS: TShaderVarMatrix3D;
26
    _MatrixLG: TShaderVarMatrix3D;
27
    _MatrixGL: TShaderVarMatrix3D;
28
    _Light: TShaderVarLight;
29
    _EyePos: TShaderVarVector3D;
30
    _Opacity: TShaderVarSingle;
31
    _Size: TShaderVarPoint3D;
32
    _Texture3D: TShaderVarTexture3D<TTexture3DRGBA32F>;
33
    procedure DoApply(const Context_: TContext3D); override;
34
  public
35
    constructor Create; override;
36
    destructor Destroy; override;
37
    property Size: TShaderVarPoint3D read _Size;
38
    property Texture3D: TShaderVarTexture3D<TTexture3DRGBA32F> read _Texture3D;
39
  end;
40

41
  // TMyMaterialSource
42

43
  TMyMaterialSource = class(TLuxMaterialSource<TMyMaterial>)
44
  private
45
  protected
46
    function GetSize: TPoint3D;
47
    procedure SetSize(const Size_: TPoint3D);
48
    function GetTexture3D: TTexture3DRGBA32F;
49
  public
50
    property Size: TPoint3D read GetSize write SetSize;
51
    property Texture3D: TTexture3DRGBA32F read GetTexture3D;
52
  end;
53

54
  // TVolumeCube
55

56
  TVolumeCube = class(TControl3D)
57
  private
58
    procedure MakeModel;
59
  protected
60
    _Geometry: TMeshData;
61
    _Material: TMyMaterialSource;
62
    procedure SetWidth(const Value_: Single); override;
63
    procedure SetHeight(const Value_: Single); override;
64
    procedure SetDepth(const Value_: Single); override;
65
    function GetTexture3D: TTexture3DRGBA32F;
66
    procedure Render; override;
67
  public
68
    constructor Create(Owner_: TComponent); override;
69
    destructor Destroy; override;
70
    property Material: TMyMaterialSource read _Material;
71
  end;
72

73

74
implementation
75

76
// TMyMaterial
77

78
procedure TMyMaterial.DoApply(const Context_: TContext3D);
79
begin
80
  inherited;
81

82
  with Context_ do
83
  begin
84
    SetShaders(_ShaderV.Shader, _ShaderP.Shader);
85

86
    _MatrixLS.Value := CurrentModelViewProjectionMatrix;
87
    _MatrixLG.Value := CurrentMatrix;
88
    _MatrixGL.Value := CurrentMatrix.Inverse;
89
    _Light.Value := Lights[0];
90
    _EyePos.Value := CurrentCameraInvMatrix.M[3];
91
    _Opacity.Value := CurrentOpacity;
92
  end;
93

94
  _ShaderV.SendVars(Context_);
95
  _ShaderP.SendVars(Context_);
96
end;
97

98
constructor TMyMaterial.Create;
99
begin
100
  inherited;
101

102
  _MatrixLS := TShaderVarMatrix3D.Create('_MatrixLS');
103
  _MatrixLG := TShaderVarMatrix3D.Create('_MatrixLG');
104
  _MatrixGL := TShaderVarMatrix3D.Create('_MatrixGL');
105
  _Light := TShaderVarLight.Create('_Light');
106
  _EyePos := TShaderVarVector3D.Create('_EyePos');
107
  _Opacity := TShaderVarSingle.Create('_Opacity');
108
  _Size := TShaderVarPoint3D.Create('_Size');
109
  _Texture3D := TShaderVarTexture3D<TTexture3DRGBA32F>.Create('_Texture3D');
110

111
  _Size.Value := TPoint3D.Create(1, 1, 1);
112

113
  _ShaderV.Vars := [_MatrixLS];
114

115
  _ShaderP.Vars := [_MatrixLG, _MatrixGL, _Light, _EyePos, _Opacity, _Size, _Texture3D];
116
end;
117

118
destructor TMyMaterial.Destroy;
119
begin
120
  _MatrixLS.Free;
121
  _MatrixLG.Free;
122
  _MatrixGL.Free;
123
  _Light.Free;
124
  _EyePos.Free;
125
  _Opacity.Free;
126
  _Size.Free;
127
  _Texture3D.Free;
128

129
  inherited;
130
end;
131

132
// TMyMaterialSource
133

134
function TMyMaterialSource.GetSize: TPoint3D;
135
begin
136
  Result := _Material.Size.Value;
137
end;
138

139
procedure TMyMaterialSource.SetSize(const Size_: TPoint3D);
140
begin
141
  _Material.Size.Value := Size_;
142
end;
143

144
function TMyMaterialSource.GetTexture3D: TTexture3DRGBA32F;
145
begin
146
  Result := _Material.Texture3D.Value;
147
end;
148

149
// TVolumeCube
150

151
procedure TVolumeCube.MakeModel;
152
begin
153
  _Material.Size := TPoint3D.Create(Width, Height, Depth);
154
  with _Geometry do
155
  begin
156
    with VertexBuffer do
157
    begin
158
      Length := 8 { Poin };
159

160
      Vertices[0] := TPoint3D.Create(0, 0, 0);
161
      Vertices[1] := TPoint3D.Create(Width, 0, 0);
162
      Vertices[2] := TPoint3D.Create(0, Height, 0);
163
      Vertices[3] := TPoint3D.Create(Width, Height, 0);
164
      Vertices[4] := TPoint3D.Create(0, 0, Depth);
165
      Vertices[5] := TPoint3D.Create(Width, 0, Depth);
166
      Vertices[6] := TPoint3D.Create(0, Height, Depth);
167
      Vertices[7] := TPoint3D.Create(Width, Height, Depth);
168
    end;
169

170
    with IndexBuffer do
171
    begin
172
      Length := 3 { Poin } * 2 { Face } * 6 { Quad };
173

174
      { 4           5
175
        100---------101
176
        ／ |        ／ |
177
        0 ／   |    1 ／   |
178
        000---------001     |
179
        |      |    |      |
180
        |      |    |      |
181
        |     110---|-----111
182
        |   ／ 6    |   ／ 7
183
        | ／        | ／
184
        010---------011
185
        2           3 }
186

187
      Indices[00] := 0;
188
      Indices[01] := 2;
189
      Indices[02] := 4;
190
      Indices[03] := 6;
191
      Indices[04] := 4;
192
      Indices[05] := 2;
193

194
      Indices[06] := 1;
195
      Indices[07] := 5;
196
      Indices[08] := 3;
197
      Indices[09] := 7;
198
      Indices[10] := 3;
199
      Indices[11] := 5;
200

201
      Indices[12] := 0;
202
      Indices[13] := 4;
203
      Indices[14] := 1;
204
      Indices[15] := 5;
205
      Indices[16] := 1;
206
      Indices[17] := 4;
207

208
      Indices[18] := 2;
209
      Indices[19] := 3;
210
      Indices[20] := 6;
211
      Indices[21] := 7;
212
      Indices[22] := 6;
213
      Indices[23] := 3;
214

215
      Indices[24] := 0;
216
      Indices[25] := 1;
217
      Indices[26] := 2;
218
      Indices[27] := 3;
219
      Indices[28] := 2;
220
      Indices[29] := 1;
221

222
      Indices[30] := 4;
223
      Indices[31] := 6;
224
      Indices[32] := 5;
225
      Indices[33] := 7;
226
      Indices[34] := 5;
227
      Indices[35] := 6;
228
    end;
229
  end;
230
end;
231

232
procedure TVolumeCube.SetWidth(const Value_: Single);
233
begin
234
  inherited;
235

236
  MakeModel;
237
end;
238

239
procedure TVolumeCube.SetHeight(const Value_: Single);
240
begin
241
  inherited;
242
  MakeModel;
243
end;
244

245
procedure TVolumeCube.SetDepth(const Value_: Single);
246
begin
247
  inherited;
248
  MakeModel;
249
end;
250

251
function TVolumeCube.GetTexture3D: TTexture3DRGBA32F;
252
begin
253
  Result := _Material.Texture3D;
254
end;
255

256
procedure TVolumeCube.Render;
257
begin
258
  Context.SetMatrix(TMatrix3D.CreateTranslation(TPoint3D.Create(-Width / 2, -Height / 2, -Depth / 2)
259
    ) * AbsoluteMatrix);
260

261
  _Geometry.Render(Context, TMaterialSource.ValidMaterial(_Material), AbsoluteOpacity);
262
end;
263

264
constructor TVolumeCube.Create(Owner_: TComponent);
265
begin
266
  inherited;
267
  _Geometry := TMeshData.Create;
268
  _Material := TMyMaterialSource.Create(Self);
269
  HitTest := False;
270
  MakeModel;
271
end;
272

273
destructor TVolumeCube.Destroy;
274
begin
275
  _Geometry.Free;
276
  _Material.Free;
277
  inherited;
278
end;
279

280
initialization
281

282
finalization
283

284
end.
285