Luxophia

LUX.GPU.OpenGL.Matery.Preset.pas
968 строк · 28.2 Кб
Перенос по словам
1
unit LUX.GPU.OpenGL.Matery.Preset;
2

3
interface //#################################################################### ■
4

5
uses System.SysUtils, System.UITypes,
6
     Winapi.OpenGL, Winapi.OpenGLext,
7
     LUX,
8
     LUX.GPU.OpenGL,
9
     LUX.GPU.OpenGL.Atom.Buffer.UniBuf,
10
     LUX.GPU.OpenGL.Matery,
11
     LUX.GPU.OpenGL.Matery.Textur.Preset;
12

13
type //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【型】
14

15
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
16

17
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
18

19
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLMateryColor
20

21
     IGLMateryColor = interface( IGLMatery )
22
     ['{F155A433-8EE7-45D5-A550-CA8E75677E0F}']
23
     {protected}
24
       ///// アクセス
25
       function GetColor :TAlphaColorF;
26
       procedure SetColor( const Color_:TAlphaColorF );
27
     {public}
28
       ///// プロパティ
29
       property Color :TAlphaColorF read GetColor write SetColor;
30
     end;
31

32
     //-------------------------------------------------------------------------
33

34
     TGLMateryColor = class( TGLMatery, IGLMateryColor )
35
     private
36
     protected
37
       _Color :TGLUniBuf<TAlphaColorF>;
38
       ///// アクセス
39
       function GetColor :TAlphaColorF;
40
       procedure SetColor( const Color_:TAlphaColorF );
41
     public
42
       constructor Create;
43
       destructor Destroy; override;
44
       ///// プロパティ
45
       property Color :TAlphaColorF read GetColor write SetColor;
46
       ///// メソッド
47
       procedure Use; override;
48
       procedure Unuse; override;
49
     end;
50

51
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLMateryRGB
52

53
     IGLMateryRGB = interface( IGLMateryNor )
54
     ['{5729E984-EB08-43A2-A1DD-86A0A569D79C}']
55
     {protected}
56
       ///// アクセス
57
       function GetAmbient :TAlphaColorF;
58
       procedure SetAmbient( const Ambient_:TAlphaColorF );
59
     {public}
60
       ///// プロパティ
61
       property Ambient :TAlphaColorF read GetAmbient write SetAmbient;
62
     end;
63

64
     //-------------------------------------------------------------------------
65

66
     TGLMateryRGB = class( TGLMateryNor, IGLMateryRGB )
67
     private
68
     protected
69
       _Ambient :TGLUniBuf<TAlphaColorF>;
70
       ///// アクセス
71
       function GetAmbient :TAlphaColorF;
72
       procedure SetAmbient( const Ambient_:TAlphaColorF );
73
     public
74
       constructor Create;
75
       destructor Destroy; override;
76
       ///// プロパティ
77
       property Ambient :TAlphaColorF read GetAmbient write SetAmbient;
78
       ///// メソッド
79
       procedure Use; override;
80
       procedure Unuse; override;
81
     end;
82

83
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLMateryDiffuse
84

85
     IGLMateryDiffuse = interface( IGLMateryNor )
86
     ['{8724B083-6A8B-43CA-8368-B60A28E26522}']
87
     {protected}
88
       ///// アクセス
89
       function GetAmbient :TAlphaColorF;
90
       procedure SetAmbient( const Ambient_:TAlphaColorF );
91
     {public}
92
       ///// プロパティ
93
       property Ambient :TAlphaColorF read GetAmbient write SetAmbient;
94
     end;
95

96
     //-------------------------------------------------------------------------
97

98
     TGLMateryDiffuse = class( TGLMateryNor, IGLMateryDiffuse )
99
     private
100
     protected
101
       _Ambient :TGLUniBuf<TAlphaColorF>;
102
       _Diffuse :TGLUniBuf<TAlphaColorF>;
103
       ///// アクセス
104
       function GetAmbient :TAlphaColorF;
105
       procedure SetAmbient( const Ambient_:TAlphaColorF );
106
       function GetDiffuse :TAlphaColorF;
107
       procedure SetDiffuse( const Diffuse_:TAlphaColorF );
108
     public
