Luxophia

1
unit LUX.FMX.Material;
2

3
interface
4

5
uses
6
  System.Classes,
7
  System.UITypes,
8
  System.Generics.Collections,
9
  System.Types,
10
  System.Math.Vectors,
11

12
  FMX.Types,
13
  FMX.Types3D,
14
  FMX.MaterialSources,
15
  Winapi.D3DCommon,
16
  Winapi.D3D11Shader,
17
  Winapi.D3DCompiler,
18

19
  LUX,
20
  LUX.FMX.Types3D;
21

22
type
23

24
  TShaderVar = class;
25
  TShaderVar<_TValue_> = class;
26
  TShaderVarPrim<_TValue_> = class;
27
  TShaderVarSingle = class;
28
  TShaderVarPointF = class;
29
  TShaderVarPoint3D = class;
30
  TShaderVarVector3D = class;
31
  TShaderVarColor = class;
32
  TShaderVarColorF = class;
33
  TShaderVarMatrix3D = class;
34
  TShaderVarTexture = class;
35
  TShaderVarTexture3D<_TValue_: TTexture3D> = class;
36
  TShaderVarLight = class;
37

38
  TShaderSource = class;
39
  TShaderSourceV = class;
40
  TShaderSourceP = class;
41

42
  TLuxMaterial = class;
43

44
  TShaderVars = array of TShaderVar;
45

46
  // TShaderVar
47

48
  TShaderVar = class
49
  private
50
  protected
51
    _Name: String;
52
    function GetSize: Integer; virtual; abstract;
53
  public
54
    constructor Create(const Name_: String);
55
    property Name: String read _Name write _Name;
56
    property Size: Integer read GetSize;
57
    function GetVars(var I_, T_: Integer; const U_: Byte): TContextShaderVariables;
58
      virtual; abstract;
59
    procedure SendVar(const Context_: TContext3D); virtual; abstract;
60
    function GetSource(var C_: Integer; var T_: Integer): String; virtual; abstract;
61
  end;
62

63
  // TShaderVar<_TValue_>
64

65
  TShaderVar<_TValue_> = class(TShaderVar)
66
  private
67
  protected
68
    _Value: _TValue_;
69
    procedure SetValue(const Value_: _TValue_); virtual;
70
  public
71
    property Value: _TValue_ read _Value write SetValue;
72
  end;
73

74
  // TShaderVarPrim
75

76
  TShaderVarPrim<_TValue_> = class(TShaderVar<_TValue_>)
77
  private
78
  protected
79
    function GetKind: TContextShaderVariableKind; virtual; abstract;
80
  public
81
    property Kind: TContextShaderVariableKind read GetKind;
82
    function GetVars(var I_, T_: Integer; const U_: Byte): TContextShaderVariables; override;
83
  end;
84

85
  // TShaderVarSingle
86

87
  TShaderVarSingle = class(TShaderVarPrim<Single>)
88
  private
89
  protected
90

91
    function GetKind: TContextShaderVariableKind; override;
92
    function GetSize: Integer; override;
93
  public
94

95
    procedure SendVar(const Context_: TContext3D); override;
96
    function GetSource(var C_: Integer; var T_: Integer): String; override;
97
  end;
98

99
  // TShaderVarPointF
100

101
  TShaderVarPointF = class(TShaderVarPrim<TPointF>)
102
  private
103
  protected
104

105
    function GetKind: TContextShaderVariableKind; override;
106
    function GetSize: Integer; override;
107
  public
108

109
    procedure SendVar(const Context_: TContext3D); override;
110
    function GetSource(var C_: Integer; var T_: Integer): String; override;
111
  end;
112

113
  // TShaderVarPoint3D
114

115
  TShaderVarPoint3D = class(TShaderVarPrim<TPoint3D>)
116
  private
117
  protected
118

119
    function GetKind: TContextShaderVariableKind; override;
120
    function GetSize: Integer; override;
121
  public
122

123
    procedure SendVar(const Context_: TContext3D); override;
