LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
  Procedural textures.
6

7
  History :  
8
       23/08/10 - Yar - Added OpenGLTokens to uses, replaced OpenGL1x functions to OpenGLAdapter
9
       22/04/10 - Yar - Fixes after GLState revision
10
       22/01/10 - Yar - Added bmp32.Blank:=false for memory allocation,
11
                           Depth dimension, NativeTextureTarget becomes property
12
       16/03/07 - DaStr - Added explicit pointer dereferencing
13
                             (thanks Burkhard Carstens) (Bugtracker ID = 1678644)
14
       01/10/04 - ilh - Added SetPermFromData and SetPermToDefault
15
                            moved PERM array to protected from inside Noise procedure
16
                            so it can be changed by SetPermFromData and SetPermToDefault
17
                           Added FNoiseRandSeed property so a Seed can be set
18
                            Starts with a random Generated Seed...
19
                            One must be set to BE Seeded
20
       11/12/02 - ??? - Initial, procedural perlin noise texture
21
                           code by Tobias Peirick
22
  
23

24
  I used the following references for my implementation:
25

26
  http://freespace.virgin.net/hugo.elias/models/m_perlin.htm 
27
  http://freespace.virgin.net/hugo.elias/models/m_clouds.htm 
28
  http://www.delphi3d.net
29

30
  Tobias Peirick
31
}
32
unit GLProcTextures;
33

34
interface
35

36
uses Classes, GLTexture, GLGraphics, OpenGLTokens, GLCrossPlatform, SysUtils,
37
  GLTextureFormat;
38

39
const
40
  GRADIENT_TABLE_SIZE = 256;
41
  DAMP_SHIFT = 20;
42

43
type
44
  TGLProcTextureNoise = class(TGLTextureImage)
45
  private
46
    FNoiseMap: TGLBitmap32;
47
    FWidth, FHeight: Integer;
48
    FMinCut: Byte;
49
    //FMaxCut         : Byte;
50
    FNoiseSharpness: Single;
51
    FNoiseAnimate: Single;
52
    FSeamless: Boolean;
53
    FNoiseRandSeed: Longint;
54
  protected
55
    FGradients: array[0..GRADIENT_TABLE_SIZE * 3 - 1] of Single;
56
    PERM: array[0..GRADIENT_TABLE_SIZE - 1] of Byte;
57
    function GetWidth: Integer; override;
58
    function GetHeight: Integer; override;
59
    function GetDepth: Integer; override;
60
    function GetTextureTarget: TGLTextureTarget; override;
61
    function Noise(x, y: Single): Single;
62
    procedure SetMinCut(const val: Byte);
63
    procedure SetSeamless(const val: Boolean);
64
    procedure SetWidth(const val: Integer);
65
    procedure SetHeight(const val: Integer);
66
    procedure SetNoiseSharpness(const val: Single);
67
    procedure SetNoiseRandSeed(const val: Longint);
68
    procedure UpdateNoise;
69
  public
70
    constructor Create(AOwner: TPersistent); override;
71
    destructor Destroy; override;
72
    class function FriendlyName: string; override;
73
    class function FriendlyDescription: string; override;
74
    procedure Assign(Source: TPersistent); override;
75
    function GetBitmap32: TGLBitmap32; override;
76
    procedure ReleaseBitmap32; override;
77
    procedure SaveToFile(const fileName: string); override;
78
    procedure LoadFromFile(const fileName: string); override;
79
    procedure NoiseAnimate(speed: Single);
80
    procedure SetPermFromData(inPERM: array of Byte);
81
    procedure SetPermToDefault;
82
  published
83
    property Width: Integer read GetWidth write SetWidth default 128;
84
    property Height: Integer read GetHeight write SetHeight default 128;
85
    property Depth: Integer read GetDepth;
86
    property MinCut: Byte read FMinCut write SetMinCut;
87
    property NoiseSharpness: Single read FNoiseSharpness write
88
      SetNoiseSharpness;
89
    property Seamless: Boolean read FSeamless write SetSeamless;
90
    property NoiseRandSeed: Longint read FNoiseRandSeed write SetNoiseRandSeed;
91
  end;
92