109
       constructor Create;
110
       destructor Destroy; override;
111
       ///// プロパティ
112
       property Ambient :TAlphaColorF read GetAmbient write SetAmbient;
113
       property Diffuse :TAlphaColorF read GetDiffuse write SetDiffuse;
114
       ///// メソッド
115
       procedure Use; override;
116
       procedure Unuse; override;
117
     end;
118

119
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLMateryPlastic
120

121
     IGLMateryPlastic = interface( IGLMateryImag )
122
     ['{6BFC6C55-3773-424E-8140-EAB4F4812101}']
123
     {protected}
124
       ///// アクセス
125
       function GetAmbient :TAlphaColorF;
126
       procedure SetAmbient( const Ambient_:TAlphaColorF );
127
       function GetDiffuse :TAlphaColorF;
128
       procedure SetDiffuse( const Diffuse_:TAlphaColorF );
129
       function GetRefI :Single;
130
       procedure SetRefI( const RefI_:Single );
131
     {public}
132
       ///// プロパティ
133
       property Ambient :TAlphaColorF read GetAmbient write SetAmbient;
134
       property Diffuse :TAlphaColorF read GetDiffuse write SetDiffuse;
135
       property RefI    :Single       read GetRefI    write SetRefI   ;
136
     end;
137

138
     //-------------------------------------------------------------------------
139

140
     TGLMateryPlastic = class( TGLMateryImag, IGLMateryPlastic )
141
     private
142
     protected
143
       _Ambient :TGLUniBuf<TAlphaColorF>;
144
       _Diffuse :TGLUniBuf<TAlphaColorF>;
145
       _RefI    :TGLUniBuf<Single>;
146
       ///// アクセス
147
       function GetAmbient :TAlphaColorF;
148
       procedure SetAmbient( const Ambient_:TAlphaColorF );
149
       function GetDiffuse :TAlphaColorF;
150
       procedure SetDiffuse( const Diffuse_:TAlphaColorF );
151
       function GetRefI :Single;
152
       procedure SetRefI( const RefI_:Single );
153
     public
154
       constructor Create;
155
       destructor Destroy; override;
156
       ///// プロパティ
157
       property Ambient :TAlphaColorF read GetAmbient write SetAmbient;
158
       property Diffuse :TAlphaColorF read GetDiffuse write SetDiffuse;
159
       property RefI    :Single       read GetRefI    write SetRefI   ;
160
       ///// メソッド
161
       procedure Use; override;
162
       procedure Unuse; override;
163
     end;
164

165
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLMateryMirror
166

167
     IGLMateryMirror = interface( IGLMateryImag )
168
     ['{2B1DD157-1296-4201-8285-8063CCF6CD03}']
169
     {protected}
170
       ///// アクセス
171
       function GetColor :TAlphaColorF;
172
       procedure SetColor( const Color_:TAlphaColorF );
173
     {public}
174
       ///// プロパティ
175
       property Color :TAlphaColorF read GetColor write SetColor;
176
     end;
177

178
     //-------------------------------------------------------------------------
179

180
     TGLMateryMirror = class( TGLMateryImag, IGLMateryMirror )
181
     private
182
     protected
183
       _Color :TGLUniBuf<TAlphaColorF>;
184
       ///// アクセス
185
       function GetColor :TAlphaColorF;
186
       procedure SetColor( const Color_:TAlphaColorF );
187
     public
188
       constructor Create;
189
       destructor Destroy; override;
190
       ///// プロパティ
191
       property Color :TAlphaColorF read GetColor write SetColor;
192
       ///// メソッド
193
       procedure Use; override;
194
       procedure Unuse; override;
195
     end;
196

197
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLMateryGlass
198

199
     IGLMateryGlass = interface( IGLMateryImag )
200
     ['{960FE1E6-E27F-499A-BFB3-EA2C72DA09A5}']
201
     {protected}
202
       ///// アクセス
203
       function GetRefI :Single;
204
       procedure SetRefI( const RefI_:Single );
205
     {public}
206
       ///// プロパティ
207
       property RefI :Single read GetRefI write SetRefI;
208
     end;
209

210
     //-------------------------------------------------------------------------
211