124
    function GetSource(var C_: Integer; var T_: Integer): String; override;
125
  end;
126

127
  // TShaderVarVector3D
128

129
  TShaderVarVector3D = class(TShaderVarPrim<TVector3D>)
130
  private
131
  protected
132

133
    function GetKind: TContextShaderVariableKind; override;
134
    function GetSize: Integer; override;
135
  public
136

137
    procedure SendVar(const Context_: TContext3D); override;
138
    function GetSource(var C_: Integer; var T_: Integer): String; override;
139
  end;
140

141
  // TShaderVarColor
142

143
  TShaderVarColor = class(TShaderVarPrim<TAlphaColor>)
144
  private
145
  protected
146

147
    function GetKind: TContextShaderVariableKind; override;
148
    function GetSize: Integer; override;
149
  public
150

151
    procedure SendVar(const Context_: TContext3D); override;
152
    function GetSource(var C_: Integer; var T_: Integer): String; override;
153
  end;
154

155
  // TShaderVarColorF
156

157
  TShaderVarColorF = class(TShaderVarPrim<TAlphaColorF>)
158
  private
159
  protected
160

161
    function GetKind: TContextShaderVariableKind; override;
162
    function GetSize: Integer; override;
163
  public
164

165
    procedure SendVar(const Context_: TContext3D); override;
166
    function GetSource(var C_: Integer; var T_: Integer): String; override;
167
  end;
168

169
  // TShaderVarMatrix3D
170

171
  TShaderVarMatrix3D = class(TShaderVarPrim<TMatrix3D>)
172
  private
173
  protected
174

175
    function GetKind: TContextShaderVariableKind; override;
176
    function GetSize: Integer; override;
177
  public
178

179
    function GetVars(var I_, T_: Integer; const U_: Byte): TContextShaderVariables; override;
180
    procedure SendVar(const Context_: TContext3D); override;
181
    function GetSource(var C_: Integer; var T_: Integer): String; override;
182
  end;
183

184
  // TShaderVarTexture
185

186
  TShaderVarTexture = class(TShaderVarPrim<TTexture>)
187
  private
188
  protected
189

190
    function GetKind: TContextShaderVariableKind; override;
191
    function GetSize: Integer; override;
192
  public
193

194
    procedure SendVar(const Context_: TContext3D); override;
195
    function GetVars(var I_, T_: Integer; const U_: Byte): TContextShaderVariables; override;
196
    function GetSource(var C_: Integer; var T_: Integer): String; override;
197
  end;
198

199
  // TShaderVarTexture3D<_TValue_>
200

201
  TShaderVarTexture3D<_TValue_: TTexture3D> = class(TShaderVarPrim<_TValue_>)
202
  private
203
  protected
204

205
    function GetKind: TContextShaderVariableKind; override;
206
    function GetSize: Integer; override;
207
  public
208
    constructor Create(const Name_: String);
209
    destructor Destroy; override;
210

211
    procedure SendVar(const Context_: TContext3D); override;
212
    function GetVars(var I_, T_: Integer; const U_: Byte): TContextShaderVariables; override;
213
    function GetSource(var C_: Integer; var T_: Integer): String; override;
214
  end;
215

216
  // TShaderVarLight
217

218
  TShaderVarLight = class(TShaderVar<TLightDescription>)
219
  private
220
    _Opt: TShaderVarPoint3D;
221
    _Pos: TShaderVarPoint3D;
222
    _Dir: TShaderVarPoint3D;
223
    _Col: TShaderVarColor;
224
  protected
225

226
    function GetSize: Integer; override;
227
    procedure SetValue(const Value_: TLightDescription); override;
228
  public
229
    constructor Create(const Name_: String);
230
    destructor Destroy; override;
231

232
    function GetVars(var I_, T_: Integer; const U_: Byte): TContextShaderVariables; override;
233
    procedure SendVar(const Context_: TContext3D); override;
234
    function GetSource(var C_: Integer; var T_: Integer): String; override;
235
  end;
236

