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