212
     TGLMateryGlass = class( TGLMateryImag, IGLMateryGlass )
213
     private
214
     protected
215
       _RefI :TGLUniBuf<Single>;
216
       ///// アクセス
217
       function GetRefI :Single;
218
       procedure SetRefI( const RefI_:Single );
219
     public
220
       constructor Create;
221
       destructor Destroy; override;
222
       ///// プロパティ
223
       property RefI :Single read GetRefI write SetRefI;
224
       ///// メソッド
225
       procedure Use; override;
226
       procedure Unuse; override;
227
     end;
228

229
//const //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【定数】
230

231
//var //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【変数】
232

233
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
234

235
implementation //############################################################### ■
236

237
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
238

239
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
240

241
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLMateryColor
242

243
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
244

245
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
246

247
/////////////////////////////////////////////////////////////////////// アクセス
248

249
function TGLMateryColor.GetColor :TAlphaColorF;
250
begin
251
     Result := _Color[ 0 ];
252
end;
253

254
procedure TGLMateryColor.SetColor( const Color_:TAlphaColorF );
255
begin
256
     _Color[ 0 ] := Color_;
257
end;
258

259
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
260

261
constructor TGLMateryColor.Create;
262
begin
263
     inherited;
264

265
     _Color := TGLUniBuf<TAlphaColorF>.Create( GL_STATIC_DRAW );
266

267
     with _ShaderF do
268
     begin
269
          with Source do
270
          begin
271
               BeginUpdate;
272
                 Clear;
273

274
                 Add( '#version 430' );
275

276
                 Add( 'layout( std140 ) uniform TMateryCol{ vec4 _MateryCol; };' );
277

278
                 Add( 'in TSenderVF' );
279
                 Add( '{' );
280
                 Add( '  vec4 Pos;' );
281
                 Add( '}' );
282
                 Add( '_Sender;' );
283

284
                 Add( 'out vec4 _ResultCol;' );
285

286
                 Add( 'void main(){ _ResultCol = _MateryCol; }' );
287

288
               EndUpdate;
289
          end;
290

291
          Assert( Status, Errors.Text );
292
     end;
293

294
     with _Engine do
295
     begin
296
          with UniBufs do
297
          begin
298
               Add( 4{BinP}, 'TMateryCol'{Name} );
299
          end;
300
     end;
301

302
     Color := TAlphaColorF.Create( 1, 0, 0, 1 );
303
end;
304

305
destructor TGLMateryColor.Destroy;
306
begin
307
     _Color.Free;
308

309
     inherited;
310
end;
311

312
/////////////////////////////////////////////////////////////////////// メソッド
313

314
procedure TGLMateryColor.Use;
315
begin
316
     inherited;
317

318
     _Color.Use( 4 );
319
end;
320

321
procedure TGLMateryColor.Unuse;
322
begin
323
     _Color.Unuse( 4 );
324

325
     inherited;
326
end;
327

328
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLMateryRGB
329

330
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
331

332
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
333

334
/////////////////////////////////////////////////////////////////////// アクセス
335

336
function TGLMateryRGB.GetAmbient :TAlphaColorF;
337
begin
338
     Result := _Ambient[ 0 ];
339
end;
340

341
procedure TGLMateryRGB.SetAmbient( const Ambient_:TAlphaColorF );
342
begin
343
     _Ambient[ 0 ] := Ambient_;
344
end;
345

346
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
347

348
constructor TGLMateryRGB.Create;
349
begin
350
     inherited;
351

352
     _Ambient := TGLUniBuf<TAlphaColorF>.Create( GL_STATIC_DRAW );
353

354
     with _ShaderF do
355
     begin
356
          with Source do
357
          begin
358
               BeginUpdate;
359
                 Clear;
360

361
                 Add( '#version 430' );
362

363
                 Add( 'layout( std140 ) uniform TAmbient{ vec4 _Ambient; };' );
364

365
                 Add( 'in TSenderVF' );
366
                 Add( '{' );
367
                 Add( '  vec4 Pos;' );
368
                 Add( '  vec4 Nor;' );
369
                 Add( '}' );
370
                 Add( '_Sender;' );
371

372
                 Add( 'out vec4 _ResultCol;' );