237
  // TShaderSource
238

239
  TShaderSource = class
240
  private
241
  protected
242
    _Name: String;
243
    _Shader: TContextShader;
244
    _Vars: TShaderVars;
245
    _Entry: AnsiString;
246
    _Source: TStringList;
247
    _Targets: TDictionary<TContextShaderArch, AnsiString>;
248
    _Errors: TDictionary<String, String>;
249

250
    function GetKind: TContextShaderKind; virtual; abstract;
251
    procedure SetSource(Sender_: TObject);
252
  public
253
    constructor Create;
254
    destructor Destroy; override;
255

256
    property Name: String read _Name write _Name;
257
    property Shader: TContextShader read _Shader write _Shader;
258
    property Kind: TContextShaderKind read GetKind;
259
    property Vars: TShaderVars read _Vars write _Vars;
260
    property Entry: AnsiString read _Entry write _Entry;
261
    property Source: TStringList read _Source;
262
    property Errors: TDictionary<String, String> read _Errors;
263

264
    procedure LoadFromFile(const Name_: String);
265
    procedure LoadFromStream(const Stream_: TStream);
266
    procedure LoadFromResource(const Name_: String);
267
    function GetVars(const A_: TContextShaderArch): TContextShaderVariables;
268
    procedure Compile;
269
    procedure SendVars(const Context_: TContext3D);
270
    function GetSources: String;
271
  end;
272

273
  // TShaderSourceV
274

275
  TShaderSourceV = class(TShaderSource)
276
  private
277
  protected
278

279
    function GetKind: TContextShaderKind; override;
280
  public
281
    constructor Create;
282
  end;
283

284
  // TShaderSourceP
285

286
  TShaderSourceP = class(TShaderSource)
287
  private
288
  protected
289

290
    function GetKind: TContextShaderKind; override;
291
  public
292
    constructor Create;
293
  end;
294

295
  // TLuxMaterial
296

297
  TLuxMaterial = class(TMaterial)
298
  private
299
  protected
300
    _ShaderV: TShaderSourceV;
301
    _ShaderP: TShaderSourceP;
302

303
    procedure DoInitialize; override;
304
  public
305
    constructor Create; override;
306
    destructor Destroy; override;
307

308
    property ShaderV: TShaderSourceV read _ShaderV;
309
    property ShaderP: TShaderSourceP read _ShaderP;
310
  end;
311

312
  // TMaterialSource<_TMaterial_>
313

314
  TLuxMaterialSource<_TMaterial_: TLuxMaterial> = class(TMaterialSource)
315
  private
316

317
    function GetMaterial: _TMaterial_;
318
  protected
319

320
    function GetShaderV: TShaderSourceV;
321
    function GetShaderP: TShaderSourceP;
322

323
    property _Material: _TMaterial_ read GetMaterial;
324

325
    function CreateMaterial: TMaterial; override;
326
  public
327

328
    property ShaderV: TShaderSourceV read GetShaderV;
329
    property ShaderP: TShaderSourceP read GetShaderP;
330
  end;
331

332
const
333

334
  VARUNIT: array [TContextShaderArch] of Byte =
335
   (1, // Undefined,
336
    1, // DX9,
337
    16, // DX10,
338
    16, // DX11_level_9,
339
    16, // DX11,
340
    1, // Metal,
341
    1, // GLSL,
342
    1, // Mac,
343
    1, // IOS,
344
    1, // Android
345
    0);
346

347
function PixelFormatToColorN(const PF_: TPixelFormat): Byte;
348

349
implementation
350

351
uses
352
  System.SysUtils,
353
  System.IOUtils,
354
  System.Math,
355
  System.AnsiStrings;
356

357

358
// TShaderVar
359

360
constructor TShaderVar.Create(const Name_: String);
361
begin
362
  inherited Create;
363

364
  _Name := Name_;
365
end;
366

367
procedure TShaderVar<_TValue_>.SetValue(const Value_: _TValue_);
368
begin
369
  _Value := Value_;