93
  // ------------------------------------------------------------------
94
  // ------------------------------------------------------------------
95
  // ------------------------------------------------------------------
96
implementation
97
// ------------------------------------------------------------------
98
// ------------------------------------------------------------------
99
// ------------------------------------------------------------------
100

101
uses GLVectorGeometry;
102

103
constructor TGLProcTextureNoise.Create(AOwner: TPersistent);
104
{ PERM array Borrowed from Darwyn Peachey.
105
  The gradient table is indexed with an XYZ triplet, which is first turned
106
  into a single random index using a lookup in PERM array. The PERM array simply
107
  contains all numbers in [0..255] in random order. }
108
//Can now be set to a different set of Random arrangement
109
var
110
  i: Integer;
111
  seedBackup: Longint;
112
  z, r, theta: Single;
113
begin
114
  inherited;
115
  FWidth := 128;
116
  FHeight := 128;
117
  FMinCut := 0;
118
  FNoiseSharpness := 0.99;
119
  FSeamless := False;
120
  seedBackup := RandSeed;
121
  Randomize;
122
  FNoiseRandSeed := Random(2147483647); //Random(10000);
123
  RandSeed := FNoiseRandSeed;
124
  SetPermToDefault;
125
  // Generate random gradient vectors.
126
  for i := 0 to GRADIENT_TABLE_SIZE - 1 do
127
  begin
128
    z := 1 - 2 * Random;
129
    r := sqrt(1 - z * z);
130
    theta := 2 * PI * Random;
131
    FGradients[i * 3] := r * cos(theta);
132
    FGradients[i * 3 + 1] := r * sin(theta);
133
    FGradients[i * 3 + 2] := z;
134
  end;
135
  RandSeed := seedBackup;
136
end;
137

138
destructor TGLProcTextureNoise.Destroy;
139
begin
140
  ReleaseBitmap32;
141
  inherited;
142
end;
143

144
procedure TGLProcTextureNoise.UpdateNoise;
145
var
146
  X, Y, C: Integer;
147
  Line: PGLPixel32Array;
148
  nf: Single;
149
  n: Byte;
150

151
  function NoiseSeamless(Scale: Single): Single;
152
  begin
153
    Result := (Noise(x / Scale, y / Scale) * (Width - x) * (Height - y)
154
      + Noise((x - width) / Scale, y / Scale) * x * (Height - y)
155
      + Noise((x - width) / Scale, (y - Height) / Scale) * x * y
156
      + Noise(x / Scale, (y - Height) / Scale) * (Width - x) * y)
157
      / (Width * Height);
158
  end;
159

160
begin
161
  // Update the noise texture.
162
  for y := 0 to FNoiseMap.Height - 1 do
163
  begin
164
    Line := FNoiseMap.ScanLine[y];
165
    for x := 0 to FNoiseMap.Width - 1 do
166
    begin
167
      nf := 0;
168

169
      case FSeamless of
170
        // Take 4 octaves of noise and add them weighted for seamless.
171
        // uses much Ghz
172
        True:
173
          begin
174
            nf := NoiseSeamless(16)
175
              + NoiseSeamless(8) / 2
176
              + NoiseSeamless(4) / 4
177
              + NoiseSeamless(2) / 8;
178
          end;
179
        // Take 4  octaves of noise and add them.
180
        False:
181
          begin
182
            nf := Noise(x / 16, y / 16)
183
              + Noise(x / 8, y / 8) / 2
184
              + Noise(x / 4, y / 4) / 4
185
              + Noise(x / 2, y / 2) / 8;
186
          end;
187
      end;
188

189
      // Range between 0 and 255
190
      n := Round(255 * (nf + 1) / 2);
191
      if MinCut > 0 then
192
      begin
193
        // Min Cut
194
        C := n - FMinCut;
195
        if C < 0 then
196
          n := 0
197
        else
198
          // Noise Sharpness
199
          n := 255 - Round(IntPower(FNoiseSharpness, C) * 255);
200
      end;
201
      //if n < 13 then n:=13;
202
      // Write the result to the texture image.
203
      Line^[x].r := n;
204
      Line^[x].g := n;
205
      Line^[x].b := n;