373

374
                 Add( 'void main()' );
375
                 Add( '{' );
376
                 Add( '  _ResultCol = vec4( _Ambient.rgb + ( 1 + normalize( _Sender.Nor.xyz ) ) / 2, 1 );' );
377
                 Add( '}' );
378

379
               EndUpdate;
380
          end;
381

382
          Assert( Status, Errors.Text );
383
     end;
384

385
     with _Engine do
386
     begin
387
          with UniBufs do
388
          begin
389
               Add( 4{BinP}, 'TAmbient'{Name} );
390
          end;
391
     end;
392

393
     Ambient := TAlphaColorF.Create( 0, 0, 0 );
394
end;
395

396
destructor TGLMateryRGB.Destroy;
397
begin
398
     inherited;
399

400
     _Ambient.Free;
401
end;
402

403
/////////////////////////////////////////////////////////////////////// メソッド
404

405
procedure TGLMateryRGB.Use;
406
begin
407
     inherited;
408

409
     _Ambient.Use( 4 );
410
end;
411

412
procedure TGLMateryRGB.Unuse;
413
begin
414
     _Ambient.Unuse( 4 );
415

416
     inherited;
417
end;
418

419
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLMateryDiffuse
420

421
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
422

423
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
424

425
/////////////////////////////////////////////////////////////////////// アクセス
426

427
function TGLMateryDiffuse.GetAmbient :TAlphaColorF;
428
begin
429
     Result := _Ambient[ 0 ];
430
end;
431

432
procedure TGLMateryDiffuse.SetAmbient( const Ambient_:TAlphaColorF );
433
begin
434
     _Ambient[ 0 ] := Ambient_;
435
end;
436

437
function TGLMateryDiffuse.GetDiffuse :TAlphaColorF;
438
begin
439
     Result := _Diffuse[ 0 ];
440
end;
441

442
procedure TGLMateryDiffuse.SetDiffuse( const Diffuse_:TAlphaColorF );
443
begin
444
     _Diffuse[ 0 ] := Diffuse_;
445
end;
446

447
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
448

449
constructor TGLMateryDiffuse.Create;
450
begin
451
     inherited;
452

453
     _Ambient := TGLUniBuf<TAlphaColorF>.Create( GL_STATIC_DRAW );
454
     _Diffuse := TGLUniBuf<TAlphaColorF>.Create( GL_STATIC_DRAW );
455

456
     with _ShaderF do
457
     begin
458
          with Source do
459
          begin
460
               BeginUpdate;
461
                 Clear;
462

463
                 Add( '#version 430' );
464

465
                 Add( 'layout( std140 ) uniform TAmbient{ vec4 _Ambient; };' );
466
                 Add( 'layout( std140 ) uniform TDiffuse{ vec4 _Diffuse; };' );
467

468
                 Add( 'in TSenderVF' );
469
                 Add( '{' );
470
                 Add( '  vec4 Pos;' );
471
                 Add( '  vec4 Nor;' );
472
                 Add( '}' );
473
                 Add( '_Sender;' );
474

475
                 Add( 'out vec4 _ResultCol;' );
476

477
                 Add( 'void main()' );
478
                 Add( '{' );
479
                 Add( '  vec3 L = normalize( vec3( 0, 1, 1 ) );' );
480
                 Add( '  vec3 N = normalize( _Sender.Nor.xyz );' );
481
                 Add( '  _ResultCol = vec4( _Ambient.rgb + _Diffuse.rgb * max( dot( L, N ), 0 ), 1 );' );
482
                 Add( '}' );
483

484
               EndUpdate;
485
          end;
486

487
          Assert( Status, Errors.Text );
488
     end;
489

490
     with _Engine do
491
     begin
492
          with UniBufs do
493
          begin
494
               Add( 4{BinP}, 'TAmbient'{Name} );
495
               Add( 5{BinP}, 'TDiffuse'{Name} );
496
          end;
497
     end;
498

499
     Ambient := TAlphaColorF.Create( 0, 0, 0 );
500
     Diffuse := TAlphaColorF.Create( 1, 1, 1 );
501
end;
502

503
destructor TGLMateryDiffuse.Destroy;
504
begin
505
     inherited;