370
end;
371

372

373
// TShaderVarPrim<_TValue_>
374

375
function TShaderVarPrim<_TValue_>.GetVars(var I_, T_: Integer; const U_: Byte)
376
  : TContextShaderVariables;
377
begin
378
  Result := [TContextShaderVariable.Create(Name, Kind, I_, U_ * Size)];
379

380
  Inc(I_, Size * U_);
381
end;
382

383
// TShaderVarSingle
384

385
function TShaderVarSingle.GetKind: TContextShaderVariableKind;
386
begin
387
  Result := TContextShaderVariableKind.Float;
388
end;
389

390
function TShaderVarSingle.GetSize: Integer;
391
begin
392
  Result := 1;
393
end;
394

395
procedure TShaderVarSingle.SendVar(const Context_: TContext3D);
396
begin
397
  Context_.SetShaderVariable(_Name, [TVector3D.Create(_Value, 0, 0, 0)]);
398
end;
399

400
function TShaderVarSingle.GetSource(var C_: Integer; var T_: Integer): String;
401
begin
402
  Result := 'float ' + _Name + ' : register( c' + C_.ToString + ' );' + CRLF;
403

404
  Inc(C_, Size);
405
end;
406

407
// TShaderVarPointF
408

409
function TShaderVarPointF.GetKind: TContextShaderVariableKind;
410
begin
411
  Result := TContextShaderVariableKind.Float2;
412
end;
413

414
function TShaderVarPointF.GetSize: Integer;
415
begin
416
  Result := 1;
417
end;
418

419
procedure TShaderVarPointF.SendVar(const Context_: TContext3D);
420
begin
421
  Context_.SetShaderVariable(_Name, [TVector3D.Create(_Value.X, _Value.Y, 0, 0)]);
422
end;
423

424
function TShaderVarPointF.GetSource(var C_: Integer; var T_: Integer): String;
425
begin
426
  Result := 'float2 ' + _Name + ' : register( c' + C_.ToString + ' );' + CRLF;
427

428
  Inc(C_, Size);
429
end;
430

431
// TShaderVarPoint3D
432

433
function TShaderVarPoint3D.GetKind: TContextShaderVariableKind;
434
begin
435
  Result := TContextShaderVariableKind.Float3;
436
end;
437

438
function TShaderVarPoint3D.GetSize: Integer;
439
begin
440
  Result := 1;
441
end;
442

443
procedure TShaderVarPoint3D.SendVar(const Context_: TContext3D);
444
begin
445
  Context_.SetShaderVariable(_Name, [TVector3D.Create(_Value.X, _Value.Y, _Value.Z, 0)]);
446
end;
447

448
function TShaderVarPoint3D.GetSource(var C_: Integer; var T_: Integer): String;
449
begin
450
  Result := 'float3 ' + _Name + ' : register( c' + C_.ToString + ' );' + CRLF;
451

452
  Inc(C_, Size);
453
end;
454

455
// TShaderVarVector3D
456

457
function TShaderVarVector3D.GetKind: TContextShaderVariableKind;
458
begin
459
  Result := TContextShaderVariableKind.Vector;
460
end;
461

462
function TShaderVarVector3D.GetSize: Integer;
463
begin
464
  Result := 1;
465
end;
466

467
procedure TShaderVarVector3D.SendVar(const Context_: TContext3D);
468
begin
469
  Context_.SetShaderVariable(_Name, _Value);
470
end;
471

472
function TShaderVarVector3D.GetSource(var C_: Integer; var T_: Integer): String;
473
begin
474
  Result := 'float4 ' + _Name + ' : register( c' + C_.ToString + ' );' + CRLF;
475

476
  Inc(C_, Size);
477
end;
478

479
// TShaderVarColor
480

481
function TShaderVarColor.GetKind: TContextShaderVariableKind;
482
begin
483
  Result := TContextShaderVariableKind.Vector;
484
end;
485

486
function TShaderVarColor.GetSize: Integer;
487
begin
488
  Result := 1;