206
      Line^[x].a := n;
207
    end;
208
  end;
209
end;
210

211
function TGLProcTextureNoise.GetBitmap32: TGLBitmap32;
212
begin
213
  if not Assigned(FNoiseMap) then
214
  begin
215
    FNoiseMap := TGLBitmap32.Create;
216
    FNoiseMap.Width := FWidth;
217
    FNoiseMap.Height := FHeight;
218
    FNoiseMap.Blank := false;
219
    UpdateNoise;
220
  end;
221
  Result := FNoiseMap;
222
end;
223

224
 
225
//
226

227
class function TGLProcTextureNoise.FriendlyName: string;
228
begin
229
  Result := 'Procedural Noise';
230
end;
231

232
// FriendlyDescription
233
//
234

235
class function TGLProcTextureNoise.FriendlyDescription: string;
236
begin
237
  Result := 'Procedural Noise (Animated)';
238
end;
239

240
procedure TGLProcTextureNoise.SetSeamless(const val: Boolean);
241
begin
242
  if val <> FSeamless then
243
  begin
244
    FSeamless := val;
245
    Invalidate;
246
  end;
247
end;
248

249
procedure TGLProcTextureNoise.LoadFromFile(const fileName: string);
250
begin
251
  Assert(False, 'TGLProcTextureNoise.LoadFromFile not implemented');
252
end;
253

254
procedure TGLProcTextureNoise.ReleaseBitmap32;
255
begin
256
  if Assigned(FNoiseMap) then
257
  begin
258
    FNoiseMap.Free;
259
    FNoiseMap := nil;
260
  end;
261
end;
262

263
procedure TGLProcTextureNoise.SaveToFile(const fileName: string);
264
begin
265
  {Nothing here}
266
end;
267

268
function TGLProcTextureNoise.GetHeight: Integer;
269
begin
270
  Result := FHeight;
271
end;
272

273
function TGLProcTextureNoise.GetWidth: Integer;
274
begin
275
  Result := FWidth;
276
end;
277

278
function TGLProcTextureNoise.GetDepth: Integer;
279
begin
280
  Result := 1;
281
end;
282

283
// GetTextureTarget
284
//
285

286
function TGLProcTextureNoise.GetTextureTarget: TGLTextureTarget;
287
begin
288
  Result := ttTexture2D;
289
end;
290

291
procedure TGLProcTextureNoise.SetHeight(const val: Integer);
292
begin
293
  if val <> FHeight then
294
  begin
295
    FHeight := val;
296
    if FHeight < 1 then
297
      FHeight := 1;
298
    Invalidate;
299
  end;
300
end;
301

302
procedure TGLProcTextureNoise.SetWidth(const val: Integer);
303
begin
304
  if val <> FWidth then
305
  begin
306
    FWidth := val;
307
    if FWidth < 1 then
308
      FWidth := 1;
309
    Invalidate;
310
  end;
311
end;
312

313
procedure TGLProcTextureNoise.SetMinCut(const val: Byte);
314
begin
315
  if val <> FMinCut then
316
  begin
317
    FMinCut := val;
318
    Invalidate;
319
  end;
320
end;
321

322
procedure TGLProcTextureNoise.SetNoiseSharpness(const val: Single);
323
begin
324
  if val <> FNoiseSharpness then
325
  begin
326
    FNoiseSharpness := val;
327
    if FNoiseSharpness > 1 then
328
      FNoiseSharpness := 1;
329
    Invalidate;
330
  end;
331
end;
332

333
procedure TGLProcTextureNoise.SetNoiseRandSeed(const val: Longint);
334
var
335
  i: Integer;
336
  seedBackup: Longint;
337
  z, r, theta: Single;
338
begin
339
  if val <> FNoiseRandSeed then
340
  begin
341
    seedBackup := RandSeed;
342
    FNoiseRandSeed := val;
343
    //Dunno, might be ok to be negative
344
    if FNoiseRandSeed < 1 then
345
      FNoiseRandSeed := 1;
346
    RandSeed := FNoiseRandSeed;
347
    //didnt change so added/copied FGradients here... to get Seed to work
348
    // Generate random gradient vectors.