506

507
     _Ambient.Free;
508
     _Diffuse.Free;
509
end;
510

511
/////////////////////////////////////////////////////////////////////// メソッド
512

513
procedure TGLMateryDiffuse.Use;
514
begin
515
     inherited;
516

517
     _Ambient.Use( 4 );
518
     _Diffuse.Use( 5 );
519
end;
520

521
procedure TGLMateryDiffuse.Unuse;
522
begin
523
     _Ambient.Unuse( 4 );
524
     _Diffuse.Unuse( 5 );
525

526
     inherited;
527
end;
528

529
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLMateryPlastic
530

531
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
532

533
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
534

535
/////////////////////////////////////////////////////////////////////// アクセス
536

537
function TGLMateryPlastic.GetAmbient :TAlphaColorF;
538
begin
539
     Result := _Ambient[ 0 ];
540
end;
541

542
procedure TGLMateryPlastic.SetAmbient( const Ambient_:TAlphaColorF );
543
begin
544
     _Ambient[ 0 ] := Ambient_;
545
end;
546

547
//------------------------------------------------------------------------------
548

549
function TGLMateryPlastic.GetDiffuse :TAlphaColorF;
550
begin
551
     Result := _Diffuse[ 0 ];
552
end;
553

554
procedure TGLMateryPlastic.SetDiffuse( const Diffuse_:TAlphaColorF );
555
begin
556
     _Diffuse[ 0 ] := Diffuse_;
557
end;
558

559
//------------------------------------------------------------------------------
560

561
function TGLMateryPlastic.GetRefI :Single;
562
begin
563
     Result := _RefI[ 0 ];
564
end;
565

566
procedure TGLMateryPlastic.SetRefI( const RefI_:Single );
567
begin
568
     _RefI[ 0 ] := RefI_;
569
end;
570

571
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
572

573
constructor TGLMateryPlastic.Create;
574
begin
575
     inherited;
576

577
     _Ambient := TGLUniBuf<TAlphaColorF>.Create( GL_STATIC_DRAW );
578
     _Diffuse := TGLUniBuf<TAlphaColorF>.Create( GL_STATIC_DRAW );
579
     _RefI    := TGLUniBuf<Single>.Create( GL_STATIC_DRAW );
580

581
     with _ShaderF do
582
     begin
583
          with Source do
584
          begin
585
               BeginUpdate;
586
                 Clear;
587

588
                 Add( '#version 430' );
589

590
                 Add( 'const float Pi  = 3.141592653589793;' );
591
                 Add( 'const float Pi2 = Pi * 2.0;' );
592

593
                 Add( 'vec2 VecToSky( vec4 Vector_ )' );
594
                 Add( '{' );
595
                 Add( '    vec2 Result;' );
596

597
                 Add( '    Result.x = ( Pi - atan( -Vector_.x, -Vector_.z ) ) / Pi2;' );
598
                 Add( '    Result.y =        acos(  Vector_.y             )   / Pi ;' );
599

600
                 Add( '    return Result;' );
601
                 Add( '}' );
602

603
                 Add( 'float Pow2( float X_ )' );
604
                 Add( '{' );
605
                 Add( '    return X_ * X_;' );
606
                 Add( '}' );
607

608
                 Add( 'float Fresnel( vec4 EyeVec_, vec4 NorVec_, float RefI_ )' );
609
                 Add( '{' );
610
                 Add( '    float N = Pow2( RefI_ );' );
611
                 Add( '    float C = dot( EyeVec_, NorVec_ );' );
612
                 Add( '    float G = sqrt( N + Pow2( C ) - 1 );' );
613
                 Add( '    float NC = N * C;' );
614
                 Add( '    return ( Pow2( (  C - G ) / (  C + G ) )' );
615
                 Add( '           + Pow2( ( NC - G ) / ( NC + G ) ) ) / 2;' );
616
                 Add( '}' );
617

618
                 Add( 'layout( std140 ) uniform TViewerScal{ layout( row_major ) mat4 _ViewerScal; };' );
619
                 Add( 'layout( std140 ) uniform TCameraProj{ layout( row_major ) mat4 _CameraProj; };' );