489
end;
490

491
procedure TShaderVarColor.SendVar(const Context_: TContext3D);
492
begin
493
  Context_.SetShaderVariable(_Name, _Value);
494
end;
495

496
function TShaderVarColor.GetSource(var C_: Integer; var T_: Integer): String;
497
begin
498
  Result := 'float4 ' + _Name + ' : register( c' + C_.ToString + ' );' + CRLF;
499

500
  Inc(C_, Size);
501
end;
502

503
// TShaderVarColorF
504

505
function TShaderVarColorF.GetKind: TContextShaderVariableKind;
506
begin
507
  Result := TContextShaderVariableKind.Vector;
508
end;
509

510
function TShaderVarColorF.GetSize: Integer;
511
begin
512
  Result := 1;
513
end;
514

515
procedure TShaderVarColorF.SendVar(const Context_: TContext3D);
516
begin
517
  with _Value do
518
    Context_.SetShaderVariable(_Name, TVector3D.Create(R, G, B, A));
519
end;
520

521
function TShaderVarColorF.GetSource(var C_: Integer; var T_: Integer): String;
522
begin
523
  Result := 'float4 ' + _Name + ' : register( c' + C_.ToString + ' );' + CRLF;
524

525
  Inc(C_, Size);
526
end;
527

528
// TShaderVarMatrix3D
529

530
function TShaderVarMatrix3D.GetKind: TContextShaderVariableKind;
531
begin
532
  Result := TContextShaderVariableKind.Matrix;
533
end;
534

535
function TShaderVarMatrix3D.GetSize: Integer;
536
begin
537
  Result := 4;
538
end;
539

540
function TShaderVarMatrix3D.GetVars(var I_, T_: Integer; const U_: Byte): TContextShaderVariables;
541
begin
542
  Result := [TContextShaderVariable.Create(Name, Kind, I_, U_ * Size)];
543

544
  Inc(I_, Size * U_);
545
end;
546

547
procedure TShaderVarMatrix3D.SendVar(const Context_: TContext3D);
548
begin
549
  Context_.SetShaderVariable(_Name, _Value);
550
end;
551

552
function TShaderVarMatrix3D.GetSource(var C_: Integer; var T_: Integer): String;
553
begin
554
  Result := 'row_major float4x4 ' + _Name + ' : register( c' + C_.ToString + ' );' + CRLF;
555

556
  Inc(C_, Size);
557
end;
558

559
// TShaderVarTexture
560

561
function TShaderVarTexture.GetKind: TContextShaderVariableKind;
562
begin
563
  Result := TContextShaderVariableKind.Texture;
564
end;
565

566
function TShaderVarTexture.GetSize: Integer;
567
begin
568
  Result := 0;
569
end;
570

571
function TShaderVarTexture.GetVars(var I_, T_: Integer; const U_: Byte): TContextShaderVariables;
572
begin
573
  Result := [TContextShaderVariable.Create(Name, Kind, T_, U_ * Size)];
574

575
  Inc(T_, 1);
576
end;
577

578
procedure TShaderVarTexture.SendVar(const Context_: TContext3D);
579
begin
580
  Context_.SetShaderVariable(_Name, _Value);
581
end;
582

583
function TShaderVarTexture.GetSource(var C_: Integer; var T_: Integer): String;
584
begin
585
  Result := 'Texture2D<float4> ' + _Name + ' : register( t' + T_.ToString + ' );' + CRLF;
586

587
  Inc(T_, 1);
588
end;
589

590
// TShaderVarTexture3D
591

592
constructor TShaderVarTexture3D<_TValue_>.Create(const Name_: String);
593
begin
594
  inherited;
595

596
  _Value := _TValue_.Create;
597
end;
598

599
destructor TShaderVarTexture3D<_TValue_>.Destroy;
600
begin
601
  _Value.Free;
602

603
  inherited;
604
end;
605

606
function TShaderVarTexture3D<_TValue_>.GetKind: TContextShaderVariableKind;
607
begin
608
  Result := TContextShaderVariableKind.Texture;
