author | nemo |
Sun, 09 Mar 2014 20:53:11 -0400 | |
changeset 10188 | e8f2dbabd01b |
parent 10187 | 0d506346c1f0 |
child 10189 | 875607ce793d |
permissions | -rw-r--r-- |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
1 |
{$INCLUDE "options.inc"} |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
2 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
3 |
unit uLandGenPerlin; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
4 |
interface |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
5 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
6 |
procedure GenPerlin; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
7 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
8 |
implementation |
10182 | 9 |
uses uVariables, uConsts, uRandom, math; // for min() |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
10 |
|
10188 | 11 |
var p: array[0..511] of LongInt; |
12 |
||
13 |
const fadear: array[byte] of LongInt = |
|
14 |
(0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 2, 3, 3, 4, 6, 7, 9, 10, 12, |
|
15 |
14, 17, 19, 22, 25, 29, 32, 36, 40, 45, 49, 54, 60, 65, 71, |
|
16 |
77, 84, 91, 98, 105, 113, 121, 130, 139, 148, 158, 167, 178, |
|
17 |
188, 199, 211, 222, 234, 247, 259, 273, 286, 300, 314, 329, 344, |
|
18 |
359, 374, 390, 407, 424, 441, 458, 476, 494, 512, 531, 550, |
|
19 |
570, 589, 609, 630, 651, 672, 693, 715, 737, 759, 782, 805, 828, |
|
20 |
851, 875, 899, 923, 948, 973, 998, 1023, 1049, 1074, 1100, 1127, |
|
21 |
1153, 1180, 1207, 1234, 1261, 1289, 1316, 1344, 1372, 1400, 1429, |
|
22 |
1457, 1486, 1515, 1543, 1572, 1602, 1631, 1660, 1690, 1719, 1749, |
|
23 |
1778, 1808, 1838, 1868, 1898, 1928, 1958, 1988, 2018, 2048, 2077, |
|
24 |
2107, 2137, 2167, 2197, 2227, 2257, 2287, 2317, 2346, 2376, 2405, |
|
25 |
2435, 2464, 2493, 2523, 2552, 2580, 2609, 2638, 2666, 2695, 2723, |
|
26 |
2751, 2779, 2806, 2834, 2861, 2888, 2915, 2942, 2968, 2995, 3021, |
|
27 |
3046, 3072, 3097, 3122, 3147, 3172, 3196, 3220, 3244, 3267, 3290, |
|
28 |
3313, 3336, 3358, 3380, 3402, 3423, 3444, 3465, 3486, 3506, 3525, |
|
29 |
3545, 3564, 3583, 3601, 3619, 3637, 3654, 3672, 3688, 3705, 3721, |
|
30 |
3736, 3751, 3766, 3781, 3795, 3809, 3822, 3836, 3848, 3861, 3873, |
|
31 |
3884, 3896, 3907, 3917, 3928, 3937, 3947, 3956, 3965, 3974, 3982, |
|
32 |
3990, 3997, 4004, 4011, 4018, 4024, 4030, 4035, 4041, 4046, 4050, |
|
33 |
4055, 4059, 4063, 4066, 4070, 4073, 4076, 4078, 4081, 4083, 4085, |
|
34 |
4086, 4088, 4089, 4091, 4092, 4092, 4093, 4094, 4094, 4095, 4095, |
|
35 |
4095, 4095, 4095, 4095, 4095); |
|
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
36 |
|
10183 | 37 |
function fade(t: LongInt) : LongInt; inline; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
38 |
var t0, t1: LongInt; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
39 |
begin |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
40 |
t0:= fadear[t shr 8]; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
41 |
t1:= fadear[min(255, t shr 8 + 1)]; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
42 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
43 |
fade:= t0 + ((t and 255) * (t1 - t0) shr 8) |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
44 |
end; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
45 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
46 |
|
10183 | 47 |
function lerp(t, a, b: LongInt) : LongInt; inline; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
48 |
begin |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
49 |
lerp:= a + (t * (b - a) shr 12) |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
50 |
end; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
51 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
52 |
|
10188 | 53 |
function grad(hash, x, y: LongInt) : LongInt; inline; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
54 |
var h, v, u: LongInt; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
55 |
begin |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
56 |
h:= hash and 15; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
57 |
if h < 8 then u:= x else u:= y; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
58 |
if h < 4 then v:= y else |
10185 | 59 |
if (h = 12) or (h = 14) then v:= x else v:= 0; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
60 |
|
10185 | 61 |
if (h and 1) <> 0 then u:= -u; |
62 |
if (h and 2) <> 0 then v:= -v; |
|
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
63 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
64 |
grad:= u + v |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
65 |
end; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
66 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
67 |
|
10188 | 68 |
function inoise(x, y: LongInt) : LongInt; inline; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
69 |
const N = $10000; |
10185 | 70 |
var xx, yy, u, v, A, AA, AB, B, BA, BB: LongInt; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
71 |
begin |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
72 |
xx:= (x shr 16) and 255; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
73 |
yy:= (y shr 16) and 255; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
74 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
75 |
x:= x and $FFFF; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
76 |
y:= y and $FFFF; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
77 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
78 |
u:= fade(x); |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
79 |
v:= fade(y); |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
80 |
|
10185 | 81 |
A:= p[xx ] + yy; AA:= p[A]; AB:= p[A + 1]; |
82 |
B:= p[xx + 1] + yy; BA:= p[B]; BB:= p[B + 1]; |
|
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
83 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
84 |
inoise:= |
10185 | 85 |
lerp(v, lerp(u, grad(p[AA ], x , y ), |
86 |
grad(p[BA ], x-N , y )), |
|
87 |
lerp(u, grad(p[AB ], x , y-N), |
|
88 |
grad(p[BB ], x-N , y-N))); |
|
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
89 |
end; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
90 |
|
10188 | 91 |
function f(t: double): double; inline; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
92 |
begin |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
93 |
f:= t * t * t * (t * (t * 6 - 15) + 10); |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
94 |
end; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
95 |
|
10182 | 96 |
procedure inoise_setup(); |
97 |
var i, ii, t: LongInt; |
|
98 |
begin |
|
99 |
for i:= 0 to 254 do |
|
100 |
p[i]:= i + 1; |
|
101 |
p[255]:= 0; |
|
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
102 |
|
10182 | 103 |
for i:= 0 to 254 do |
104 |
begin |
|
105 |
ii:= GetRandom(256 - i) + i; |
|
106 |
t:= p[i]; |
|
107 |
p[i]:= p[ii]; |
|
108 |
p[ii]:= t |
|
109 |
end; |
|
110 |
||
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
111 |
for i:= 0 to 255 do |
10182 | 112 |
p[256 + i]:= p[i]; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
113 |
end; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
114 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
115 |
const detail = 120000*3; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
116 |
field = 3; |
10188 | 117 |
df = detail * field; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
118 |
width = 4096; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
119 |
height = 2048; |
10187
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
120 |
bottomPlateHeight = 90; |
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
121 |
bottomPlateMargin = 1200; |
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
122 |
plateFactor = 1; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
123 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
124 |
procedure GenPerlin; |
10187
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
125 |
var y, x, dy, di, dj, r: LongInt; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
126 |
begin |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
127 |
inoise_setup(); |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
128 |
|
10186 | 129 |
for y:= 1024 to pred(height) do |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
130 |
begin |
10188 | 131 |
di:= df * y div height; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
132 |
for x:= 0 to pred(width) do |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
133 |
begin |
10188 | 134 |
dj:= df * x div width; |
10186 | 135 |
r:= (abs(inoise(di, dj))) shr 8 and $ff; |
10187
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
136 |
//r:= r - max(0, abs(x - width div 2) - width * 55 div 128); // fade on edges |
10183 | 137 |
//r:= r - max(0, - abs(x - width div 2) + width * 2 div 100); // split vertically in the middle |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
138 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
139 |
|
10183 | 140 |
//r:= r + (trunc(1000 - sqrt(sqr(x - (width div 2)) * 4 + sqr(y - height * 5 div 4) * 22))) div 600 * 20; // ellipse |
10187
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
141 |
r:= r + (trunc(2000 - (abs(x - (width div 2)) * 2 + abs(y - height * 5 div 4) * 4))) div 26; // manhattan length ellipse |
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
142 |
|
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
143 |
if (y > height - bottomPlateHeight) and (x > bottomPlateMargin) and (x + bottomPlateMargin < width) then |
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
144 |
begin |
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
145 |
dy:= (y - height + bottomPlateHeight) * plateFactor; |
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
146 |
r:= r + dy; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
147 |
|
10187
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
148 |
if x < bottomPlateMargin + bottomPlateHeight then |
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
149 |
r:= r + (x - bottomPlateMargin - bottomPlateHeight) * plateFactor |
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
150 |
else |
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
151 |
if x + bottomPlateMargin + bottomPlateHeight > width then |
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
152 |
r:= r - (x - width + bottomPlateMargin + bottomPlateHeight) * plateFactor; |
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
153 |
end; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
154 |
if r < 0 then Land[y, x]:= 0 else Land[y, x]:= lfBasic; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
155 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
156 |
end; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
157 |
end; |
10184 | 158 |
|
159 |
leftX:= 0; |
|
160 |
rightX:= 4095; |
|
161 |
topY:= 0; |
|
162 |
hasBorder:= false; |
|
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
163 |
end; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
164 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
165 |
end. |