620
                 Add( 'layout( std140 ) uniform TCameraPose{ layout( row_major ) mat4 _CameraPose; };' );
621
                 Add( 'layout( std140 ) uniform TShaperPose{ layout( row_major ) mat4 _ShaperPose; };' );
622

623
                 Add( 'uniform sampler2D _Textur;' );
624

625
                 Add( 'layout( std140 ) uniform TAmbient{ vec4  _Ambient; };' );
626
                 Add( 'layout( std140 ) uniform TDiffuse{ vec4  _Diffuse; };' );
627
                 Add( 'layout( std140 ) uniform TRefI   { float _RefI;    };' );
628

629
                 Add( 'in TSenderVF' );
630
                 Add( '{' );
631
                 Add( '  vec4 Pos;' );
632
                 Add( '  vec4 Nor;' );
633
                 Add( '  vec4 Tex;' );
634
                 Add( '}' );
635
                 Add( '_Sender;' );
636

637
                 Add( 'out vec4 _ResultCol;' );
638

639
                 Add( 'void main()' );
640
                 Add( '{' );
641
                 Add( '  vec4 C = _CameraPose[ 3 ];' );
642
                 Add( '  vec4 V = normalize( _Sender.Pos - C );' );
643
                 Add( '  vec4 N = normalize( _Sender.Nor );' );
644
                 Add( '  vec4 R = reflect( V, N );' );
645

646
                 Add( '  vec4 Cd = _Diffuse * N.y;' );
647
                 Add( '  vec4 Cr = texture( _Textur, VecToSky( R ) );' );
648

649
                 Add( 'float F = clamp( Fresnel( -V, N, _RefI ), 0, 1 );' );
650

651
                 Add( '  _ResultCol = _Ambient + ( Cr - Cd ) * F + Cd;' );
652
                 Add( '  _ResultCol.a = 1;' );
653
                 Add( '}' );
654

655
               EndUpdate;
656
          end;
657

658
          Assert( Status, Errors.Text );
659
     end;
660

661
     with _Engine do
662
     begin
663
          with UniBufs do
664
          begin
665
               Add( 4{BinP}, 'TAmbient'{Name} );
666
               Add( 5{BinP}, 'TDiffuse'{Name} );
667
               Add( 6{BinP}, 'TRefI'{Name} );
668
          end;
669
     end;
670

671
     Ambient := TAlphaColorF.Create( 0.1, 0.1, 0.1 );
672
     Diffuse := TAlphaColorF.Create( 1, 1, 1 );
673
     RefI    := 1.5;
674
end;
675

676
destructor TGLMateryPlastic.Destroy;
677
begin
678
     inherited;
679

680
     _Ambient.Free;
681
     _Diffuse.Free;
682
     _RefI   .Free;
683
end;
684

685
/////////////////////////////////////////////////////////////////////// メソッド
686

687
procedure TGLMateryPlastic.Use;
688
begin
689
     inherited;
690

691
     _Ambient.Use( 4 );
692
     _Diffuse.Use( 5 );
693
     _RefI   .Use( 6 );
694
end;
695

696
procedure TGLMateryPlastic.Unuse;
697
begin
698
     _Ambient.Unuse( 4 );
699
     _Diffuse.Unuse( 5 );
700
     _RefI   .Unuse( 6 );
701

702
     inherited;
703
end;
704

705
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLMateryMirror
706

707
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
708

709
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
710

711
/////////////////////////////////////////////////////////////////////// アクセス
712

713
function TGLMateryMirror.GetColor :TAlphaColorF;
714
begin
715
     Result := _Color[ 0 ];
716
end;
717

718
procedure TGLMateryMirror.SetColor( const Color_:TAlphaColorF );
719
begin
720
     _Color[ 0 ] := Color_;
721
end;
722

723
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
724

725
constructor TGLMateryMirror.Create;
726
begin
727
     inherited;
728

729
     _Color := TGLUniBuf<TAlphaColorF>.Create( GL_STATIC_DRAW );
730

731
     with _ShaderF do
732
     begin
733
          with Source do
734
          begin
735
               BeginUpdate;
736
                 Clear;
737

738
                 Add( '#version 430' );
739

740
                 Add( 'const float Pi  = 3.141592653589793;' );