609
end;
610

611
function TShaderVarTexture3D<_TValue_>.GetSize: Integer;
612
begin
613
  Result := 0;
614
end;
615

616
function TShaderVarTexture3D<_TValue_>.GetVars(var I_, T_: Integer; const U_: Byte)
617
  : TContextShaderVariables;
618
begin
619
  Result := [TContextShaderVariable.Create(Name, Kind, T_, U_ * Size)];
620

621
  Inc(T_, 1);
622
end;
623

624
procedure TShaderVarTexture3D<_TValue_>.SendVar(const Context_: TContext3D);
625
begin
626
  Context_.SetShaderVariable(_Name, _Value);
627
end;
628

629
function TShaderVarTexture3D<_TValue_>.GetSource(var C_: Integer; var T_: Integer): String;
630
begin
631
  Result := 'Texture3D<float' + PixelFormatToColorN(_Value.PixelFormat).ToString + '> ' + _Name +
632
    ' : register( t' + T_.ToString + ' );' + CRLF;
633

634
  Inc(T_, 1);
635
end;
636

637
// TShaderVarLight
638

639
function TShaderVarLight.GetSize: Integer;
640
begin
641
  Result := _Opt.Size + _Pos.Size + _Dir.Size + _Col.Size;
642
end;
643

644
procedure TShaderVarLight.SetValue(const Value_: TLightDescription);
645
begin
646
  inherited;
647

648
  with _Value do
649
  begin
650
    _Opt.Value := TPoint3D.Create(Integer(LightType) + 1, Cos(DegToRad(SpotCutoff)), SpotExponent);
651
    _Pos.Value := Position;
652
    _Dir.Value := Direction;
653
    _Col.Value := Color;
654
  end;
655
end;
656

657
constructor TShaderVarLight.Create(const Name_: String);
658
begin
659
  inherited;
660

661
  _Opt := TShaderVarPoint3D.Create(_Name + '.Opt');
662
  _Pos := TShaderVarPoint3D.Create(_Name + '.Pos');
663
  _Dir := TShaderVarPoint3D.Create(_Name + '.Dir');
664
  _Col := TShaderVarColor.Create(_Name + '.Col');
665
end;
666

667
destructor TShaderVarLight.Destroy;
668
begin
669
  _Opt.Free;
670
  _Pos.Free;
671
  _Dir.Free;
672
  _Col.Free;
673
end;
674

675
function TShaderVarLight.GetVars(var I_, T_: Integer; const U_: Byte): TContextShaderVariables;
676
begin
677
  Result := _Opt.GetVars(I_, T_, U_) + _Pos.GetVars(I_, T_, U_) + _Dir.GetVars(I_, T_, U_) +
678
    _Col.GetVars(I_, T_, U_);
679
end;
680

681
procedure TShaderVarLight.SendVar(const Context_: TContext3D);
682
begin
683
  _Opt.SendVar(Context_);
684
  _Pos.SendVar(Context_);
685
  _Dir.SendVar(Context_);
686
  _Col.SendVar(Context_);
687
end;
688

689
function TShaderVarLight.GetSource(var C_: Integer; var T_: Integer): String;
690
begin
691
  Result := 'struct TLight' + CRLF + '{' + CRLF + '    float3 Opt;' + CRLF + '    float3 Pos;' +
692
    CRLF + '    float3 Dir;' + CRLF + '    float4 Col;' + CRLF + '};' + CRLF + 'TLight ' + _Name +
693
    ' : register( c' + C_.ToString + ' );' + CRLF;
694

695
  Inc(C_, Size);
696
end;
697

698
// TShaderSource
699

700
procedure TShaderSource.SetSource(Sender_: TObject);
701
begin
702
  Compile;
703
end;
704

705
constructor TShaderSource.Create;
706
begin
707
  inherited;
708

709
  _Source := TStringList.Create;
710
  _Source.OnChange := SetSource;
711

