author  nemo 
Tue, 11 Mar 2014 22:32:48 0400  
changeset 10191  d9862e01309a 
parent 10190  e4f81f6d428c 
child 10192  bb1310c4bd79 
permissions  rwrr 
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 
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset

57 
lerp:= a + (t * (b  a) shr 12) 
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 ], xN , y )), 

95 
lerp(u, grad(p[AB ], x , yN), 

96 
grad(p[BB ], xN , yN))); 

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 

10190  123 
const detail = 180000; 
124 
field = 5; 

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 

10187
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset

130 
bottomPlateHeight = 90; 
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset

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; 
10187
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset

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; 
10186  145 
r:= (abs(inoise(di, dj))) shr 8 and $ff; 
10190  146 
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

147 

10190  148 
r:= r  (height  y) div 32; 
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset

149 

10190  150 
//r:= r  max(0,  abs(x  width div 2) + width * 2 div 100); // split vertically in the middle 
10183  151 
//r:= r + (trunc(1000  sqrt(sqr(x  (width div 2)) * 4 + sqr(y  height * 5 div 4) * 22))) div 600 * 20; // ellipse 
10190  152 
//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

153 

10190  154 
{ 
10187
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset

155 
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

156 
begin 
10190  157 
dy:= (y  height + bottomPlateHeight); 
10187
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset

158 
r:= r + dy; 
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset

159 

10187
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset

160 
if x < bottomPlateMargin + bottomPlateHeight then 
10190  161 
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

162 
else 
0d506346c1f0
Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents:
10186
diff
changeset

163 
if x + bottomPlateMargin + bottomPlateHeight > width then 
10190  164 
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

165 
end; 
10190  166 
} 
10189  167 
if r < 0 then Land[y, x]:= 0 else Land[y, x]:= lfObjMask; 
10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset

168 

4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset

169 
end; 
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset

170 
end; 
10184  171 

10189  172 
for x:= 0 to width do 
173 
if Land[height  1, x] = lfObjMask then FillLand(x, height  1, 0, lfBasic); 

10191  174 
//FillLand(0, minY, lfBasic, lfObjMask); 
10190  175 

176 
// strip all lfObjMask pixels 

10191  177 
for y:= minY to LAND_HEIGHT  1 do 
10190  178 
for x:= 0 to LAND_WIDTH  1 do 
179 
if Land[y, x] = lfObjMask then 

180 
Land[y, x]:= 0; 

10189  181 

10184  182 
leftX:= 0; 
183 
rightX:= 4095; 

184 
topY:= 0; 

185 
hasBorder:= false; 

10181
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset

186 
end; 
4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset

187 

4708343d5963
Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff
changeset

188 
end. 