LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Classes and function for generation of PerlinNoise.
6

7
    History :  
8
       17/11/14 - PW - Refactored TPerlin3DNoise to TGLPerlin3DNoise, renamed unit
9
       31/08/10 - Bugfixed range error in TPerlin3DNoise.Initialize
10
       30/03/07 - DaStr - Added $I GLScene.inc
11
       14/04/04 - EG - Creation
12
    
13

14
   Loosely based on Tom Nuydens's (www.delphi3d.com) Noise.pas unit, itself based on
15
   http://students.vassar.edu/mazucker/code/perlin-noise-math-faq.html
16
   Darwin Peachey's chapter in "Texturing & Modeling: A Procedural Approach"
17
   Further bugs are mine :)
18
}
19
unit GLPerlinNoise3D;
20

21
interface
22

23
{$I GLScene.inc}
24

25
uses
26
  GLVectorGeometry;
27

28
const
29
   cPERLIN_TABLE_SIZE = 256; // must be a power of two
30

31
type
32

33
   // TGLPerlin3DNoise
34
   //
35
   { Generates Perlin Noise in the [-1; 1] range.
36
      2D noise requests are taken in the Z=0 slice }
37
   TGLPerlin3DNoise = class (TObject)
38
      protected
39
          
40
         FPermutations : packed array [0..cPERLIN_TABLE_SIZE-1] of Integer;
41
         FGradients : packed array [0..cPERLIN_TABLE_SIZE*3-1] of Single;
42

43
      protected
44
          
45
         function Lattice(ix, iy, iz : Integer; fx, fy, fz : Single) : Single; overload;
46
         function Lattice(ix, iy : Integer; fx, fy : Single) : Single; overload;
47

48
      public
49
          
50
         constructor Create(randomSeed : Integer);
51
         procedure Initialize(randomSeed : Integer);
52

53
         function Noise(const x, y : Single) : Single; overload;
54
         function Noise(const x, y, z : Single) : Single; overload;
55
         function Noise(const v : TAffineVector) : Single; overload;
56
         function Noise(const v : TVector) : Single; overload;
57
  end;
58

59
// ------------------------------------------------------------------
60
// ------------------------------------------------------------------
61
// ------------------------------------------------------------------
62
implementation
63

64
// ------------------------------------------------------------------
65
// ------------------------------------------------------------------
66
// ------------------------------------------------------------------
67

68
// ------------------
69
// ------------------ TGLPerlin3DNoise ------------------
70
// ------------------
71

72
// Create
73
//
74
constructor TGLPerlin3DNoise.Create(randomSeed : Integer);
75
begin
76
   inherited Create;
77
   Initialize(randomSeed);
78
end;
79

80
// InitGradients
81
//
82
procedure TGLPerlin3DNoise.Initialize(randomSeed : Integer);
83
var
84
   seedBackup : Cardinal;
85
   i, t, j : Integer;
86
   z, r : Single;
87
begin
88
   seedBackup:=RandSeed;
89
   RandSeed:=randomSeed;
90

91
   // Generate random gradient vectors.
92
   for i:=0 to cPERLIN_TABLE_SIZE-1 do begin
93
      z:=1-2*Random;
94
      r:=Sqrt(1-z*z);
95
      SinCos(c2PI*Random, r, FGradients[i*3], FGradients[i*3+1]);
96
      FGradients[i*3+2]:=z;
97
   end;
98
   // Initialize permutations table
99
   for i:=0 to cPERLIN_TABLE_SIZE-1 do
100
      FPermutations[i]:=i;
101
   // Shake up
102
   for i:=0 to cPERLIN_TABLE_SIZE-1 do begin
103
      j:=Random(cPERLIN_TABLE_SIZE);
104
      t:=FPermutations[i];
105
      FPermutations[i]:=FPermutations[j];
106
      FPermutations[j]:=t;
107
   end;
108

109
   RandSeed:=seedBackup;
110
end;
111

112
// Lattice (3d)
113
//
114
function TGLPerlin3DNoise.Lattice(ix, iy, iz : Integer; fx, fy, fz : Single): Single;
115
const
116
   cMask = cPERLIN_TABLE_SIZE-1;
117
var
118
   g : Integer;
119
begin
120
   g:=FPermutations[(ix+FPermutations[(iy+FPermutations[iz and cMask]) and cMask]) and cMask]*3;