712
  _Targets := TDictionary<TContextShaderArch, AnsiString>.Create;
713
  _Errors := TDictionary<String, String>.Create;
714
end;
715

716
destructor TShaderSource.Destroy;
717
begin
718
  _Errors.Free;
719
  _Targets.Free;
720

721
  _Source.Free;
722

723
  inherited;
724
end;
725

726
procedure TShaderSource.LoadFromFile(const Name_: String);
727
begin
728
  _Source.LoadFromFile(Name_);
729

730
  _Name := TPath.GetFileName(Name_);
731

732
  Compile;
733
end;
734

735
procedure TShaderSource.LoadFromStream(const Stream_: TStream);
736
begin
737
  _Source.LoadFromStream(Stream_);
738

739
  _Name := '';
740

741
  Compile;
742
end;
743

744
procedure TShaderSource.LoadFromResource(const Name_: String);
745
var
746
  RS: TResourceStream;
747
begin
748
  RS := TResourceStream.Create(HInstance, Name_, RT_RCDATA);
749

750
  LoadFromStream(RS);
751

752
  RS.Free;
753

754
  _Name := Name_;
755
end;
756

757
function TShaderSource.GetVars(const A_: TContextShaderArch): TContextShaderVariables;
758
var
759
  V: TShaderVar;
760
  C, T: Integer;
761
begin
762
  Result := [];
763
  C := 0;
764
  T := 0;
765

766
  for V in _Vars do
767
    Result := Result + V.GetVars(C, T, VARUNIT[A_]);
768
end;
769

770
procedure TShaderSource.Compile;
771
var
772
  S, N, T: AnsiString;
773
  CSSs: array of TContextShaderSource;
774
  A: TContextShaderArch;
775
  H: HResult;
776
  B, E: ID3DBlob;
777
  Bs: TArray<Byte>;
778
  M: String;
779
begin
780
  TShaderManager.UnregisterShader(_Shader);
781

782
  _Errors.Clear;
783

784
  S := AnsiString(GetSources + _Source.Text);
785
  N := AnsiString(_Name);
786

787
  CSSs := [];
788

789
  for A in _Targets.Keys do
790
  begin
791
    T := _Targets[A];
792

793
    H := D3DCompile(PAnsiChar(S), Length(S), PAnsiChar(N), nil, nil, PAnsiChar(_Entry),
794
      PAnsiChar(T), D3DCOMPILE_OPTIMIZATION_LEVEL3, 0, B, E);
795

796
    if Assigned(B) then
797
    begin
798
      SetLength(Bs, B.GetBufferSize);
799

800
      Move(B.GetBufferPointer^, Bs[0], B.GetBufferSize);
801

802
      CSSs := CSSs + [TContextShaderSource.Create(A, Bs, GetVars(A))];
803
    end
804
    else
805
    begin
806
      SetString(M, PAnsiChar(E.GetBufferPointer), E.GetBufferSize);
807

808
      _Errors.Add(String(T), M);
809
    end;
810
  end;
811

812
  if Assigned(CSSs) then
813
    _Shader := TShaderManager.RegisterShaderFromData(_Name, GetKind, '', CSSs);
814
end;
815

816
procedure TShaderSource.SendVars(const Context_: TContext3D);
817
var
818
  V: TShaderVar;
819
begin
820
  for V in _Vars do
821
    V.SendVar(Context_);
822
end;
823

824
function TShaderSource.GetSources: String;
825
var
826
  V: TShaderVar;
827
  C, T: Integer;
828
begin
829
  Result := '';
830
  C := 0;
831
  T := 0;
832

833
  for V in _Vars do
834
    Result := Result + V.GetSource(C, T);
835
end;
836

837
// TShaderSourceV
838

839
function TShaderSourceV.GetKind: TContextShaderKind;
840
begin
841
  Result := TContextShaderKind.VertexShader;
842
end;
843

844
constructor TShaderSourceV.Create;
845
begin
846
  inherited;
847

848
  _Entry := 'MainV';
849