349
    for i := 0 to GRADIENT_TABLE_SIZE - 1 do
350
    begin
351
      z := 1 - 2 * Random;
352
      r := sqrt(1 - z * z);
353
      theta := 2 * PI * Random;
354
      FGradients[i * 3] := r * cos(theta);
355
      FGradients[i * 3 + 1] := r * sin(theta);
356
      FGradients[i * 3 + 2] := z;
357
    end;
358
    RandSeed := seedBackup;
359
    Invalidate;
360
  end;
361
end;
362

363
procedure TGLProcTextureNoise.Assign(Source: TPersistent);
364
begin
365
  if Assigned(Source) and (Source is TGLProcTextureNoise) then
366
  begin
367
    FWidth := TGLProcTextureNoise(Source).FWidth;
368
    FHeight := TGLProcTextureNoise(Source).FHeight;
369
    FMinCut := TGLProcTextureNoise(Source).FMinCut;
370
    FNoiseSharpness := TGLProcTextureNoise(Source).FNoiseSharpness;
371
    FNoiseRandSeed := TGLProcTextureNoise(Source).FNoiseRandSeed;
372
    Invalidate;
373
  end
374
  else
375
    inherited;
376
end;
377

378
procedure TGLProcTextureNoise.NoiseAnimate(speed: Single);
379
begin
380
  FNoiseAnimate := FNoiseAnimate + speed;
381
  Invalidate;
382
end;
383

384
function TGLProcTextureNoise.Noise(x, y: Single): Single;
385
var
386
  ix, iy, iz: Integer;
387
  fx0, fx1, fy0, fy1, fz0, fz1: Single;
388
  wx, wy, wz: Single;
389
  vx0, vx1, vy0, vy1, vz0, vz1: Single;
390

391
  function Smooth(x: Single): Single;
392
  begin