121
   Result:=FGradients[g]*fx+FGradients[g+1]*fy+FGradients[g+2]*fz;
122
end;
123

124
// Lattice (2d)
125
//
126
function TGLPerlin3DNoise.Lattice(ix, iy : Integer; fx, fy : Single): Single;
127
const
128
   cMask = cPERLIN_TABLE_SIZE-1;
129
var
130
   g : Integer;
131
begin
132
   g:=FPermutations[(ix+FPermutations[(iy+FPermutations[0]) and cMask]) and cMask]*3;
133
   Result:=FGradients[g]*fx+FGradients[g+1]*fy;
134
end;
135

136
// Noise (affine)
137
//
138
function TGLPerlin3DNoise.Noise(const v : TAffineVector) : Single;
139

140
   function Smooth(var x : Single) : Single;
141
   begin
142
      Result:=x*x*(3-2*x);
143
   end;
144
   
145
var
146
   ix, iy, iz : Integer;
147
   fx0, fx1, fy0, fy1, fz0, fz1 : Single;
148
   wx, wy, wz : Single;
149
   vy0, vy1, vz0, vz1 : Single;
150
begin
151
   ix:=Floor(v.V[0]);
152
   fx0:=v.V[0]-ix;
153
   fx1:=fx0-1;
154
   wx:=Smooth(fx0);
155

156
   iy:=Floor(v.V[1]);
157
   fy0:=v.V[1]-iy;
158
   fy1:=fy0-1;
159
   wy:=Smooth(fy0);
160

161
   iz:=Floor(v.V[2]);
162
   fz0:=v.V[2]-iz;
163
   fz1:=fz0-1;
164
   wz:=Smooth(fz0);
165

166
   vy0:=Lerp(Lattice(ix, iy, iz, fx0, fy0, fz0),
167
             Lattice(ix+1, iy, iz, fx1, fy0, fz0),
168
             wx);
169
   vy1:=Lerp(Lattice(ix, iy+1, iz, fx0, fy1, fz0),
170
             Lattice(ix+1, iy+1, iz, fx1, fy1, fz0),
171
             wx);
172
   vz0:=Lerp(vy0, vy1, wy);
173

174
   vy0:=Lerp(Lattice(ix, iy, iz+1, fx0, fy0, fz1),
175
             Lattice(ix+1, iy, iz+1, fx1, fy0, fz1),
176
             wx);
177
   vy1:=Lerp(Lattice(ix, iy+1, iz+1, fx0, fy1, fz1),
178
             Lattice(ix+1, iy+1, iz+1, fx1, fy1, fz1),
179
             wx);
180
   vz1:=Lerp(vy0, vy1, wy);
181

182
   Result:=Lerp(vz0, vz1, wz);
183
end;
184

185
// Noise (dual single)
186
//
187
function TGLPerlin3DNoise.Noise(const x, y : Single) : Single;
188

189
   function Smooth(var x : Single) : Single;
190
   begin
191
      Result:=x*x*(3-2*x);
192
   end;
193

194
var
195
   ix, iy : Integer;
196
   fx0, fx1, fy0, fy1 : Single;
197
   wx, wy : Single;
198
   vy0, vy1 : Single;
199
begin
200
   ix:=Floor(x);
201
   fx0:=x-ix;
202
   fx1:=fx0-1;
203
   wx:=Smooth(fx0);
204

205
   iy:=Floor(y);
206
   fy0:=y-iy;
207
   fy1:=fy0-1;
208
   wy:=Smooth(fy0);
209

210
   vy0:=Lerp(Lattice(ix, iy, fx0, fy0),
211
             Lattice(ix+1, iy, fx1, fy0),
212
             wx);
213
   vy1:=Lerp(Lattice(ix, iy+1, fx0, fy1),
214
             Lattice(ix+1, iy+1, fx1, fy1),
215
             wx);
216
   Result:=Lerp(vy0, vy1, wy);
217
end;
218

219
// Noise (trio single)
220
//
221
function TGLPerlin3DNoise.Noise(const x, y, z : Single) : Single;
222
begin
223
   Result:=Noise(AffineVectorMake(x, y, z));
224
end;
225

226
// Noise (hmg)
227
//
228
function TGLPerlin3DNoise.Noise(const v : TVector) : Single;
229
begin
230
   Result:=Noise(PAffineVector(@v)^);
231
end;
232

233
end.
234
 
235