author | Wuzzy <Wuzzy2@mail.ru> |
Wed, 14 Mar 2018 23:02:39 +0100 | |
changeset 13216 | 667f28278aa4 |
parent 10702 | 528d899443ab |
child 15016 | bea068dd9356 |
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 |
10189 | 9 |
uses uVariables |
10 |
, uConsts |
|
11 |
, uRandom |
|
12 |
, uLandOutline // FillLand |
|
10479 | 13 |
, uUtils |
10189 | 14 |
; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
15 |
|
10188 | 16 |
var p: array[0..511] of LongInt; |
17 |
||
10510 | 18 |
const fadear: array[byte] of LongInt = |
10188 | 19 |
(0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 2, 3, 3, 4, 6, 7, 9, 10, 12, |
20 |
14, 17, 19, 22, 25, 29, 32, 36, 40, 45, 49, 54, 60, 65, 71, |
|
21 |
77, 84, 91, 98, 105, 113, 121, 130, 139, 148, 158, 167, 178, |
|
22 |
188, 199, 211, 222, 234, 247, 259, 273, 286, 300, 314, 329, 344, |
|
23 |
359, 374, 390, 407, 424, 441, 458, 476, 494, 512, 531, 550, |
|
24 |
570, 589, 609, 630, 651, 672, 693, 715, 737, 759, 782, 805, 828, |
|
25 |
851, 875, 899, 923, 948, 973, 998, 1023, 1049, 1074, 1100, 1127, |
|
26 |
1153, 1180, 1207, 1234, 1261, 1289, 1316, 1344, 1372, 1400, 1429, |
|
27 |
1457, 1486, 1515, 1543, 1572, 1602, 1631, 1660, 1690, 1719, 1749, |
|
28 |
1778, 1808, 1838, 1868, 1898, 1928, 1958, 1988, 2018, 2048, 2077, |
|
29 |
2107, 2137, 2167, 2197, 2227, 2257, 2287, 2317, 2346, 2376, 2405, |
|
30 |
2435, 2464, 2493, 2523, 2552, 2580, 2609, 2638, 2666, 2695, 2723, |
|
31 |
2751, 2779, 2806, 2834, 2861, 2888, 2915, 2942, 2968, 2995, 3021, |
|
32 |
3046, 3072, 3097, 3122, 3147, 3172, 3196, 3220, 3244, 3267, 3290, |
|
33 |
3313, 3336, 3358, 3380, 3402, 3423, 3444, 3465, 3486, 3506, 3525, |
|
34 |
3545, 3564, 3583, 3601, 3619, 3637, 3654, 3672, 3688, 3705, 3721, |
|
35 |
3736, 3751, 3766, 3781, 3795, 3809, 3822, 3836, 3848, 3861, 3873, |
|
36 |
3884, 3896, 3907, 3917, 3928, 3937, 3947, 3956, 3965, 3974, 3982, |
|
37 |
3990, 3997, 4004, 4011, 4018, 4024, 4030, 4035, 4041, 4046, 4050, |
|
38 |
4055, 4059, 4063, 4066, 4070, 4073, 4076, 4078, 4081, 4083, 4085, |
|
39 |
4086, 4088, 4089, 4091, 4092, 4092, 4093, 4094, 4094, 4095, 4095, |
|
40 |
4095, 4095, 4095, 4095, 4095); |
|
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
41 |
|
10183 | 42 |
function fade(t: LongInt) : LongInt; inline; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
43 |
var t0, t1: LongInt; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
44 |
begin |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
45 |
t0:= fadear[t shr 8]; |
10189 | 46 |
|
10510 | 47 |
if t0 = fadear[255] then |
10189 | 48 |
t1:= t0 |
49 |
else |
|
50 |
t1:= fadear[t shr 8 + 1]; |
|
10181
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 |
fade:= t0 + ((t and 255) * (t1 - t0) shr 8) |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
53 |
end; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
54 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
55 |
|
10183 | 56 |
function lerp(t, a, b: LongInt) : LongInt; inline; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
57 |
begin |
10494 | 58 |
lerp:= a + ((Int64(b) - a) * t shr 12) |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
59 |
end; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
60 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
61 |
|
10188 | 62 |
function grad(hash, x, y: LongInt) : LongInt; inline; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
63 |
var h, v, u: LongInt; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
64 |
begin |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
65 |
h:= hash and 15; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
66 |
if h < 8 then u:= x else u:= y; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
67 |
if h < 4 then v:= y else |
10185 | 68 |
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
|
69 |
|
10185 | 70 |
if (h and 1) <> 0 then u:= -u; |
71 |
if (h and 2) <> 0 then v:= -v; |
|
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
72 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
73 |
grad:= u + v |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
74 |
end; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
75 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
76 |
|
10188 | 77 |
function inoise(x, y: LongInt) : LongInt; inline; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
78 |
const N = $10000; |
10185 | 79 |
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
|
80 |
begin |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
81 |
xx:= (x shr 16) and 255; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
82 |
yy:= (y shr 16) and 255; |
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 |
x:= x and $FFFF; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
85 |
y:= y and $FFFF; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
86 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
87 |
u:= fade(x); |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
88 |
v:= fade(y); |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
89 |
|
10185 | 90 |
A:= p[xx ] + yy; AA:= p[A]; AB:= p[A + 1]; |
91 |
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
|
92 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
93 |
inoise:= |
10185 | 94 |
lerp(v, lerp(u, grad(p[AA ], x , y ), |
95 |
grad(p[BA ], x-N , y )), |
|
96 |
lerp(u, grad(p[AB ], x , y-N), |
|
97 |
grad(p[BB ], x-N , y-N))); |
|
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
98 |
end; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
99 |
|
10182 | 100 |
procedure inoise_setup(); |
10494 | 101 |
var i, ii, t: Longword; |
10182 | 102 |
begin |
103 |
for i:= 0 to 254 do |
|
104 |
p[i]:= i + 1; |
|
105 |
p[255]:= 0; |
|
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
106 |
|
10182 | 107 |
for i:= 0 to 254 do |
108 |
begin |
|
109 |
ii:= GetRandom(256 - i) + i; |
|
110 |
t:= p[i]; |
|
111 |
p[i]:= p[ii]; |
|
112 |
p[ii]:= t |
|
113 |
end; |
|
114 |
||
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
115 |
for i:= 0 to 255 do |
10182 | 116 |
p[256 + i]:= p[i]; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
117 |
end; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
118 |
|
10479 | 119 |
const width = 4096; |
120 |
height = 2048; |
|
121 |
minY = 500; |
|
10190 | 122 |
|
10249 | 123 |
//bottomPlateHeight = 90; |
124 |
//bottomPlateMargin = 1200; |
|
10190 | 125 |
margin = 200; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
126 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
127 |
procedure GenPerlin; |
10702 | 128 |
var y, x, di, dj, r, param1, param2, rCutoff, detail: LongInt; |
129 |
var df: Int64; |
|
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
130 |
begin |
10391 | 131 |
param1:= cTemplateFilter div 3; |
132 |
param2:= cTemplateFilter mod 3; |
|
10491 | 133 |
rCutoff:= min(max((26-cFeatureSize)*4,15),85); |
134 |
detail:= (26-cFeatureSize)*16000+50000; // feature size is a slider from 1-25 at present. flip it for perlin |
|
10391 | 135 |
|
136 |
df:= detail * (6 - param2 * 2); |
|
137 |
||
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
138 |
inoise_setup(); |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
139 |
|
10190 | 140 |
for y:= minY to pred(height) do |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
141 |
begin |
10188 | 142 |
di:= df * y div height; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
143 |
for x:= 0 to pred(width) do |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
144 |
begin |
10188 | 145 |
dj:= df * x div width; |
10192
bb1310c4bd79
Feel free to revert this one, was just screwing around with stuff from before. I kinda like it and figured committing it was the easiest way for you to look at it. http://m8y.org/hw/perlin.png
nemo
parents:
10191
diff
changeset
|
146 |
|
10386 | 147 |
r:= ((abs(inoise(di, dj)) + y*4) mod 65536 - (height - y) * 8) div 256; |
10192
bb1310c4bd79
Feel free to revert this one, was just screwing around with stuff from before. I kinda like it and figured committing it was the easiest way for you to look at it. http://m8y.org/hw/perlin.png
nemo
parents:
10191
diff
changeset
|
148 |
|
bb1310c4bd79
Feel free to revert this one, was just screwing around with stuff from before. I kinda like it and figured committing it was the easiest way for you to look at it. http://m8y.org/hw/perlin.png
nemo
parents:
10191
diff
changeset
|
149 |
//r:= (abs(inoise(di, dj))) shr 8 and $ff; |
10190 | 150 |
if (x < margin) or (x > width - margin) then r:= r - abs(x - width div 2) + width div 2 - margin; // fade on edges |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
151 |
|
10190 | 152 |
//r:= r - max(0, - abs(x - width div 2) + width * 2 div 100); // split vertically in the middle |
10183 | 153 |
//r:= r + (trunc(1000 - sqrt(sqr(x - (width div 2)) * 4 + sqr(y - height * 5 div 4) * 22))) div 600 * 20; // ellipse |
10190 | 154 |
//r:= r + 1 - ((abs(x - (width div 2)) + abs(y - height) * 2)) div 32; // manhattan length ellipse |
10187
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
155 |
|
10190 | 156 |
{ |
10187
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
157 |
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
|
158 |
begin |
10190 | 159 |
dy:= (y - height + bottomPlateHeight); |
10187
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
160 |
r:= r + dy; |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
161 |
|
10187
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
162 |
if x < bottomPlateMargin + bottomPlateHeight then |
10190 | 163 |
r:= r + (x - bottomPlateMargin - bottomPlateHeight) |
10187
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
164 |
else |
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
165 |
if x + bottomPlateMargin + bottomPlateHeight > width then |
10190 | 166 |
r:= r - (x - width + bottomPlateMargin + bottomPlateHeight); |
10187
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset
|
167 |
end; |
10190 | 168 |
} |
10192
bb1310c4bd79
Feel free to revert this one, was just screwing around with stuff from before. I kinda like it and figured committing it was the easiest way for you to look at it. http://m8y.org/hw/perlin.png
nemo
parents:
10191
diff
changeset
|
169 |
|
10492 | 170 |
if r < rCutoff then |
171 |
Land[y, x]:= 0 |
|
172 |
else if param1 = 0 then |
|
173 |
Land[y, x]:= lfObjMask |
|
174 |
else |
|
10510 | 175 |
Land[y, x]:= lfBasic |
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
176 |
end; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
177 |
end; |
10184 | 178 |
|
10391 | 179 |
if param1 = 0 then |
180 |
begin |
|
181 |
for x:= 0 to width do |
|
182 |
if Land[height - 1, x] = lfObjMask then FillLand(x, height - 1, 0, lfBasic); |
|
10190 | 183 |
|
10391 | 184 |
// strip all lfObjMask pixels |
185 |
for y:= minY to LAND_HEIGHT - 1 do |
|
186 |
for x:= 0 to LAND_WIDTH - 1 do |
|
187 |
if Land[y, x] = lfObjMask then |
|
188 |
Land[y, x]:= 0; |
|
189 |
end; |
|
10189 | 190 |
|
10184 | 191 |
leftX:= 0; |
192 |
rightX:= 4095; |
|
193 |
topY:= 0; |
|
194 |
hasBorder:= false; |
|
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
195 |
end; |
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
196 |
|
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset
|
197 |
end. |