393
    { Smoothing curve. This is used to calculate interpolants so that the noise
394
      doesn't look blocky when the frequency is low. }
395
    Result := x * x * (3 - 2 * x);
396
  end;
397

398
  function Permutate(x: Integer): Integer;
399
  const
400
    MASK = GRADIENT_TABLE_SIZE - 1;
401
  begin
402
    // Do a lookup in the permutation table.
403
    Result := PERM[x and MASK];
404
  end;
405

406
  function Index(ix, iy, iz: Integer): Integer;
407
  begin
408
    // Turn an XYZ triplet into a single gradient table index.
409
    Result := Permutate(ix + Permutate(iy + Permutate(iz)));
410
  end;
411

412
  function Lattice(lx, ly, lz: Integer; fx, fy, fz: Single): Single;
413
  var
414
    g: Integer;
415
  begin
416
    // Look up a random gradient at [ix,iy,iz] and dot it with the [fx,fy,fz] vector.
417
    g := Index(lx, ly, lz) * 3;
418
    Result := FGradients[g] * fx + FGradients[g + 1] * fy + FGradients[g + 2] *
419
      fz;
420
  end;
421

422
  function Lerp(t, x0, x1: Single): Single;
423
  begin
424
    // Simple linear interpolation.
425
    Result := x0 + t * (x1 - x0);
426
  end;
427

428
begin
429
  { The main noise function. Looks up the pseudorandom gradients at the nearest
430
    lattice points, dots them with the input vector, and interpolates the
431
    results to produce a single output value in [0, 1] range. }
432

433
  ix := Floor(x);
434
  fx0 := x - ix;
435
  fx1 := fx0 - 1;
436
  wx := Smooth(fx0);
437
  iy := Floor(y);
438
  fy0 := y - iy;
439
  fy1 := fy0 - 1;
440
  wy := Smooth(fy0);
441

442
  iz := Floor(FNoiseAnimate);
443
  fz0 := FNoiseAnimate - iz;
444
  fz1 := fz0 - 1;
445
  wz := Smooth(fz0);
446

447
  vx0 := Lattice(ix, iy, iz, fx0, fy0, fz0);
448
  vx1 := Lattice(ix + 1, iy, iz, fx1, fy0, fz0);
449
  vy0 := Lerp(wx, vx0, vx1);
450

451
  vx0 := Lattice(ix, iy + 1, iz, fx0, fy1, fz0);
452
  vx1 := Lattice(ix + 1, iy + 1, iz, fx1, fy1, fz0);
453
  vy1 := Lerp(wx, vx0, vx1);
454

455
  vz0 := Lerp(wy, vy0, vy1);
456

457
  vx0 := Lattice(ix, iy, iz + 1, fx0, fy0, fz1);
458
  vx1 := Lattice(ix + 1, iy, iz + 1, fx1, fy0, fz1);
459
  vy0 := Lerp(wx, vx0, vx1);
460

461
  vx0 := Lattice(ix, iy + 1, iz + 1, fx0, fy1, fz1);
462
  vx1 := Lattice(ix + 1, iy + 1, iz + 1, fx1, fy1, fz1);
463
  vy1 := Lerp(wx, vx0, vx1);
464

465
  vz1 := Lerp(wy, vy0, vy1);
466

467
  Result := Lerp(wz, vz0, vz1);
468
end;
469

470
procedure TGLProcTextureNoise.SetPermFromData(inPERM: array of Byte);
471
var
472
  I: Integer;
473
begin
474
  for I := 0 to 255 do
475
    PERM[I] := inPERM[I];
476
  Invalidate;
477
end;
478

479
procedure TGLProcTextureNoise.SetPermToDefault;
480
begin
481
  //225,155,210,108,175,199,221,144,203,116, 70,213, 69,158, 33,252,
482
  PERM[0] := 225;
483
  PERM[1] := 155;
484
  PERM[2] := 210;
485
  PERM[3] := 108;
486
  PERM[4] := 175;
487
  PERM[5] := 199;
488
  PERM[6] := 221;
489
  PERM[7] := 144;
490
  PERM[8] := 203;
491
  PERM[9] := 116;
492
  PERM[10] := 70;
493
  PERM[11] := 213;
494
  PERM[12] := 69;
495
  PERM[13] := 158;
496
  PERM[14] := 33;
497
  PERM[15] := 252;
498
  //5, 82,173,133,222,139,174, 27,  9, 71, 90,246, 75,130, 91,191,
499
  PERM[16] := 5;
500
  PERM[17] := 82;
501
  PERM[18] := 173;
502
  PERM[19] := 133;
503
  PERM[20] := 222;
504
  PERM[21] := 139;
505
  PERM[22] := 174;
506
  PERM[23] := 27;
507
  PERM[24] := 9;
508
  PERM[25] := 71;
509
  PERM[26] := 90;
510
  PERM[27] := 246;
511
  PERM[28] := 75;
512
  PERM[29] := 130;
513
  PERM[30] := 91;
514
  PERM[31] := 191;
515
  //169,138,  2,151,194,235, 81,  7, 25,113,228,159,205,253,134,142,
516
  PERM[32] := 169;
517
  PERM[33] := 138;
518
  PERM[34] := 2;
519
  PERM[35] := 151;
520
  PERM[36] := 194;
521
  PERM[37] := 235;
522
  PERM[38] := 81;
523
  PERM[39] := 7;
524
  PERM[40] := 25;
525
  PERM[41] := 113;
526
  PERM[42] := 228;
527
  PERM[43] := 159;
528
  PERM[44] := 205;
529
  PERM[45] := 253;
530
  PERM[46] := 134;
531
  PERM[47] := 142;
532
  //248, 65,224,217, 22,121,229, 63, 89,103, 96,104,156, 17,201,129,
533
  PERM[48] := 248;
534
  PERM[49] := 65;
535
  PERM[50] := 224;
536
  PERM[51] := 217;
537
  PERM[52] := 22;
538
  PERM[53] := 121;
539
  PERM[54] := 229;
540
  PERM[55] := 63;
541
  PERM[56] := 89;
542
  PERM[57] := 103;
543
  PERM[58] := 96;
544
  PERM[59] := 104;
545
  PERM[60] := 156;
546
  PERM[61] := 17;
547
  PERM[62] := 201;
548
  PERM[63] := 129;
549
  //36,  8,165,110,237,117,231, 56,132,211,152, 20,181,111,239,218,
550
  PERM[64] := 36;
551
  PERM[65] := 8;
552
  PERM[66] := 165;
553
  PERM[67] := 110;
554
  PERM[68] := 237;
555
  PERM[69] := 117;
556
  PERM[70] := 231;
557
  PERM[71] := 56;
558
  PERM[72] := 132;
559
  PERM[73] := 211;
560
  PERM[74] := 152;
561
  PERM[75] := 20;
562
  PERM[76] := 181;
563
  PERM[77] := 111;
564
  PERM[78] := 239;
565
  PERM[79] := 218;
566
  // 170,163, 51,172,157, 47, 80,212,176,250, 87, 49, 99,242,136,189,
567
  PERM[80] := 170;
568
  PERM[81] := 163;
569
  PERM[82] := 51;
570
  PERM[83] := 172;
571
  PERM[84] := 157;
572
  PERM[85] := 47;
573
  PERM[86] := 80;
574
  PERM[86] := 212;
575
  PERM[88] := 176;
576
  PERM[89] := 250;
577
  PERM[90] := 87;
578
  PERM[91] := 49;
579
  PERM[92] := 99;
580
  PERM[93] := 242;
581
  PERM[94] := 136;
582
  PERM[95] := 189;
583
  //162,115, 44, 43,124, 94,150, 16,141,247, 32, 10,198,223,255, 72,
584
  PERM[96] := 162;
585
  PERM[97] := 115;
586
  PERM[98] := 44;
587
  PERM[99] := 43;
588
  PERM[100] := 124;
589
  PERM[101] := 94;
590
  PERM[102] := 150;
591
  PERM[103] := 16;
592
  PERM[104] := 141;
593
  PERM[105] := 247;
594
  PERM[106] := 32;
595
  PERM[107] := 10;
596
  PERM[108] := 198;
597
  PERM[109] := 223;
598
  PERM[110] := 255;
599
  PERM[111] := 72;
600
  //53,131, 84, 57,220,197, 58, 50,208, 11,241, 28,  3,192, 62,202,
601
  PERM[112] := 53;
602
  PERM[113] := 131;
603
  PERM[114] := 84;
604
  PERM[115] := 57;
605
  PERM[116] := 220;
606
  PERM[117] := 197;
607
  PERM[118] := 58;
608
  PERM[119] := 50;
609
  PERM[120] := 208;
610
  PERM[121] := 11;
611
  PERM[122] := 241;
612
  PERM[123] := 28;
613
  PERM[124] := 3;
614
  PERM[125] := 192;
615
  PERM[126] := 62;
616
  PERM[127] := 202;
617
  //18,215,153, 24, 76, 41, 15,179, 39, 46, 55,  6,128,167, 23,188,
618
  PERM[128] := 18;
619
  PERM[129] := 215;
620
  PERM[130] := 153;
621
  PERM[131] := 24;
622
  PERM[132] := 76;
623
  PERM[133] := 41;
624
  PERM[134] := 15;
625
  PERM[135] := 179;
626
  PERM[136] := 39;
627
  PERM[137] := 46;
628
  PERM[138] := 55;
629
  PERM[139] := 6;
630
  PERM[140] := 128;
631
  PERM[141] := 167;
632
  PERM[142] := 23;
633
  PERM[143] := 188;
634
  // 106, 34,187,140,164, 73,112,182,244,195,227, 13, 35, 77,196,185,
635
  PERM[144] := 106;
636
  PERM[145] := 34;
637
  PERM[146] := 187;
638
  PERM[147] := 140;
639
  PERM[148] := 164;
640
  PERM[149] := 73;
641
  PERM[150] := 112;
642
  PERM[151] := 182;
643
  PERM[152] := 244;
644
  PERM[153] := 195;
645
  PERM[154] := 227;
646
  PERM[155] := 13;
647
  PERM[156] := 35;
648
  PERM[157] := 77;
649
  PERM[158] := 196;
650
  PERM[159] := 185;
651
  //26,200,226,119, 31,123,168,125,249, 68,183,230,177,135,160,180,
652
  PERM[160] := 26;
653
  PERM[161] := 200;
654
  PERM[162] := 226;
655
  PERM[163] := 119;
656
  PERM[164] := 31;
657
  PERM[165] := 123;
658
  PERM[166] := 168;
659
  PERM[167] := 125;
660
  PERM[168] := 249;
661
  PERM[169] := 68;
662
  PERM[170] := 183;
663
  PERM[171] := 230;
664
  PERM[172] := 177;
665
  PERM[173] := 135;
666
  PERM[174] := 160;
667
  PERM[175] := 180;
668
  // 12,  1,243,148,102,166, 38,238,251, 37,240,126, 64, 74,161, 40,
669
  PERM[176] := 12;
670
  PERM[177] := 1;
671
  PERM[178] := 243;
672
  PERM[179] := 148;
673
  PERM[180] := 102;
674
  PERM[181] := 166;
675
  PERM[182] := 38;
676
  PERM[183] := 238;
677
  PERM[184] := 251;
678
  PERM[185] := 37;
679
  PERM[186] := 240;
680
  PERM[187] := 126;
681
  PERM[188] := 64;
682
  PERM[189] := 74;
683
  PERM[190] := 161;
684
  PERM[191] := 40;
685
  // 184,149,171,178,101, 66, 29, 59,146, 61,254,107, 42, 86,154,  4,
686
  PERM[192] := 184;
687
  PERM[193] := 149;
688
  PERM[194] := 171;
689
  PERM[195] := 178;
690
  PERM[196] := 101;
691
  PERM[197] := 66;
692
  PERM[198] := 29;
693
  PERM[199] := 59;
694
  PERM[200] := 146;
695
  PERM[201] := 61;
696
  PERM[202] := 254;
697
  PERM[203] := 107;
698
  PERM[204] := 42;
699
  PERM[205] := 86;
700
  PERM[206] := 154;
701
  PERM[207] := 4;
702
  //  236,232,120, 21,233,209, 45, 98,193,114, 78, 19,206, 14,118,127,
703
  PERM[208] := 236;
704
  PERM[209] := 232;
705
  PERM[210] := 120;
706
  PERM[211] := 21;
707
  PERM[212] := 233;
708
  PERM[213] := 209;
709
  PERM[214] := 45;
710
  PERM[215] := 98;
711
  PERM[216] := 193;
712
  PERM[217] := 114;
713
  PERM[218] := 78;
714
  PERM[219] := 19;
715
  PERM[220] := 206;
716
  PERM[221] := 14;
717
  PERM[222] := 118;
718
  PERM[223] := 127;
719
  // 48, 79,147, 85, 30,207,219, 54, 88,234,190,122, 95, 67,143,109,
720
  PERM[224] := 48;
721
  PERM[225] := 79;
722
  PERM[226] := 147;
723
  PERM[227] := 85;
724
  PERM[228] := 30;
725
  PERM[229] := 207;
726
  PERM[230] := 219;
727
  PERM[231] := 54;
728
  PERM[232] := 88;
729
  PERM[233] := 234;
730
  PERM[234] := 190;
731
  PERM[235] := 122;
732
  PERM[236] := 95;
733
  PERM[237] := 67;
734
  PERM[238] := 143;
735
  PERM[239] := 109;
736
  // 137,214,145, 93, 92,100,245,  0,216,186, 60, 83,105, 97,204, 52
737
  PERM[240] := 137;
738
  PERM[241] := 214;
739
  PERM[242] := 145;
740
  PERM[243] := 93;
741
  PERM[244] := 92;
742
  PERM[245] := 100;
743
  PERM[246] := 245;
744
  PERM[247] := 0;
745
  PERM[248] := 216;
746
  PERM[249] := 186;
747
  PERM[250] := 60;
748
  PERM[251] := 83;
749
  PERM[252] := 105;
750
  PERM[253] := 97;
751
  PERM[254] := 204;
752
  PERM[255] := 52;
753
end;
754

755
// ------------------------------------------------------------------
756
// ------------------------------------------------------------------
757
// ------------------------------------------------------------------
758
initialization
759
  // ------------------------------------------------------------------
760
  // ------------------------------------------------------------------
761
  // ------------------------------------------------------------------
762

763
  RegisterGLTextureImageClass(TGLProcTextureNoise);
764

765
finalization
766

767
end.
768

769