| changeset 10189 | 875607ce793d |
| parent 10188 | e8f2dbabd01b |
| child 10190 | e4f81f6d428c |
| 10188:e8f2dbabd01b | 10189:875607ce793d |
|---|---|
4 interface |
4 interface |
5 |
5 |
6 procedure GenPerlin; |
6 procedure GenPerlin; |
7 |
7 |
8 implementation |
8 implementation |
9 uses uVariables, uConsts, uRandom, math; // for min() |
9 uses uVariables |
10 , uConsts |
|
11 , uRandom |
|
12 , uLandOutline // FillLand |
|
13 ; |
|
10 |
14 |
11 var p: array[0..511] of LongInt; |
15 var p: array[0..511] of LongInt; |
12 |
16 |
13 const fadear: array[byte] of LongInt = |
17 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, |
18 (0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 2, 3, 3, 4, 6, 7, 9, 10, 12, |
36 |
40 |
37 function fade(t: LongInt) : LongInt; inline; |
41 function fade(t: LongInt) : LongInt; inline; |
38 var t0, t1: LongInt; |
42 var t0, t1: LongInt; |
39 begin |
43 begin |
40 t0:= fadear[t shr 8]; |
44 t0:= fadear[t shr 8]; |
41 t1:= fadear[min(255, t shr 8 + 1)]; |
45 |
46 if t0 = fadear[255] then |
|
47 t1:= t0 |
|
48 else |
|
49 t1:= fadear[t shr 8 + 1]; |
|
42 |
50 |
43 fade:= t0 + ((t and 255) * (t1 - t0) shr 8) |
51 fade:= t0 + ((t and 255) * (t1 - t0) shr 8) |
44 end; |
52 end; |
45 |
53 |
46 |
54 |
149 r:= r + (x - bottomPlateMargin - bottomPlateHeight) * plateFactor |
157 r:= r + (x - bottomPlateMargin - bottomPlateHeight) * plateFactor |
150 else |
158 else |
151 if x + bottomPlateMargin + bottomPlateHeight > width then |
159 if x + bottomPlateMargin + bottomPlateHeight > width then |
152 r:= r - (x - width + bottomPlateMargin + bottomPlateHeight) * plateFactor; |
160 r:= r - (x - width + bottomPlateMargin + bottomPlateHeight) * plateFactor; |
153 end; |
161 end; |
154 if r < 0 then Land[y, x]:= 0 else Land[y, x]:= lfBasic; |
162 if r < 0 then Land[y, x]:= 0 else Land[y, x]:= lfObjMask; |
155 |
163 |
156 end; |
164 end; |
157 end; |
165 end; |
166 |
|
167 for x:= 0 to width do |
|
168 if Land[height - 1, x] = lfObjMask then FillLand(x, height - 1, 0, lfBasic); |
|
169 FillLand(0, 0, lfBasic, lfObjMask); |
|
170 FillLand(0, 0, lfBasic, 0); |
|
158 |
171 |
159 leftX:= 0; |
172 leftX:= 0; |
160 rightX:= 4095; |
173 rightX:= 4095; |
161 topY:= 0; |
174 topY:= 0; |
162 hasBorder:= false; |
175 hasBorder:= false; |