author | unc0rr |
Wed, 20 May 2009 16:43:19 +0000 | |
changeset 2080 | 6d29370dc0dd |
parent 1906 | 644f93d8f148 |
child 2096 | 356468481e74 |
permissions | -rw-r--r-- |
4 | 1 |
(* |
1066 | 2 |
* Hedgewars, a free turn based strategy game |
883 | 3 |
* Copyright (c) 2005-2008 Andrey Korotaev <unC0Rr@gmail.com> |
4 | 4 |
* |
183 | 5 |
* This program is free software; you can redistribute it and/or modify |
6 |
* it under the terms of the GNU General Public License as published by |
|
7 |
* the Free Software Foundation; version 2 of the License |
|
4 | 8 |
* |
183 | 9 |
* This program is distributed in the hope that it will be useful, |
10 |
* but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
11 |
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
12 |
* GNU General Public License for more details. |
|
4 | 13 |
* |
183 | 14 |
* You should have received a copy of the GNU General Public License |
15 |
* along with this program; if not, write to the Free Software |
|
16 |
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA |
|
4 | 17 |
*) |
18 |
||
19 |
unit uLand; |
|
20 |
interface |
|
1906 | 21 |
uses SDLh, uLandTemplates, uFloat, |
22 |
{$IFDEF IPHONE} |
|
23 |
gles11, |
|
24 |
{$ELSE} |
|
25 |
GL, |
|
26 |
{$ENDIF} |
|
27 |
uConsts; |
|
4 | 28 |
{$include options.inc} |
1760 | 29 |
type TLandArray = packed array[0 .. LAND_HEIGHT - 1, 0 .. LAND_WIDTH - 1] of LongWord; |
30 |
TPreview = packed array[0..127, 0..31] of byte; |
|
31 |
TDirtyTag = packed array[0 .. LAND_HEIGHT div 32 - 1, 0 .. LAND_WIDTH div 32 - 1] of byte; |
|
4 | 32 |
|
33 |
var Land: TLandArray; |
|
768 | 34 |
LandPixels: TLandArray; |
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1537
diff
changeset
|
35 |
LandDirty: TDirtyTag; |
1776 | 36 |
hasBorder: boolean; // I'm putting this here for now. I'd like it to be toggleable by user (so user can set a border on a non-cave map) - will turn off air attacks |
37 |
hasGirders: boolean; // I think should be on template by template basis. some caverns might have open water and large spaces. Some islands don't need? It might be better to tweak the girder code based upon space above. dunno. |
|
1792 | 38 |
playHeight, playWidth, leftX, rightX, topY, MaxHedgehogs: Longword; // idea is that a template can specify height/width. Or, a map, a height/width by the dimensions of the image. If the map has pixels near top of image, it triggers border. Maybe not a good idea, but, for now? Could also be used to prevent placing a girder outside play area on maps with hasBorder = true |
1776 | 39 |
|
40 |
// in your coding style, it appears to be "isXXXX" for a verb, and "FooBar" for everything else - should be PlayHeight ? |
|
4 | 41 |
|
37 | 42 |
procedure GenMap; |
766 | 43 |
function GenPreview: TPreview; |
367 | 44 |
procedure CheckLandDigest(s: shortstring); |
4 | 45 |
|
46 |
implementation |
|
1806 | 47 |
uses uConsole, uStore, uMisc, uRandom, uTeams, uLandObjects, uSHA, uIO, uAmmos, uLandTexture; |
4 | 48 |
|
49 |
type TPixAr = record |
|
50 |
Count: Longword; |
|
22 | 51 |
ar: array[0..Pred(cMaxEdgePoints)] of TPoint; |
4 | 52 |
end; |
53 |
||
37 | 54 |
procedure LogLandDigest; |
316 | 55 |
var ctx: TSHA1Context; |
56 |
dig: TSHA1Digest; |
|
57 |
s: shortstring; |
|
37 | 58 |
begin |
316 | 59 |
SHA1Init(ctx); |
60 |
SHA1Update(ctx, @Land, sizeof(Land)); |
|
61 |
dig:= SHA1Final(ctx); |
|
367 | 62 |
s:='M{'+inttostr(dig[0])+':' |
316 | 63 |
+inttostr(dig[1])+':' |
64 |
+inttostr(dig[2])+':' |
|
65 |
+inttostr(dig[3])+':' |
|
66 |
+inttostr(dig[4])+'}'; |
|
699 | 67 |
CheckLandDigest(s); |
367 | 68 |
SendIPCRaw(@s[0], Length(s) + 1) |
69 |
end; |
|
70 |
||
71 |
procedure CheckLandDigest(s: shortstring); |
|
72 |
const digest: shortstring = ''; |
|
73 |
begin |
|
368 | 74 |
{$IFDEF DEBUGFILE} |
75 |
AddFileLog('CheckLandDigest: ' + s); |
|
76 |
{$ENDIF} |
|
367 | 77 |
if digest = '' then |
78 |
digest:= s |
|
79 |
else |
|
700 | 80 |
TryDo(s = digest, 'Different maps generated, sorry', true) |
37 | 81 |
end; |
82 |
||
371 | 83 |
procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword); |
358 | 84 |
var |
371 | 85 |
eX, eY, dX, dY: LongInt; |
86 |
i, sX, sY, x, y, d: LongInt; |
|
358 | 87 |
begin |
88 |
eX:= 0; |
|
89 |
eY:= 0; |
|
90 |
dX:= X2 - X1; |
|
91 |
dY:= Y2 - Y1; |
|
92 |
||
93 |
if (dX > 0) then sX:= 1 |
|
94 |
else |
|
95 |
if (dX < 0) then |
|
96 |
begin |
|
97 |
sX:= -1; |
|
98 |
dX:= -dX |
|
99 |
end else sX:= dX; |
|
100 |
||
101 |
if (dY > 0) then sY:= 1 |
|
102 |
else |
|
103 |
if (dY < 0) then |
|
104 |
begin |
|
105 |
sY:= -1; |
|
106 |
dY:= -dY |
|
107 |
end else sY:= dY; |
|
108 |
||
109 |
if (dX > dY) then d:= dX |
|
110 |
else d:= dY; |
|
111 |
||
112 |
x:= X1; |
|
113 |
y:= Y1; |
|
114 |
||
115 |
for i:= 0 to d do |
|
116 |
begin |
|
117 |
inc(eX, dX); |
|
118 |
inc(eY, dY); |
|
119 |
if (eX > d) then |
|
120 |
begin |
|
121 |
dec(eX, d); |
|
122 |
inc(x, sX); |
|
123 |
end; |
|
124 |
if (eY > d) then |
|
125 |
begin |
|
126 |
dec(eY, d); |
|
127 |
inc(y, sY); |
|
128 |
end; |
|
364 | 129 |
|
1753 | 130 |
if ((x and LAND_WIDTH_MASK) = 0) and ((y and LAND_HEIGHT_MASK) = 0) then |
358 | 131 |
Land[y, x]:= Color; |
132 |
end |
|
133 |
end; |
|
134 |
||
365 | 135 |
procedure DrawEdge(var pa: TPixAr; Color: Longword); |
371 | 136 |
var i: LongInt; |
4 | 137 |
begin |
365 | 138 |
i:= 0; |
4 | 139 |
with pa do |
371 | 140 |
while i < LongInt(Count) - 1 do |
365 | 141 |
if (ar[i + 1].X = NTPX) then inc(i, 2) |
142 |
else begin |
|
143 |
DrawLine(ar[i].x, ar[i].y, ar[i + 1].x, ar[i + 1].y, Color); |
|
144 |
inc(i) |
|
145 |
end |
|
22 | 146 |
end; |
147 |
||
365 | 148 |
procedure Vector(p1, p2, p3: TPoint; var Vx, Vy: hwFloat); |
149 |
var d1, d2, d: hwFloat; |
|
364 | 150 |
begin |
498 | 151 |
Vx:= int2hwFloat(p1.X - p3.X); |
152 |
Vy:= int2hwFloat(p1.Y - p3.Y); |
|
153 |
d:= DistanceI(p2.X - p1.X, p2.Y - p1.Y); |
|
154 |
d1:= DistanceI(p2.X - p3.X, p2.Y - p3.Y); |
|
365 | 155 |
d2:= Distance(Vx, Vy); |
156 |
if d1 < d then d:= d1; |
|
157 |
if d2 < d then d:= d2; |
|
158 |
d:= d * _1div3; |
|
159 |
if d2.QWordValue = 0 then |
|
160 |
begin |
|
498 | 161 |
Vx:= _0; |
162 |
Vy:= _0 |
|
365 | 163 |
end else |
164 |
begin |
|
498 | 165 |
d2:= _1 / d2; |
365 | 166 |
Vx:= Vx * d2; |
167 |
Vy:= Vy * d2; |
|
168 |
||
169 |
Vx:= Vx * d; |
|
170 |
Vy:= Vy * d |
|
171 |
end |
|
172 |
end; |
|
173 |
||
371 | 174 |
procedure AddLoopPoints(var pa, opa: TPixAr; StartI, EndI: LongInt; Delta: hwFloat); |
175 |
var i, pi, ni: LongInt; |
|
365 | 176 |
NVx, NVy, PVx, PVy: hwFloat; |
498 | 177 |
x1, x2, y1, y2: LongInt; |
178 |
tsq, tcb, t, r1, r2, r3, cx1, cx2, cy1, cy2: hwFloat; |
|
371 | 179 |
X, Y: LongInt; |
365 | 180 |
begin |
181 |
pi:= EndI; |
|
182 |
i:= StartI; |
|
183 |
ni:= Succ(StartI); |
|
184 |
Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy); |
|
185 |
repeat |
|
186 |
inc(pi); |
|
187 |
if pi > EndI then pi:= StartI; |
|
188 |
inc(i); |
|
189 |
if i > EndI then i:= StartI; |
|
190 |
inc(ni); |
|
191 |
if ni > EndI then ni:= StartI; |
|
192 |
PVx:= NVx; |
|
193 |
PVy:= NVy; |
|
194 |
Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy); |
|
195 |
||
196 |
x1:= opa.ar[pi].x; |
|
197 |
y1:= opa.ar[pi].y; |
|
198 |
x2:= opa.ar[i].x; |
|
199 |
y2:= opa.ar[i].y; |
|
498 | 200 |
cx1:= int2hwFloat(x1) - PVx; |
201 |
cy1:= int2hwFloat(y1) - PVy; |
|
202 |
cx2:= int2hwFloat(x2) + NVx; |
|
203 |
cy2:= int2hwFloat(y2) + NVy; |
|
204 |
t:= _0; |
|
364 | 205 |
while t.Round = 0 do |
206 |
begin |
|
207 |
tsq:= t * t; |
|
208 |
tcb:= tsq * t; |
|
498 | 209 |
r1:= (_1 - t*3 + tsq*3 - tcb); |
210 |
r2:= ( t*3 - tsq*6 + tcb*3); |
|
211 |
r3:= ( tsq*3 - tcb*3); |
|
430 | 212 |
X:= hwRound(r1 * x1 + r2 * cx1 + r3 * cx2 + tcb * x2); |
213 |
Y:= hwRound(r1 * y1 + r2 * cy1 + r3 * cy2 + tcb * y2); |
|
364 | 214 |
t:= t + Delta; |
215 |
pa.ar[pa.Count].x:= X; |
|
216 |
pa.ar[pa.Count].y:= Y; |
|
217 |
inc(pa.Count); |
|
218 |
TryDo(pa.Count <= cMaxEdgePoints, 'Edge points overflow', true) |
|
219 |
end; |
|
365 | 220 |
until i = StartI; |
221 |
pa.ar[pa.Count].x:= opa.ar[StartI].X; |
|
222 |
pa.ar[pa.Count].y:= opa.ar[StartI].Y; |
|
364 | 223 |
inc(pa.Count) |
224 |
end; |
|
225 |
||
365 | 226 |
procedure BezierizeEdge(var pa: TPixAr; Delta: hwFloat); |
495 | 227 |
var i, StartLoop: LongInt; |
365 | 228 |
opa: TPixAr; |
229 |
begin |
|
230 |
opa:= pa; |
|
231 |
pa.Count:= 0; |
|
232 |
i:= 0; |
|
233 |
StartLoop:= 0; |
|
371 | 234 |
while i < LongInt(opa.Count) do |
365 | 235 |
if (opa.ar[i + 1].X = NTPX) then |
236 |
begin |
|
237 |
AddLoopPoints(pa, opa, StartLoop, i, Delta); |
|
238 |
inc(i, 2); |
|
239 |
StartLoop:= i; |
|
240 |
pa.ar[pa.Count].X:= NTPX; |
|
241 |
inc(pa.Count); |
|
242 |
end else inc(i) |
|
243 |
end; |
|
244 |
||
371 | 245 |
procedure FillLand(x, y: LongInt); |
4 | 246 |
var Stack: record |
247 |
Count: Longword; |
|
248 |
points: array[0..8192] of record |
|
371 | 249 |
xl, xr, y, dir: LongInt; |
4 | 250 |
end |
251 |
end; |
|
252 |
||
371 | 253 |
procedure Push(_xl, _xr, _y, _dir: LongInt); |
4 | 254 |
begin |
75 | 255 |
TryDo(Stack.Count <= 8192, 'FillLand: stack overflow', true); |
4 | 256 |
_y:= _y + _dir; |
1760 | 257 |
if (_y < 0) or (_y >= LAND_HEIGHT) then exit; |
4 | 258 |
with Stack.points[Stack.Count] do |
259 |
begin |
|
260 |
xl:= _xl; |
|
261 |
xr:= _xr; |
|
262 |
y:= _y; |
|
263 |
dir:= _dir |
|
264 |
end; |
|
75 | 265 |
inc(Stack.Count) |
4 | 266 |
end; |
267 |
||
371 | 268 |
procedure Pop(var _xl, _xr, _y, _dir: LongInt); |
4 | 269 |
begin |
270 |
dec(Stack.Count); |
|
271 |
with Stack.points[Stack.Count] do |
|
272 |
begin |
|
273 |
_xl:= xl; |
|
274 |
_xr:= xr; |
|
275 |
_y:= y; |
|
276 |
_dir:= dir |
|
277 |
end |
|
278 |
end; |
|
279 |
||
371 | 280 |
var xl, xr, dir: LongInt; |
351 | 281 |
begin |
4 | 282 |
Stack.Count:= 0; |
283 |
xl:= x - 1; |
|
284 |
xr:= x; |
|
23 | 285 |
Push(xl, xr, y, -1); |
286 |
Push(xl, xr, y, 1); |
|
4 | 287 |
while Stack.Count > 0 do |
288 |
begin |
|
289 |
Pop(xl, xr, y, dir); |
|
51 | 290 |
while (xl > 0) and (Land[y, xl] <> 0) do dec(xl); |
1760 | 291 |
while (xr < LAND_WIDTH - 1) and (Land[y, xr] <> 0) do inc(xr); |
4 | 292 |
while (xl < xr) do |
293 |
begin |
|
51 | 294 |
while (xl <= xr) and (Land[y, xl] = 0) do inc(xl); |
4 | 295 |
x:= xl; |
51 | 296 |
while (xl <= xr) and (Land[y, xl] <> 0) do |
4 | 297 |
begin |
51 | 298 |
Land[y, xl]:= 0; |
4 | 299 |
inc(xl) |
300 |
end; |
|
22 | 301 |
if x < xl then |
302 |
begin |
|
303 |
Push(x, Pred(xl), y, dir); |
|
304 |
Push(x, Pred(xl), y,-dir); |
|
305 |
end; |
|
4 | 306 |
end; |
307 |
end; |
|
308 |
end; |
|
309 |
||
310 |
procedure ColorizeLand(Surface: PSDL_Surface); |
|
311 |
var tmpsurf: PSDL_Surface; |
|
1182
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
312 |
r, rr: TSDL_Rect; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
313 |
x, yd, yu: LongInt; |
4 | 314 |
begin |
567 | 315 |
tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/LandTex', false, true, false); |
4 | 316 |
r.y:= 0; |
1760 | 317 |
while r.y < LAND_HEIGHT do |
1182
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
318 |
begin |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
319 |
r.x:= 0; |
1760 | 320 |
while r.x < LAND_WIDTH do |
1182
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
321 |
begin |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
322 |
SDL_UpperBlit(tmpsurf, nil, Surface, @r); |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
323 |
inc(r.x, tmpsurf^.w) |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
324 |
end; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
325 |
inc(r.y, tmpsurf^.h) |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
326 |
end; |
4 | 327 |
SDL_FreeSurface(tmpsurf); |
328 |
||
351 | 329 |
tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/Border', false, true, true); |
1760 | 330 |
for x:= 0 to LAND_WIDTH - 1 do |
1182
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
331 |
begin |
1760 | 332 |
yd:= LAND_HEIGHT - 1; |
1182
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
333 |
repeat |
1760 | 334 |
while (yd > 0) and (Land[yd, x] = 0) do dec(yd); |
1182
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
335 |
|
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
336 |
if (yd < 0) then yd:= 0; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
337 |
|
1760 | 338 |
while (yd < LAND_HEIGHT) and (Land[yd, x] <> 0) do inc(yd); |
1182
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
339 |
dec(yd); |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
340 |
yu:= yd; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
341 |
|
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
342 |
while (yu > 0 ) and (Land[yu, x] <> 0) do dec(yu); |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
343 |
while (yu < yd ) and (Land[yu, x] = 0) do inc(yu); |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
344 |
|
1760 | 345 |
if (yd < LAND_HEIGHT - 1) and ((yd - yu) >= 16) then |
1182
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
346 |
begin |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
347 |
rr.x:= x; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
348 |
rr.y:= yd - 15; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
349 |
r.x:= x mod tmpsurf^.w; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
350 |
r.y:= 16; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
351 |
r.w:= 1; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
352 |
r.h:= 16; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
353 |
SDL_UpperBlit(tmpsurf, @r, Surface, @rr); |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
354 |
end; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
355 |
if (yu > 0) then |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
356 |
begin |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
357 |
rr.x:= x; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
358 |
rr.y:= yu; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
359 |
r.x:= x mod tmpsurf^.w; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
360 |
r.y:= 0; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
361 |
r.w:= 1; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
362 |
r.h:= min(16, yd - yu + 1); |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
363 |
SDL_UpperBlit(tmpsurf, @r, Surface, @rr); |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
364 |
end; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
365 |
yd:= yu - 1; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
366 |
until yd < 0; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
367 |
end; |
4 | 368 |
end; |
369 |
||
358 | 370 |
procedure SetPoints(var Template: TEdgeTemplate; var pa: TPixAr); |
371 | 371 |
var i: LongInt; |
22 | 372 |
begin |
23 | 373 |
with Template do |
374 |
begin |
|
358 | 375 |
pa.Count:= BasePointsCount; |
376 |
for i:= 0 to pred(pa.Count) do |
|
23 | 377 |
begin |
371 | 378 |
pa.ar[i].x:= BasePoints^[i].x + LongInt(GetRandom(BasePoints^[i].w)); |
1792 | 379 |
if pa.ar[i].x <> NTPX then |
380 |
pa.ar[i].x:= pa.ar[i].x + ((LAND_WIDTH - Template.TemplateWidth) div 2); |
|
1776 | 381 |
pa.ar[i].y:= BasePoints^[i].y + LongInt(GetRandom(BasePoints^[i].h)) + LAND_HEIGHT - Template.TemplateHeight |
23 | 382 |
end; |
1183
540cea859395
Step 4: repair girder rendering (girder is 32bit now)
unc0rr
parents:
1182
diff
changeset
|
383 |
|
358 | 384 |
if canMirror then |
360 | 385 |
if getrandom(2) = 0 then |
358 | 386 |
begin |
387 |
for i:= 0 to pred(BasePointsCount) do |
|
365 | 388 |
if pa.ar[i].x <> NTPX then |
1760 | 389 |
pa.ar[i].x:= LAND_WIDTH - 1 - pa.ar[i].x; |
358 | 390 |
for i:= 0 to pred(FillPointsCount) do |
1760 | 391 |
FillPoints^[i].x:= LAND_WIDTH - 1 - FillPoints^[i].x; |
358 | 392 |
end; |
22 | 393 |
|
358 | 394 |
if canFlip then |
360 | 395 |
if getrandom(2) = 0 then |
358 | 396 |
begin |
397 |
for i:= 0 to pred(BasePointsCount) do |
|
1760 | 398 |
pa.ar[i].y:= LAND_HEIGHT - 1 - pa.ar[i].y; |
358 | 399 |
for i:= 0 to pred(FillPointsCount) do |
1760 | 400 |
FillPoints^[i].y:= LAND_HEIGHT - 1 - FillPoints^[i].y; |
358 | 401 |
end; |
402 |
end |
|
4 | 403 |
end; |
67 | 404 |
|
561 | 405 |
function CheckIntersect(V1, V2, V3, V4: TPoint): boolean; |
406 |
var c1, c2, dm: LongInt; |
|
407 |
begin |
|
408 |
dm:= (V4.y - V3.y) * (V2.x - V1.x) - (V4.x - V3.x) * (V2.y - V1.y); |
|
409 |
c1:= (V4.x - V3.x) * (V1.y - V3.y) - (V4.y - V3.y) * (V1.x - V3.x); |
|
410 |
if dm = 0 then exit(false); |
|
411 |
||
412 |
c2:= (V2.x - V3.x) * (V1.y - V3.y) - (V2.y - V3.y) * (V1.x - V3.x); |
|
413 |
if dm > 0 then |
|
414 |
begin |
|
415 |
if (c1 < 0) or (c1 > dm) then exit(false); |
|
416 |
if (c2 < 0) or (c2 > dm) then exit(false) |
|
417 |
end else |
|
418 |
begin |
|
419 |
if (c1 > 0) or (c1 < dm) then exit(false); |
|
420 |
if (c2 > 0) or (c2 < dm) then exit(false) |
|
421 |
end; |
|
422 |
||
423 |
//AddFileLog('1 (' + inttostr(V1.x) + ',' + inttostr(V1.y) + ')x(' + inttostr(V2.x) + ',' + inttostr(V2.y) + ')'); |
|
424 |
//AddFileLog('2 (' + inttostr(V3.x) + ',' + inttostr(V3.y) + ')x(' + inttostr(V4.x) + ',' + inttostr(V4.y) + ')'); |
|
425 |
CheckIntersect:= true |
|
426 |
end; |
|
427 |
||
428 |
function CheckSelfIntersect(var pa: TPixAr; ind: Longword): boolean; |
|
429 |
var i: Longword; |
|
430 |
begin |
|
431 |
if (ind <= 0) or (ind >= Pred(pa.Count)) then exit(false); |
|
432 |
for i:= 1 to pa.Count - 3 do |
|
433 |
if (i <= ind - 1) or (i >= ind + 2) then |
|
434 |
begin |
|
435 |
if (i <> ind - 1) and |
|
436 |
CheckIntersect(pa.ar[ind], pa.ar[ind - 1], pa.ar[i], pa.ar[i - 1]) then exit(true); |
|
437 |
if (i <> ind + 2) and |
|
438 |
CheckIntersect(pa.ar[ind], pa.ar[ind + 1], pa.ar[i], pa.ar[i - 1]) then exit(true); |
|
439 |
end; |
|
440 |
CheckSelfIntersect:= false |
|
441 |
end; |
|
442 |
||
429 | 443 |
procedure RandomizePoints(var pa: TPixAr); |
364 | 444 |
const cEdge = 55; |
561 | 445 |
cMinDist = 8; |
371 | 446 |
var radz: array[0..Pred(cMaxEdgePoints)] of LongInt; |
561 | 447 |
i, k, dist, px, py: LongInt; |
364 | 448 |
begin |
449 |
radz[0]:= 0; |
|
450 |
for i:= 0 to Pred(pa.Count) do |
|
451 |
with pa.ar[i] do |
|
365 | 452 |
if x <> NTPX then |
453 |
begin |
|
1760 | 454 |
radz[i]:= Min(Max(x - cEdge, 0), Max(LAND_WIDTH - cEdge - x, 0)); |
455 |
radz[i]:= Min(radz[i], Min(Max(y - cEdge, 0), Max(LAND_HEIGHT - cEdge - y, 0))); |
|
365 | 456 |
if radz[i] > 0 then |
457 |
for k:= 0 to Pred(i) do |
|
364 | 458 |
begin |
429 | 459 |
dist:= Max(abs(x - pa.ar[k].x), abs(y - pa.ar[k].y)); |
365 | 460 |
radz[k]:= Max(0, Min((dist - cMinDist) div 2, radz[k])); |
461 |
radz[i]:= Max(0, Min(dist - radz[k] - cMinDist, radz[i])) |
|
462 |
end |
|
463 |
end; |
|
364 | 464 |
|
465 |
for i:= 0 to Pred(pa.Count) do |
|
466 |
with pa.ar[i] do |
|
1753 | 467 |
if ((x and LAND_WIDTH_MASK) = 0) and ((y and LAND_HEIGHT_MASK) = 0) then |
364 | 468 |
begin |
561 | 469 |
px:= x; |
470 |
py:= y; |
|
371 | 471 |
x:= x + LongInt(GetRandom(7) - 3) * (radz[i] * 5 div 7) div 3; |
561 | 472 |
y:= y + LongInt(GetRandom(7) - 3) * (radz[i] * 5 div 7) div 3; |
473 |
if CheckSelfIntersect(pa, i) then |
|
474 |
begin |
|
475 |
x:= px; |
|
476 |
y:= py |
|
477 |
end; |
|
364 | 478 |
end |
67 | 479 |
end; |
480 |
||
364 | 481 |
|
23 | 482 |
procedure GenBlank(var Template: TEdgeTemplate); |
4 | 483 |
var pa: TPixAr; |
23 | 484 |
i: Longword; |
155
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
485 |
y, x: Longword; |
4 | 486 |
begin |
1760 | 487 |
for y:= 0 to LAND_HEIGHT - 1 do |
488 |
for x:= 0 to LAND_WIDTH - 1 do |
|
155
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
489 |
Land[y, x]:= COLOR_LAND; |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
490 |
|
358 | 491 |
SetPoints(Template, pa); |
429 | 492 |
for i:= 1 to Template.BezierizeCount do |
493 |
begin |
|
431 | 494 |
BezierizeEdge(pa, _0_5); |
561 | 495 |
RandomizePoints(pa); |
429 | 496 |
RandomizePoints(pa) |
497 |
end; |
|
498 |
for i:= 1 to Template.RandPassesCount do RandomizePoints(pa); |
|
365 | 499 |
BezierizeEdge(pa, _0_1); |
27 | 500 |
|
365 | 501 |
DrawEdge(pa, 0); |
27 | 502 |
|
358 | 503 |
with Template do |
23 | 504 |
for i:= 0 to pred(FillPointsCount) do |
505 |
with FillPoints^[i] do |
|
89 | 506 |
FillLand(x, y); |
507 |
||
1773 | 508 |
DrawEdge(pa, COLOR_LAND); |
509 |
||
1792 | 510 |
MaxHedgehogs:= Template.MaxHedgehogs; |
1776 | 511 |
hasGirders:= Template.hasGirders; |
512 |
playHeight:= Template.TemplateHeight; |
|
513 |
playWidth:= Template.TemplateWidth; |
|
514 |
leftX:= ((LAND_WIDTH - playWidth) div 2); |
|
515 |
rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1; |
|
516 |
topY:= LAND_HEIGHT - playHeight; |
|
517 |
||
1797 | 518 |
// force to only cavern even if a cavern map is invertable if cTemplateFilter = 4 ? |
1773 | 519 |
if (Template.canInvert and (getrandom(2) = 0)) or |
520 |
(not Template.canInvert and Template.isNegative) then |
|
1776 | 521 |
begin |
522 |
hasBorder:= true; |
|
1773 | 523 |
for y:= 0 to LAND_HEIGHT - 1 do |
524 |
for x:= 0 to LAND_WIDTH - 1 do |
|
1776 | 525 |
if (y < topY) or (x < leftX) or (x > rightX) then |
526 |
Land[y, x]:= 0 |
|
527 |
else |
|
528 |
begin |
|
529 |
if Land[y, x] = 0 then |
|
530 |
Land[y, x]:= COLOR_LAND |
|
531 |
else if Land[y, x] = COLOR_LAND then |
|
532 |
Land[y, x]:= 0; |
|
533 |
end; |
|
534 |
end; |
|
23 | 535 |
end; |
536 |
||
371 | 537 |
function SelectTemplate: LongInt; |
161 | 538 |
begin |
1797 | 539 |
case cTemplateFilter of |
540 |
0: begin |
|
541 |
SelectTemplate:= getrandom(Succ(High(EdgeTemplates))); |
|
542 |
end; |
|
543 |
1: begin |
|
544 |
SelectTemplate:= SmallTemplates[getrandom(Succ(High(SmallTemplates)))]; |
|
545 |
end; |
|
546 |
2: begin |
|
547 |
SelectTemplate:= MediumTemplates[getrandom(Succ(High(MediumTemplates)))]; |
|
548 |
end; |
|
549 |
3: begin |
|
550 |
SelectTemplate:= LargeTemplates[getrandom(Succ(High(LargeTemplates)))]; |
|
551 |
end; |
|
552 |
4: begin |
|
553 |
SelectTemplate:= CavernTemplates[getrandom(Succ(High(CavernTemplates)))]; |
|
554 |
end; |
|
555 |
5: begin |
|
556 |
SelectTemplate:= WackyTemplates[getrandom(Succ(High(WackyTemplates)))]; |
|
557 |
end; |
|
558 |
end; |
|
559 |
WriteLnToConsole('Selected template #'+inttostr(SelectTemplate)+' using filter #'+inttostr(cTemplateFilter)); |
|
161 | 560 |
end; |
561 |
||
1182
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
562 |
procedure LandSurface2LandPixels(Surface: PSDL_Surface); |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
563 |
var x, y: LongInt; |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
564 |
p: PLongwordArray; |
1180
e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1085
diff
changeset
|
565 |
begin |
1182
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
566 |
TryDo(Surface <> nil, 'Assert (LandSurface <> nil) failed', true); |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
567 |
|
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
568 |
if SDL_MustLock(Surface) then |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
569 |
SDLTry(SDL_LockSurface(Surface) >= 0, true); |
1180
e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1085
diff
changeset
|
570 |
|
1182
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
571 |
p:= Surface^.pixels; |
1760 | 572 |
for y:= 0 to LAND_HEIGHT - 1 do |
1182
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
573 |
begin |
1760 | 574 |
for x:= 0 to LAND_WIDTH - 1 do |
1182
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
575 |
if Land[y, x] <> 0 then LandPixels[y, x]:= p^[x] or $FF000000; |
1760 | 576 |
|
1182
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
577 |
p:= @(p^[Surface^.pitch div 4]); |
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
578 |
end; |
1180
e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1085
diff
changeset
|
579 |
|
1182
e2e13aa055c1
Step 3: Maps are rendered correctly, but without objects yet
unc0rr
parents:
1181
diff
changeset
|
580 |
if SDL_MustLock(Surface) then |
1753 | 581 |
SDL_UnlockSurface(Surface); |
1754 | 582 |
end; |
583 |
||
584 |
procedure GenLandSurface; |
|
585 |
var tmpsurf: PSDL_Surface; |
|
586 |
begin |
|
587 |
WriteLnToConsole('Generating land...'); |
|
588 |
||
589 |
GenBlank(EdgeTemplates[SelectTemplate]); |
|
590 |
||
591 |
AddProgress; |
|
592 |
||
1760 | 593 |
tmpsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, LAND_WIDTH, LAND_HEIGHT, 32, RMask, GMask, BMask, 0); |
1754 | 594 |
|
595 |
TryDo(tmpsurf <> nil, 'Error creating pre-land surface', true); |
|
596 |
ColorizeLand(tmpsurf); |
|
597 |
AddOnLandObjects(tmpsurf); |
|
598 |
||
599 |
LandSurface2LandPixels(tmpsurf); |
|
600 |
SDL_FreeSurface(tmpsurf); |
|
601 |
||
602 |
AddProgress; |
|
603 |
||
604 |
AddProgress |
|
605 |
end; |
|
606 |
||
607 |
procedure MakeFortsMap; |
|
608 |
var tmpsurf: PSDL_Surface; |
|
609 |
begin |
|
1784 | 610 |
// For now, defining a fort's playable area as 3072x1200 - there are no tall forts. The extra height is to avoid triggering border with current code, also if user turns on a border, it'll give a bit more maneuvering room. |
611 |
playHeight:= 1200; |
|
612 |
playWidth:= 3072; |
|
1776 | 613 |
leftX:= (LAND_WIDTH - playWidth) div 2; |
614 |
rightX:= ((playWidth + (LAND_WIDTH - playWidth) div 2) - 1); |
|
615 |
topY:= LAND_HEIGHT - playHeight; |
|
616 |
||
1754 | 617 |
WriteLnToConsole('Generating forts land...'); |
618 |
||
619 |
tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[0]^.Teams[0]^.FortName + 'L', true, true, true); |
|
1784 | 620 |
BlitImageAndGenerateCollisionInfo(leftX+150, LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf); |
1754 | 621 |
SDL_FreeSurface(tmpsurf); |
622 |
||
623 |
tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[1]^.Teams[0]^.FortName + 'R', true, true, true); |
|
1784 | 624 |
BlitImageAndGenerateCollisionInfo(rightX - 150 - tmpsurf^.w, LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf); |
1754 | 625 |
SDL_FreeSurface(tmpsurf); |
626 |
end; |
|
627 |
||
1792 | 628 |
// Hi unC0Rr. |
629 |
// This is a function that Tiy assures me would not be good for gameplay. |
|
630 |
// It allows the setting of arbitrary portions of landscape as indestructible, or regular, or even blank. |
|
631 |
// He said I could add it here only when I swore it wouldn't impact gameplay. Which, as far as I can tell, is true. |
|
632 |
// I'd just like to play with it with my friends if you don't mind. |
|
633 |
// Can allow for amusing maps. |
|
634 |
procedure LoadMask; |
|
635 |
var tmpsurf: PSDL_Surface; |
|
636 |
p: PLongwordArray; |
|
637 |
x, y, cpX, cpY: Longword; |
|
638 |
begin |
|
639 |
tmpsurf:= LoadImage(Pathz[ptMapCurrent] + '/mask', true, false, true); |
|
640 |
if (tmpsurf <> nil) and (tmpsurf^.w <= LAND_WIDTH) and (tmpsurf^.h <= LAND_HEIGHT) and (tmpsurf^.format^.BytesPerPixel = 4) then |
|
641 |
begin |
|
642 |
cpX:= (LAND_WIDTH - tmpsurf^.w) div 2; |
|
643 |
cpY:= LAND_HEIGHT - tmpsurf^.h; |
|
644 |
if SDL_MustLock(tmpsurf) then |
|
645 |
SDLTry(SDL_LockSurface(tmpsurf) >= 0, true); |
|
646 |
||
647 |
p:= tmpsurf^.pixels; |
|
648 |
for y:= 0 to Pred(tmpsurf^.h) do |
|
649 |
begin |
|
650 |
for x:= 0 to Pred(tmpsurf^.w) do |
|
1849 | 651 |
begin |
652 |
if (($FF000000 and p^[x]) = 0) then // Tiy was having trouble generating transparent black |
|
653 |
Land[cpY + y, cpX + x]:= 0 |
|
654 |
else |
|
655 |
Land[cpY + y, cpX + x]:= p^[x]; |
|
656 |
end; |
|
1792 | 657 |
p:= @(p^[tmpsurf^.pitch div 4]); |
658 |
end; |
|
659 |
||
660 |
if SDL_MustLock(tmpsurf) then |
|
661 |
SDL_UnlockSurface(tmpsurf); |
|
662 |
SDL_FreeSurface(tmpsurf); |
|
663 |
end; |
|
664 |
end; |
|
665 |
||
1754 | 666 |
procedure LoadMap; |
667 |
var tmpsurf: PSDL_Surface; |
|
1795 | 668 |
s: string; |
669 |
f: textfile; |
|
1754 | 670 |
begin |
671 |
WriteLnToConsole('Loading land from file...'); |
|
672 |
AddProgress; |
|
673 |
tmpsurf:= LoadImage(Pathz[ptMapCurrent] + '/map', true, true, true); |
|
1760 | 674 |
TryDo((tmpsurf^.w <= LAND_WIDTH) and (tmpsurf^.h <= LAND_HEIGHT), 'Map dimensions too big!', true); |
1754 | 675 |
|
1792 | 676 |
// unC0Rr - should this be passed from the GUI? I'm not sure which layer does what |
677 |
s:= Pathz[ptMapCurrent] + '/map.cfg'; |
|
678 |
WriteLnToConsole('Fetching map HH limit'); |
|
679 |
Assign(f, s); |
|
680 |
Reset(f); |
|
1795 | 681 |
Readln(f); |
682 |
if not eof(f) then Readln(f, MaxHedgehogs); |
|
683 |
||
1792 | 684 |
if(MaxHedgehogs = 0) then MaxHedgehogs:= 18; |
685 |
||
1776 | 686 |
playHeight:= tmpsurf^.h; |
687 |
playWidth:= tmpsurf^.w; |
|
688 |
leftX:= (LAND_WIDTH - playWidth) div 2; |
|
689 |
rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1; |
|
690 |
topY:= LAND_HEIGHT - playHeight; |
|
691 |
||
1754 | 692 |
TryDo(tmpsurf^.format^.BytesPerPixel = 4, 'Map should be 32bit', true); |
693 |
||
1772 | 694 |
BlitImageAndGenerateCollisionInfo( |
695 |
(LAND_WIDTH - tmpsurf^.w) div 2, |
|
696 |
LAND_HEIGHT - tmpsurf^.h, |
|
697 |
tmpsurf^.w, |
|
698 |
tmpsurf); |
|
1754 | 699 |
SDL_FreeSurface(tmpsurf); |
1792 | 700 |
|
701 |
LoadMask; |
|
1754 | 702 |
end; |
703 |
||
704 |
procedure GenMap; |
|
1784 | 705 |
var x, y, w, c: Longword; |
1754 | 706 |
begin |
1776 | 707 |
hasBorder:= false; |
708 |
hasGirders:= true; |
|
1754 | 709 |
LoadThemeConfig; |
710 |
||
711 |
if (GameFlags and gfForts) = 0 then |
|
712 |
if Pathz[ptMapCurrent] <> '' then LoadMap |
|
713 |
else GenLandSurface |
|
714 |
else MakeFortsMap; |
|
715 |
AddProgress; |
|
1760 | 716 |
|
1754 | 717 |
{$IFDEF DEBUGFILE}LogLandDigest;{$ENDIF} |
1753 | 718 |
|
1768 | 719 |
// check for land near top |
1784 | 720 |
c:= 0; |
721 |
if (GameFlags and gfBorder) <> 0 then |
|
722 |
hasBorder:= true |
|
723 |
else |
|
724 |
for y:= topY to topY + 5 do |
|
725 |
for x:= leftX to rightX do |
|
726 |
if Land[y, x] <> 0 then |
|
727 |
begin |
|
728 |
inc(c); |
|
729 |
if c > 200 then // avoid accidental triggering |
|
730 |
begin |
|
731 |
hasBorder:= true; |
|
732 |
break; |
|
733 |
end; |
|
734 |
end; |
|
1768 | 735 |
|
1776 | 736 |
if hasBorder then |
1768 | 737 |
begin |
1784 | 738 |
for y:= 0 to LAND_HEIGHT - 1 do |
739 |
for x:= 0 to LAND_WIDTH - 1 do |
|
740 |
if (y < topY) or (x < leftX) or (x > rightX) then |
|
741 |
Land[y, x]:= COLOR_INDESTRUCTIBLE; |
|
1768 | 742 |
// experiment hardcoding cave |
1784 | 743 |
// also try basing cave dimensions on map/template dimensions, if they exist |
744 |
for w:= 0 to 5 do // width of 3 allowed worms to be knocked through with grenade |
|
745 |
begin |
|
746 |
for y:= topY to LAND_HEIGHT - 1 do |
|
747 |
begin |
|
748 |
Land[y, leftX + w]:= COLOR_INDESTRUCTIBLE; |
|
749 |
Land[y, rightX - w]:= COLOR_INDESTRUCTIBLE; |
|
750 |
if (y + w) mod 32 < 16 then |
|
751 |
c:= $FF000000 |
|
752 |
else |
|
753 |
c:= $FF00FFFF; |
|
754 |
LandPixels[y, leftX + w]:= c; |
|
755 |
LandPixels[y, rightX - w]:= c; |
|
756 |
end; |
|
1768 | 757 |
|
1784 | 758 |
for x:= leftX to rightX do |
759 |
begin |
|
760 |
Land[topY + w, x]:= COLOR_INDESTRUCTIBLE; |
|
761 |
if (x + w) mod 32 < 16 then |
|
762 |
c:= $FF000000 |
|
763 |
else |
|
764 |
c:= $FF00FFFF; |
|
765 |
LandPixels[topY + w, x]:= c; |
|
766 |
end; |
|
767 |
end; |
|
1768 | 768 |
end; |
769 |
||
1776 | 770 |
if ((GameFlags and gfForts) = 0) and (Pathz[ptMapCurrent] = '') then AddObjects; |
771 |
||
1807 | 772 |
UpdateLandTexture(0, LAND_WIDTH, 0, LAND_HEIGHT); |
37 | 773 |
end; |
774 |
||
566 | 775 |
function GenPreview: TPreview; |
371 | 776 |
var x, y, xx, yy, t, bit: LongInt; |
566 | 777 |
Preview: TPreview; |
155
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
778 |
begin |
160 | 779 |
WriteLnToConsole('Generating preview...'); |
161 | 780 |
GenBlank(EdgeTemplates[SelectTemplate]); |
155
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
781 |
|
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
782 |
for y:= 0 to 127 do |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
783 |
for x:= 0 to 31 do |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
784 |
begin |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
785 |
Preview[y, x]:= 0; |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
786 |
for bit:= 0 to 7 do |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
787 |
begin |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
788 |
t:= 0; |
1760 | 789 |
for yy:= y * (LAND_HEIGHT div 128) to y * (LAND_HEIGHT div 128) + 7 do |
790 |
for xx:= x * (LAND_WIDTH div 32) + bit * 8 to x * (LAND_WIDTH div 32) + bit * 8 + 7 do |
|
155
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
791 |
if Land[yy, xx] <> 0 then inc(t); |
351 | 792 |
if t > 8 then Preview[y, x]:= Preview[y, x] or ($80 shr bit) |
155
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
793 |
end |
566 | 794 |
end; |
1768 | 795 |
GenPreview:= Preview |
155
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
796 |
end; |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
797 |
|
51 | 798 |
initialization |
799 |
||
4 | 800 |
end. |