741
                 Add( 'const float Pi2 = Pi * 2.0;' );
742

743
                 Add( 'vec2 VecToSky( vec4 Vector_ )' );
744
                 Add( '{' );
745
                 Add( '    vec2 Result;' );
746

747
                 Add( '    Result.x = ( Pi - atan( -Vector_.x, -Vector_.z ) ) / Pi2;' );
748
                 Add( '    Result.y =        acos(  Vector_.y             )   / Pi ;' );
749

750
                 Add( '    return Result;' );
751
                 Add( '}' );
752

753
                 Add( 'layout( std140 ) uniform TViewerScal{ layout( row_major ) mat4 _ViewerScal; };' );
754
                 Add( 'layout( std140 ) uniform TCameraProj{ layout( row_major ) mat4 _CameraProj; };' );
755
                 Add( 'layout( std140 ) uniform TCameraPose{ layout( row_major ) mat4 _CameraPose; };' );
756
                 Add( 'layout( std140 ) uniform TShaperPose{ layout( row_major ) mat4 _ShaperPose; };' );
757

758
                 Add( 'uniform sampler2D _Textur;' );
759

760
                 Add( 'layout( std140 ) uniform TColor{ vec4 _Color; };' );
761

762
                 Add( 'in TSenderVF' );
763
                 Add( '{' );
764
                 Add( '  vec4 Pos;' );
765
                 Add( '  vec4 Nor;' );
766
                 Add( '  vec4 Tex;' );
767
                 Add( '}' );
768
                 Add( '_Sender;' );
769

770
                 Add( 'out vec4 _ResultCol;' );
771

772
                 Add( 'void main()' );
773
                 Add( '{' );
774
                 Add( '  vec4 C = _CameraPose[ 3 ];' );
775
                 Add( '  vec4 V = normalize( _Sender.Pos - C );' );
776
                 Add( '  vec4 N = normalize( _Sender.Nor );' );
777
                 Add( '  vec4 R = reflect( V, N );' );
778
                 Add( '  _ResultCol = _Color * texture( _Textur, VecToSky( R ) );' );
779
                 Add( '}' );
780

781
               EndUpdate;
782
          end;
783

784
          Assert( Status, Errors.Text );
785
     end;
786

787
     with _Engine do
788
     begin
789
          with UniBufs do
790
          begin
791
               Add( 4{BinP}, 'TColor'{Name} );
792
          end;
793
     end;
794

795
     Color := TAlphaColorF.Create( 1, 1, 1 );
796
end;
797

798
destructor TGLMateryMirror.Destroy;
799
begin
800
     inherited;
801

802
     _Color.Free;
803
end;
804

805
/////////////////////////////////////////////////////////////////////// メソッド
806

807
procedure TGLMateryMirror.Use;
808
begin
809
     inherited;
810

811
     _Color.Use( 4 );
812
end;
813

814
procedure TGLMateryMirror.Unuse;
815
begin
816
     _Color.Unuse( 4 );
817

818
     inherited;
819
end;
820

821
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLMateryGlass
822

823
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
824

825
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
826

827
/////////////////////////////////////////////////////////////////////// アクセス
828

829
function TGLMateryGlass.GetRefI :Single;
830
begin
831
     Result := _RefI[ 0 ];
832
end;
833

834
procedure TGLMateryGlass.SetRefI( const RefI_:Single );
835
begin
836
     _RefI[ 0 ] := RefI_;
837
end;
838

839
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
840

841
constructor TGLMateryGlass.Create;
842
begin
843
     inherited;
844

845
     _RefI := TGLUniBuf<Single>.Create( GL_STATIC_DRAW );
846

847
     with _ShaderF do
848
     begin
849
          with Source do
850
          begin
851
               BeginUpdate;
852
                 Clear;
853

854
                 Add( '#version 430' );
855

856
                 Add( 'const float Pi  = 3.141592653589793;' );
857
                 Add( 'const float Pi2 = Pi * 2.0;' );
858

859
                 Add( 'vec2 VecToSky( vec4 Vector_ )' );
860
                 Add( '{' );
861
                 Add( '    vec2 Result;' );
862