850
  _Targets.Add(TContextShaderArch.DX9, 'vs_3_0');
851
  _Targets.Add(TContextShaderArch.DX11_level_9, 'vs_4_0_level_9_3');
852
  _Targets.Add(TContextShaderArch.DX11, 'vs_5_0');
853
end;
854

855
// TShaderSourceP
856

857
function TShaderSourceP.GetKind: TContextShaderKind;
858
begin
859
  Result := TContextShaderKind.PixelShader;
860
end;
861

862
constructor TShaderSourceP.Create;
863
begin
864
  inherited;
865

866
  _Entry := 'MainP';
867

868
  _Targets.Add(TContextShaderArch.DX9, 'ps_3_0');
869
  _Targets.Add(TContextShaderArch.DX11_level_9, 'ps_4_0_level_9_3');
870
  _Targets.Add(TContextShaderArch.DX11, 'ps_5_0');
871
end;
872

873
// TLuxMaterial
874

875
procedure TLuxMaterial.DoInitialize;
876
begin
877
  inherited;
878

879
end;
880

881
constructor TLuxMaterial.Create;
882
begin
883
  inherited;
884

885
  _ShaderV := TShaderSourceV.Create;
886
  _ShaderP := TShaderSourceP.Create;
887
end;
888

889
destructor TLuxMaterial.Destroy;
890
begin
891
  _ShaderV.Free;
892
  _ShaderP.Free;
893

894
  inherited;
895
end;
896

897
// TLuxMaterialSource<_TMaterial_>
898

899
function TLuxMaterialSource<_TMaterial_>.GetMaterial: _TMaterial_;
900
begin
901
  Result := _TMaterial_(Material);
902
end;
903

904
function TLuxMaterialSource<_TMaterial_>.GetShaderV: TShaderSourceV;
905
begin
906
  Result := _Material.ShaderV;
907
end;
908

909
function TLuxMaterialSource<_TMaterial_>.GetShaderP: TShaderSourceP;
910
begin
911
  Result := _Material.ShaderP;
912
end;
913

914
function TLuxMaterialSource<_TMaterial_>.CreateMaterial: TMaterial;
915
begin
916
  Result := _TMaterial_.Create;
917
end;
918

919
function PixelFormatToColorN(const PF_: TPixelFormat): Byte;
920
begin
921
  case PF_ of
922
    TPixelFormat.RGB:
923
      Result := 3;
924
    TPixelFormat.RGBA:
925
      Result := 4;
926
    TPixelFormat.BGR:
927
      Result := 3;
928
    TPixelFormat.BGRA:
929
      Result := 4;
930
    TPixelFormat.RGBA16:
931
      Result := 4;
932
    TPixelFormat.BGR_565:
933
      Result := 3;
934
    TPixelFormat.BGRA4:
935
      Result := 4;
936
    TPixelFormat.BGR4:
937
      Result := 3;
938
    TPixelFormat.BGR5_A1:
939
      Result := 4;
940
    TPixelFormat.BGR5:
941
      Result := 3;
942
    TPixelFormat.BGR10_A2:
943
      Result := 4;
944
    TPixelFormat.RGB10_A2:
945
      Result := 4;
946
    TPixelFormat.L:
947
      Result := 1;
948
    TPixelFormat.LA:
949
      Result := 2;
950
    TPixelFormat.LA4:
951
      Result := 2;
952
    TPixelFormat.L16:
953
      Result := 1;
954
    TPixelFormat.A:
955
      Result := 1;
956
    TPixelFormat.R16F:
957
      Result := 1;
958
    TPixelFormat.RG16F:
959
      Result := 2;
960
    TPixelFormat.RGBA16F:
961
      Result := 4;
962
    TPixelFormat.R32F:
963
      Result := 1;
964
    TPixelFormat.RG32F:
965
      Result := 2;
966
    TPixelFormat.RGBA32F:
967
      Result := 4;
968
  else
969
    Result := 4;
970
  end;
971
end;
972

973
initialization
974

975
finalization
976

977
end.
978