863
                 Add( '    Result.x = ( Pi - atan( -Vector_.x, -Vector_.z ) ) / Pi2;' );
864
                 Add( '    Result.y =        acos(  Vector_.y             )   / Pi ;' );
865

866
                 Add( '    return Result;' );
867
                 Add( '}' );
868

869
                 Add( 'float Pow2( float X_ )' );
870
                 Add( '{' );
871
                 Add( '    return X_ * X_;' );
872
                 Add( '}' );
873

874
                 Add( 'float Fresnel( vec4 EyeVec_, vec4 NorVec_, float RefI_ )' );
875
                 Add( '{' );
876
                 Add( '    float N = Pow2( RefI_ );' );
877
                 Add( '    float C = dot( EyeVec_, NorVec_ );' );
878
                 Add( '    float G = sqrt( N + Pow2( C ) - 1 );' );
879
                 Add( '    float NC = N * C;' );
880
                 Add( '    return ( Pow2( (  C - G ) / (  C + G ) )' );
881
                 Add( '           + Pow2( ( NC - G ) / ( NC + G ) ) ) / 2;' );
882
                 Add( '}' );
883

884
                 Add( 'layout( std140 ) uniform TViewerScal{ layout( row_major ) mat4 _ViewerScal; };' );
885
                 Add( 'layout( std140 ) uniform TCameraProj{ layout( row_major ) mat4 _CameraProj; };' );
886
                 Add( 'layout( std140 ) uniform TCameraPose{ layout( row_major ) mat4 _CameraPose; };' );
887
                 Add( 'layout( std140 ) uniform TShaperPose{ layout( row_major ) mat4 _ShaperPose; };' );
888

889
                 Add( 'uniform sampler2D _Textur;' );
890

891
                 Add( 'layout( std140 ) uniform TRefI{ float _RefI; };' );
892

893
                 Add( 'in TSenderVF' );
894
                 Add( '{' );
895
                 Add( '  vec4 Pos;' );
896
                 Add( '  vec4 Nor;' );
897
                 Add( '  vec4 Tex;' );
898
                 Add( '}' );
899
                 Add( '_Sender;' );
900

901
                 Add( 'out vec4 _ResultCol;' );
902

903
                 Add( 'void main()' );
904
                 Add( '{' );
905
                 Add( '  vec4 C = _CameraPose[ 3 ];' );
906
                 Add( '  vec4 V = normalize( _Sender.Pos - C );' );
907
                 Add( '  vec4 N = normalize( _Sender.Nor );' );
908
                 Add( '  vec4 Re = reflect( V, N );' );
909
                 Add( '  vec4 Ra = refract( V, N, 1.0/_RefI );' );
910

911
                 Add( '  vec4 Ce = texture( _Textur, VecToSky( Re ) );' );
912
                 Add( '  vec4 Ca = texture( _Textur, VecToSky( Ra ) );' );
913

914
                 Add( 'float F = clamp( Fresnel( -V, N, _RefI ), 0, 1 );' );
915

916
                 Add( '  _ResultCol = ( Ce - Ca ) * F + Ca;' );
917
                 Add( '  _ResultCol.a = 1;' );
918
                 Add( '}' );
919

920
               EndUpdate;
921
          end;
922

923
          Assert( Status, Errors.Text );
924
     end;
925

926
     with _Engine do
927
     begin
928
          with UniBufs do
929
          begin
930
               Add( 4{BinP}, 'TRefI'{Name} );
931
          end;
932
     end;
933

934
     RefI := 1.5;
935
end;
936

937
destructor TGLMateryGlass.Destroy;
938
begin
939
     inherited;
940

941
     _RefI.Free;
942
end;
943

944
/////////////////////////////////////////////////////////////////////// メソッド
945

946
procedure TGLMateryGlass.Use;
947
begin
948
     inherited;
949

950
     _RefI.Use( 4 );
951
end;
952

953
procedure TGLMateryGlass.Unuse;
954
begin
955
     _RefI.Unuse( 4 );
956

957
     inherited;
958
end;
959

960
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
961

962
//############################################################################## □
963

964
initialization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 初期化
965

966
finalization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 最終化
967

968
end. //######################################################################### ■
969
Luxophia

Использование cookies
