author  nemo 
Wed, 03 Feb 2010 04:18:28 +0000  
changeset 2741  7a84ce33f52f 
parent 2733  52a5a160566f 
child 2948  3f21a9dc93d0 
permissions  rwrr 
393  1 
(* 
1066  2 
* Hedgewars, a free turn based strategy game 
883  3 
* Copyright (c) 20052008 Andrey Korotaev <unC0Rr@gmail.com> 
393  4 
* 
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 

8 
* 

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. 

13 
* 

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 021111307, USA 

17 
*) 

18 

2630  19 
{$INCLUDE "options.inc"} 
20 

184  21 
unit uLandGraphics; 
22 
interface 

409  23 
uses uFloat, uConsts; 
184  24 

25 
type PRangeArray = ^TRangeArray; 

26 
TRangeArray = array[0..31] of record 

371  27 
Left, Right: LongInt; 
184  28 
end; 
29 

2716
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2695
diff
changeset

30 
function SweepDirty: boolean; 
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2695
diff
changeset

31 
function Despeckle(X, Y: LongInt): boolean; 
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2695
diff
changeset

32 
function CheckLandValue(X, Y: LongInt; Color: Word): boolean; 
371  33 
procedure DrawExplosion(X, Y, Radius: LongInt); 
34 
procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte); 

35 
procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt); 

36 
procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword); 

511  37 
procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet: boolean); 
184  38 

520  39 
function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean): boolean; 
409  40 

184  41 
implementation 
1806  42 
uses SDLh, uMisc, uLand, uLandTexture; 
184  43 

371  44 
procedure FillCircleLines(x, y, dx, dy: LongInt; Value: Longword); 
45 
var i: LongInt; 

184  46 
begin 
1753  47 
if ((y + dy) and LAND_HEIGHT_MASK) = 0 then 
2376  48 
for i:= max(x  dx, 0) to min(x + dx, LAND_WIDTH  1) do 
1753  49 
if Land[y + dy, i] <> COLOR_INDESTRUCTIBLE then 
50 
Land[y + dy, i]:= Value; 

51 
if ((y  dy) and LAND_HEIGHT_MASK) = 0 then 

2376  52 
for i:= max(x  dx, 0) to min(x + dx, LAND_WIDTH  1) do 
1753  53 
if Land[y  dy, i] <> COLOR_INDESTRUCTIBLE then 
54 
Land[y  dy, i]:= Value; 

55 
if ((y + dx) and LAND_HEIGHT_MASK) = 0 then 

2376  56 
for i:= max(x  dy, 0) to min(x + dy, LAND_WIDTH  1) do 
1753  57 
if Land[y + dx, i] <> COLOR_INDESTRUCTIBLE then 
58 
Land[y + dx, i]:= Value; 

59 
if ((y  dx) and LAND_HEIGHT_MASK) = 0 then 

2376  60 
for i:= max(x  dy, 0) to min(x + dy, LAND_WIDTH  1) do 
1753  61 
if Land[y  dx, i] <> COLOR_INDESTRUCTIBLE then 
62 
Land[y  dx, i]:= Value; 

184  63 
end; 
64 

511  65 
procedure ChangeCircleLines(x, y, dx, dy: LongInt; doSet: boolean); 
504
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

66 
var i: LongInt; 
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

67 
begin 
511  68 
if not doSet then 
69 
begin 

1753  70 
if ((y + dy) and LAND_HEIGHT_MASK) = 0 then 
1760  71 
for i:= max(x  dx, 0) to min(x + dx, LAND_WIDTH  1) do 
1861  72 
if (Land[y + dy, i] > 0) and (Land[y + dy, i] < 256) then dec(Land[y + dy, i]); // check > 0 because explosion can erase collision data 
1753  73 
if ((y  dy) and LAND_HEIGHT_MASK) = 0 then 
1760  74 
for i:= max(x  dx, 0) to min(x + dx, LAND_WIDTH  1) do 
1861  75 
if (Land[y  dy, i] > 0) and (Land[y  dy, i] < 256) then dec(Land[y  dy, i]); 
1753  76 
if ((y + dx) and LAND_HEIGHT_MASK) = 0 then 
1760  77 
for i:= max(x  dy, 0) to min(x + dy, LAND_WIDTH  1) do 
1861  78 
if (Land[y + dx, i] > 0) and (Land[y + dx, i] < 256) then dec(Land[y + dx, i]); 
1753  79 
if ((y  dx) and LAND_HEIGHT_MASK) = 0 then 
1760  80 
for i:= max(x  dy, 0) to min(x + dy, LAND_WIDTH  1) do 
1861  81 
if (Land[y  dx, i] > 0) and (Land[y  dx, i] < 256) then dec(Land[y  dx, i]); 
511  82 
end else 
83 
begin 

1753  84 
if ((y + dy) and LAND_HEIGHT_MASK) = 0 then 
2376  85 
for i:= max(x  dx, 0) to min(x + dx, LAND_WIDTH  1) do 
1861  86 
if (Land[y + dy, i] < 256) then 
87 
inc(Land[y + dy, i]); 

1753  88 
if ((y  dy) and LAND_HEIGHT_MASK) = 0 then 
2376  89 
for i:= max(x  dx, 0) to min(x + dx, LAND_WIDTH  1) do 
1861  90 
if (Land[y  dy, i] < 256) then 
91 
inc(Land[y  dy, i]); 

1753  92 
if ((y + dx) and LAND_HEIGHT_MASK) = 0 then 
1861  93 
for i:= max(x  dy, 0) to min(x + dy, LAND_WIDTH  1) do 
94 
if (Land[y + dx, i] < 256) then 

95 
inc(Land[y + dx, i]); 

1753  96 
if ((y  dx) and LAND_HEIGHT_MASK) = 0 then 
1861  97 
for i:= max(x  dy, 0) to min(x + dy, LAND_WIDTH  1) do 
98 
if (Land[y  dx, i] < 256) then 

99 
inc(Land[y  dx, i]); 

511  100 
end 
504
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

101 
end; 
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

102 

371  103 
procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword); 
104 
var dx, dy, d: LongInt; 

184  105 
begin 
106 
dx:= 0; 

107 
dy:= Radius; 

108 
d:= 3  2 * Radius; 

109 
while (dx < dy) do 

110 
begin 

111 
FillCircleLines(x, y, dx, dy, Value); 

112 
if (d < 0) 

113 
then d:= d + 4 * dx + 6 

114 
else begin 

115 
d:= d + 4 * (dx  dy) + 10; 

116 
dec(dy) 

117 
end; 

118 
inc(dx) 

119 
end; 

120 
if (dx = dy) then FillCircleLines(x, y, dx, dy, Value); 

121 
end; 

122 

511  123 
procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet: boolean); 
504
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

124 
var dx, dy, d: LongInt; 
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

125 
begin 
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

126 
dx:= 0; 
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

127 
dy:= Radius; 
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

128 
d:= 3  2 * Radius; 
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

129 
while (dx < dy) do 
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

130 
begin 
511  131 
ChangeCircleLines(x, y, dx, dy, doSet); 
504
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

132 
if (d < 0) 
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

133 
then d:= d + 4 * dx + 6 
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

134 
else begin 
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

135 
d:= d + 4 * (dx  dy) + 10; 
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

136 
dec(dy) 
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

137 
end; 
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

138 
inc(dx) 
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

139 
end; 
511  140 
if (dx = dy) then ChangeCircleLines(x, y, dx, dy, doSet) 
504
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

141 
end; 
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset

142 

2603  143 
procedure FillLandCircleLines0(x, y, dx, dy: LongInt); 
371  144 
var i: LongInt; 
184  145 
begin 
1753  146 
if ((y + dy) and LAND_HEIGHT_MASK) = 0 then 
2376  147 
for i:= max(x  dx, 0) to min(x + dx, LAND_WIDTH  1) do 
2647  148 
if (Land[y + dy, i] <> COLOR_INDESTRUCTIBLE) then 
2603  149 
LandPixels[y + dy, i]:= 0; 
1753  150 
if ((y  dy) and LAND_HEIGHT_MASK) = 0 then 
2376  151 
for i:= max(x  dx, 0) to min(x + dx, LAND_WIDTH  1) do 
2647  152 
if (Land[y  dy, i] <> COLOR_INDESTRUCTIBLE) then 
2603  153 
LandPixels[y  dy, i]:= 0; 
1753  154 
if ((y + dx) and LAND_HEIGHT_MASK) = 0 then 
2376  155 
for i:= max(x  dy, 0) to min(x + dy, LAND_WIDTH  1) do 
2647  156 
if (Land[y + dx, i] <> COLOR_INDESTRUCTIBLE) then 
2603  157 
LandPixels[y + dx, i]:= 0; 
1753  158 
if ((y  dx) and LAND_HEIGHT_MASK) = 0 then 
2376  159 
for i:= max(x  dy, 0) to min(x + dy, LAND_WIDTH  1) do 
2647  160 
if (Land[y  dx, i] <> COLOR_INDESTRUCTIBLE) then 
2603  161 
LandPixels[y  dx, i]:= 0; 
184  162 
end; 
163 

2647  164 
procedure FillLandCircleLinesBG(x, y, dx, dy: LongInt); 
165 
var i: LongInt; 

166 
begin 

167 
if ((y + dy) and LAND_HEIGHT_MASK) = 0 then 

168 
for i:= max(x  dx, 0) to min(x + dx, LAND_WIDTH  1) do 

169 
if (Land[y + dy, i] = COLOR_LAND) then 

170 
LandPixels[y + dy, i]:= LandBackPixel(i, y + dy) 

171 
else 

172 
if (Land[y + dy, i] = COLOR_OBJECT) then LandPixels[y + dy, i]:= 0; 

173 
if ((y  dy) and LAND_HEIGHT_MASK) = 0 then 

174 
for i:= max(x  dx, 0) to min(x + dx, LAND_WIDTH  1) do 

175 
if (Land[y  dy, i] = COLOR_LAND) then 

176 
LandPixels[y  dy, i]:= LandBackPixel(i, y  dy) 

177 
else 

178 
if (Land[y  dy, i] = COLOR_OBJECT) then LandPixels[y  dy, i]:= 0; 

179 
if ((y + dx) and LAND_HEIGHT_MASK) = 0 then 

180 
for i:= max(x  dy, 0) to min(x + dy, LAND_WIDTH  1) do 

181 
if (Land[y + dx, i] = COLOR_LAND) then 

182 
LandPixels[y + dx, i]:= LandBackPixel(i, y + dx) 

183 
else 

184 
if (Land[y + dx, i] = COLOR_OBJECT) then LandPixels[y + dx, i]:= 0; 

185 
if ((y  dx) and LAND_HEIGHT_MASK) = 0 then 

186 
for i:= max(x  dy, 0) to min(x + dy, LAND_WIDTH  1) do 

187 
if (Land[y  dx, i] = COLOR_LAND) then 

188 
LandPixels[y  dx, i]:= LandBackPixel(i, y  dx) 

189 
else 

190 
if (Land[y  dx, i] = COLOR_OBJECT) then LandPixels[y  dx, i]:= 0; 

191 
end; 

192 

371  193 
procedure FillLandCircleLinesEBC(x, y, dx, dy: LongInt); 
194 
var i: LongInt; 

184  195 
begin 
1753  196 
if ((y + dy) and LAND_HEIGHT_MASK) = 0 then 
1760  197 
for i:= max(x  dx, 0) to min(x + dx, LAND_WIDTH  1) do 
2647  198 
if (Land[y + dy, i] = COLOR_LAND) or (Land[y + dy, i] = COLOR_OBJECT) then 
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

199 
begin 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

200 
LandPixels[y + dy, i]:= cExplosionBorderColor; 
2647  201 
Despeckle(i, y + dy); 
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

202 
LandDirty[(y + dy) div 32, i div 32]:= 1; 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

203 
end; 
1753  204 
if ((y  dy) and LAND_HEIGHT_MASK) = 0 then 
1760  205 
for i:= max(x  dx, 0) to min(x + dx, LAND_WIDTH  1) do 
2647  206 
if (Land[y  dy, i] = COLOR_LAND) or (Land[y  dy, i] = COLOR_OBJECT) then 
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

207 
begin 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

208 
LandPixels[y  dy, i]:= cExplosionBorderColor; 
2647  209 
Despeckle(i, y  dy); 
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

210 
LandDirty[(y  dy) div 32, i div 32]:= 1; 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

211 
end; 
1753  212 
if ((y + dx) and LAND_HEIGHT_MASK) = 0 then 
1760  213 
for i:= max(x  dy, 0) to min(x + dy, LAND_WIDTH  1) do 
2647  214 
if (Land[y + dx, i] = COLOR_LAND) or (Land[y + dx, i] = COLOR_OBJECT) then 
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

215 
begin 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

216 
LandPixels[y + dx, i]:= cExplosionBorderColor; 
2647  217 
Despeckle(i, y + dx); 
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

218 
LandDirty[(y + dx) div 32, i div 32]:= 1; 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

219 
end; 
1753  220 
if ((y  dx) and LAND_HEIGHT_MASK) = 0 then 
1760  221 
for i:= max(x  dy, 0) to min(x + dy, LAND_WIDTH  1) do 
2647  222 
if (Land[y  dx, i] = COLOR_LAND) or (Land[y  dx, i] = COLOR_OBJECT) then 
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

223 
begin 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

224 
LandPixels[y  dx, i]:= cExplosionBorderColor; 
2647  225 
Despeckle(i, y  dy); 
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

226 
LandDirty[(y  dx) div 32, i div 32]:= 1; 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

227 
end; 
184  228 
end; 
229 

371  230 
procedure DrawExplosion(X, Y, Radius: LongInt); 
2603  231 
var dx, dy, ty, tx, d: LongInt; 
184  232 
begin 
2647  233 

234 
// draw background land texture 

235 
begin 

236 
dx:= 0; 

237 
dy:= Radius; 

238 
d:= 3  2 * Radius; 

239 

240 
while (dx < dy) do 

241 
begin 

242 
FillLandCircleLinesBG(x, y, dx, dy); 

243 
if (d < 0) 

244 
then d:= d + 4 * dx + 6 

245 
else begin 

246 
d:= d + 4 * (dx  dy) + 10; 

247 
dec(dy) 

248 
end; 

249 
inc(dx) 

250 
end; 

251 
if (dx = dy) then FillLandCircleLinesBG(x, y, dx, dy); 

252 
end; 

253 

254 
// draw a hole in land 

2733  255 
if Radius > 20 then 
2647  256 
begin 
257 
dx:= 0; 

2733  258 
dy:= Radius  15; 
2647  259 
d:= 3  2 * dy; 
260 

261 
while (dx < dy) do 

262 
begin 

263 
FillLandCircleLines0(x, y, dx, dy); 

264 
if (d < 0) 

265 
then d:= d + 4 * dx + 6 

266 
else begin 

267 
d:= d + 4 * (dx  dy) + 10; 

268 
dec(dy) 

269 
end; 

270 
inc(dx) 

271 
end; 

272 
if (dx = dy) then FillLandCircleLines0(x, y, dx, dy); 

273 
end; 

274 

1849  275 
// FillRoundInLand after erasing land pixels to allow Land 0 check for mask.png to function 
2647  276 
FillRoundInLand(X, Y, Radius, 0); 
277 

278 
// draw explosion border 

279 
begin 

280 
inc(Radius, 4); 

281 
dx:= 0; 

282 
dy:= Radius; 

283 
d:= 3  2 * Radius; 

284 
while (dx < dy) do 

285 
begin 

286 
FillLandCircleLinesEBC(x, y, dx, dy); 

287 
if (d < 0) 

288 
then d:= d + 4 * dx + 6 

289 
else begin 

290 
d:= d + 4 * (dx  dy) + 10; 

291 
dec(dy) 

292 
end; 

293 
inc(dx) 

294 
end; 

295 
if (dx = dy) then FillLandCircleLinesEBC(x, y, dx, dy); 

296 
end; 

351  297 

1807  298 
tx:= max(X  Radius  1, 0); 
299 
dx:= min(X + Radius + 1, LAND_WIDTH)  tx; 

300 
ty:= max(Y  Radius  1, 0); 

301 
dy:= min(Y + Radius + 1, LAND_HEIGHT)  ty; 

302 
UpdateLandTexture(tx, dx, ty, dy) 

184  303 
end; 
304 

371  305 
procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte); 
184  306 
var tx, ty, i: LongInt; 
307 
begin 

308 
for i:= 0 to Pred(Count) do 

2647  309 
begin 
310 
for ty:= max(y  Radius, 0) to min(y + Radius, LAND_HEIGHT) do 

311 
for tx:= max(0, ar^[i].Left  Radius) to min(LAND_WIDTH, ar^[i].Right + Radius) do 

312 
if Land[ty, tx] = COLOR_LAND then 

313 
LandPixels[ty, tx]:= LandBackPixel(tx, ty) 

314 
else if Land[ty, tx] = COLOR_OBJECT then 

315 
LandPixels[ty, tx]:= 0; 

316 
inc(y, dY) 

317 
end; 

184  318 

319 
inc(Radius, 4); 

351  320 
dec(y, Count * dY); 
184  321 

322 
for i:= 0 to Pred(Count) do 

323 
begin 

1753  324 
for ty:= max(y  Radius, 0) to min(y + Radius, LAND_HEIGHT) do 
325 
for tx:= max(0, ar^[i].Left  Radius) to min(LAND_WIDTH, ar^[i].Right + Radius) do 

2647  326 
if (Land[ty, tx] = COLOR_LAND) or (Land[ty, tx] = COLOR_OBJECT) then 
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

327 
begin 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

328 
LandPixels[ty, tx]:= cExplosionBorderColor; 
2647  329 
LandDirty[(y + dy) shr 5, i shr 5]:= 1; 
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

330 
end; 
184  331 
inc(y, dY) 
332 
end; 

333 

818  334 

1807  335 
UpdateLandTexture(0, LAND_WIDTH, 0, LAND_HEIGHT) 
184  336 
end; 
337 

338 
// 

339 
//  (dX, dY)  direction, vector of length = 0.5 

340 
// 

371  341 
procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt); 
358  342 
var nx, ny, dX8, dY8: hwFloat; 
1809  343 
i, t, tx, ty, stX, stY, ddy, ddx: Longint; 
184  344 
begin // (dY, dX) is (dX, dY) rotated by PI/2 
772
e8d530ca77be
Don't update all land texture when drawing tunnel (saves video throughput)
unc0rr
parents:
769
diff
changeset

345 
stY:= hwRound(Y); 
1809  346 
stX:= hwRound(X); 
772
e8d530ca77be
Don't update all land texture when drawing tunnel (saves video throughput)
unc0rr
parents:
769
diff
changeset

347 

184  348 
nx:= X + dY * (HalfWidth + 8); 
349 
ny:= Y  dX * (HalfWidth + 8); 

350 

358  351 
dX8:= dX * 8; 
352 
dY8:= dY * 8; 

184  353 
for i:= 0 to 7 do 
354 
begin 

358  355 
X:= nx  dX8; 
356 
Y:= ny  dY8; 

184  357 
for t:= 8 to ticks + 8 do 
2666  358 
begin 
359 
X:= X + dX; 

360 
Y:= Y + dY; 

361 
tx:= hwRound(X); 

362 
ty:= hwRound(Y); 

363 
if ((ty and LAND_HEIGHT_MASK) = 0) and 

364 
((tx and LAND_WIDTH_MASK) = 0) and 

365 
((Land[ty, tx] = COLOR_LAND) or 

366 
(Land[ty, tx] = COLOR_OBJECT)) then 

367 
LandPixels[ty, tx]:= cExplosionBorderColor 

368 
end; 

184  369 
nx:= nx  dY; 
370 
ny:= ny + dX; 

371 
end; 

372 

373 
for i:= HalfWidth to HalfWidth do 

374 
begin 

358  375 
X:= nx  dX8; 
376 
Y:= ny  dY8; 

184  377 
for t:= 0 to 7 do 
2666  378 
begin 
379 
X:= X + dX; 

380 
Y:= Y + dY; 

381 
tx:= hwRound(X); 

382 
ty:= hwRound(Y); 

383 
if ((ty and LAND_HEIGHT_MASK) = 0) and 

384 
((tx and LAND_WIDTH_MASK) = 0) and 

385 
((Land[ty, tx] = COLOR_LAND) or 

386 
(Land[ty, tx] = COLOR_OBJECT)) then 

387 
LandPixels[ty, tx]:= cExplosionBorderColor 

388 
end; 

184  389 
X:= nx; 
390 
Y:= ny; 

391 
for t:= 0 to ticks do 

392 
begin 

393 
X:= X + dX; 

394 
Y:= Y + dY; 

351  395 
tx:= hwRound(X); 
396 
ty:= hwRound(Y); 

2741  397 
if ((ty and LAND_HEIGHT_MASK) = 0) and ((tx and LAND_WIDTH_MASK) = 0) and (Land[ty, tx] <> COLOR_INDESTRUCTIBLE) then 
2647  398 
begin 
399 
if Land[ty, tx] = COLOR_LAND then 

400 
LandPixels[ty, tx]:= LandBackPixel(tx, ty) 

401 
else if Land[ty, tx] = COLOR_OBJECT then 

402 
LandPixels[ty, tx]:= 0; 

403 
Land[ty, tx]:= 0; 

404 
end 

184  405 
end; 
406 
for t:= 0 to 7 do 

2666  407 
begin 
408 
X:= X + dX; 

409 
Y:= Y + dY; 

410 
tx:= hwRound(X); 

411 
ty:= hwRound(Y); 

412 
if ((ty and LAND_HEIGHT_MASK) = 0) and 

413 
((tx and LAND_WIDTH_MASK) = 0) and 

414 
((Land[ty, tx] = COLOR_LAND) or 

415 
(Land[ty, tx] = COLOR_OBJECT)) then 

416 
LandPixels[ty, tx]:= cExplosionBorderColor 

417 
end; 

184  418 
nx:= nx  dY; 
419 
ny:= ny + dX; 

420 
end; 

421 

422 
for i:= 0 to 7 do 

423 
begin 

358  424 
X:= nx  dX8; 
425 
Y:= ny  dY8; 

184  426 
for t:= 8 to ticks + 8 do 
2666  427 
begin 
428 
X:= X + dX; 

429 
Y:= Y + dY; 

430 
tx:= hwRound(X); 

431 
ty:= hwRound(Y); 

432 
if ((ty and LAND_HEIGHT_MASK) = 0) and 

433 
((tx and LAND_WIDTH_MASK) = 0) and 

434 
((Land[ty, tx] = COLOR_LAND) or 

435 
(Land[ty, tx] = COLOR_OBJECT)) then 

436 
LandPixels[ty, tx]:= cExplosionBorderColor 

437 
end; 

184  438 
nx:= nx  dY; 
439 
ny:= ny + dX; 

440 
end; 

441 

1809  442 
tx:= max(stX  HalfWidth * 2  4  abs(hwRound(dX * ticks)), 0); 
1807  443 
ty:= max(stY  HalfWidth * 2  4  abs(hwRound(dY * ticks)), 0); 
1809  444 
ddx:= min(stX + HalfWidth * 2 + 4 + abs(hwRound(dX * ticks)), LAND_WIDTH)  tx; 
445 
ddy:= min(stY + HalfWidth * 2 + 4 + abs(hwRound(dY * ticks)), LAND_HEIGHT)  ty; 

446 

447 
UpdateLandTexture(tx, ddx, ty, ddy) 

184  448 
end; 
449 

520  450 
function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean): boolean; 
2235  451 
var X, Y, bpp, h, w, row, col, numFramesFirstCol: LongInt; 
409  452 
p: PByteArray; 
769
788efc1d649f
 Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset

453 
Image: PSDL_Surface; 
409  454 
begin 
2235  455 
numFramesFirstCol:= SpritesData[Obj].imageHeight div SpritesData[Obj].Height; 
456 

769
788efc1d649f
 Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset

457 
TryDo(SpritesData[Obj].Surface <> nil, 'Assert SpritesData[Obj].Surface failed', true); 
788efc1d649f
 Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset

458 
Image:= SpritesData[Obj].Surface; 
409  459 
w:= SpritesData[Obj].Width; 
769
788efc1d649f
 Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset

460 
h:= SpritesData[Obj].Height; 
2235  461 
row:= Frame mod numFramesFirstCol; 
462 
col:= Frame div numFramesFirstCol; 

409  463 

464 
if SDL_MustLock(Image) then 

465 
SDLTry(SDL_LockSurface(Image) >= 0, true); 

466 

467 
bpp:= Image^.format^.BytesPerPixel; 

769
788efc1d649f
 Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset

468 
TryDo(bpp = 4, 'It should be 32 bpp sprite', true); 
788efc1d649f
 Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset

469 
// Check that sprite fits free space 
2236  470 
p:= @(PByteArray(Image^.pixels)^[ Image^.pitch * row * h + col * w * 4 ]); 
409  471 
case bpp of 
472 
4: for y:= 0 to Pred(h) do 

473 
begin 

474 
for x:= 0 to Pred(w) do 

475 
if PLongword(@(p^[x * 4]))^ <> 0 then 

1792  476 
if ((cpY + y) < Longint(topY)) or 
477 
((cpY + y) > LAND_HEIGHT) or 

478 
((cpX + x) < Longint(leftX)) or 

479 
((cpX + x) > Longint(rightX)) or 

409  480 
(Land[cpY + y, cpX + x] <> 0) then 
481 
begin 

482 
if SDL_MustLock(Image) then 

483 
SDL_UnlockSurface(Image); 

484 
exit(false) 

485 
end; 

486 
p:= @(p^[Image^.pitch]); 

487 
end; 

488 
end; 

489 

520  490 
TryPlaceOnLand:= true; 
769
788efc1d649f
 Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset

491 
if not doPlace then 
788efc1d649f
 Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset

492 
begin 
788efc1d649f
 Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset

493 
if SDL_MustLock(Image) then 
788efc1d649f
 Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset

494 
SDL_UnlockSurface(Image); 
788efc1d649f
 Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset

495 
exit 
788efc1d649f
 Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset

496 
end; 
520  497 

409  498 
// Checked, now place 
2236  499 
p:= @(PByteArray(Image^.pixels)^[ Image^.pitch * row * h + col * w * 4 ]); 
409  500 
case bpp of 
501 
4: for y:= 0 to Pred(h) do 

502 
begin 

503 
for x:= 0 to Pred(w) do 

769
788efc1d649f
 Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset

504 
if PLongword(@(p^[x * 4]))^ <> 0 then 
788efc1d649f
 Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset

505 
begin 
2647  506 
Land[cpY + y, cpX + x]:= COLOR_OBJECT; 
769
788efc1d649f
 Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset

507 
LandPixels[cpY + y, cpX + x]:= PLongword(@(p^[x * 4]))^ 
788efc1d649f
 Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset

508 
end; 
409  509 
p:= @(p^[Image^.pitch]); 
510 
end; 

511 
end; 

512 
if SDL_MustLock(Image) then 

513 
SDL_UnlockSurface(Image); 

514 

1807  515 
x:= max(cpX, leftX); 
516 
w:= min(cpX + Image^.w, LAND_WIDTH)  x; 

1792  517 
y:= max(cpY, topY); 
1753  518 
h:= min(cpY + Image^.h, LAND_HEIGHT)  y; 
1807  519 
UpdateLandTexture(x, w, y, h) 
409  520 
end; 
521 

1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

522 
// was experimenting with applying as damage occurred. 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

523 
function Despeckle(X, Y: LongInt): boolean; 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

524 
var nx, ny, i, j, c: LongInt; 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

525 
begin 
1792  526 
if (Land[Y, X] <> 0) and (Land[Y, X] <> COLOR_INDESTRUCTIBLE) and (LandPixels[Y, X] = cExplosionBorderColor)then // check neighbours 
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

527 
begin 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

528 
c:= 0; 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

529 
for i:= 1 to 1 do 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

530 
for j:= 1 to 1 do 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

531 
if (i <> 0) or (j <> 0) then 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

532 
begin 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

533 
ny:= Y + i; 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

534 
nx:= X + j; 
1753  535 
if ((ny and LAND_HEIGHT_MASK) = 0) and ((nx and LAND_WIDTH_MASK) = 0) then 
1892  536 
if Land[ny, nx] > 255 then 
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

537 
inc(c); 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

538 
end; 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

539 

00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

540 
if c < 4 then // 03 neighbours 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

541 
begin 
2648
415a75d45693
Get rid of stupid ToggleLongInt and ToggleString functions
unc0rr
parents:
2647
diff
changeset

542 
if Land[Y, X] = COLOR_LAND then LandPixels[Y, X]:= LandBackPixel(X, Y) else LandPixels[Y, X]:= 0; 
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

543 
Land[Y, X]:= 0; 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

544 
exit(true); 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

545 
end; 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

546 
end; 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

547 
Despeckle:= false 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

548 
end; 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

549 

1792  550 
function SweepDirty: boolean; 
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

551 
var x, y, xx, yy: LongInt; 
2695  552 
bRes, updateBlock, resweep: boolean; 
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

553 
begin 
2695  554 
bRes:= false; 
1792  555 

1761  556 
for y:= 0 to LAND_HEIGHT div 32  1 do 
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

557 
begin 
2376  558 

1761  559 
for x:= 0 to LAND_WIDTH div 32  1 do 
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

560 
begin 
1809  561 
if LandDirty[y, x] <> 0 then 
562 
begin 

563 
updateBlock:= false; 

2167
4e9ad395c1d1
Loop sweeping to avoid stray pixels. Avoided at first hoping there was a cleverer approach. Fortunately sweep is infrequent.
nemo
parents:
1892
diff
changeset

564 
resweep:= true; 
4e9ad395c1d1
Loop sweeping to avoid stray pixels. Avoided at first hoping there was a cleverer approach. Fortunately sweep is infrequent.
nemo
parents:
1892
diff
changeset

565 
while(resweep) do 
4e9ad395c1d1
Loop sweeping to avoid stray pixels. Avoided at first hoping there was a cleverer approach. Fortunately sweep is infrequent.
nemo
parents:
1892
diff
changeset

566 
begin 
4e9ad395c1d1
Loop sweeping to avoid stray pixels. Avoided at first hoping there was a cleverer approach. Fortunately sweep is infrequent.
nemo
parents:
1892
diff
changeset

567 
resweep:= false; 
4e9ad395c1d1
Loop sweeping to avoid stray pixels. Avoided at first hoping there was a cleverer approach. Fortunately sweep is infrequent.
nemo
parents:
1892
diff
changeset

568 
for yy:= y * 32 to y * 32 + 31 do 
4e9ad395c1d1
Loop sweeping to avoid stray pixels. Avoided at first hoping there was a cleverer approach. Fortunately sweep is infrequent.
nemo
parents:
1892
diff
changeset

569 
for xx:= x * 32 to x * 32 + 31 do 
4e9ad395c1d1
Loop sweeping to avoid stray pixels. Avoided at first hoping there was a cleverer approach. Fortunately sweep is infrequent.
nemo
parents:
1892
diff
changeset

570 
if Despeckle(xx, yy) then 
4e9ad395c1d1
Loop sweeping to avoid stray pixels. Avoided at first hoping there was a cleverer approach. Fortunately sweep is infrequent.
nemo
parents:
1892
diff
changeset

571 
begin 
2695  572 
bRes:= true; 
2167
4e9ad395c1d1
Loop sweeping to avoid stray pixels. Avoided at first hoping there was a cleverer approach. Fortunately sweep is infrequent.
nemo
parents:
1892
diff
changeset

573 
updateBlock:= true; 
4e9ad395c1d1
Loop sweeping to avoid stray pixels. Avoided at first hoping there was a cleverer approach. Fortunately sweep is infrequent.
nemo
parents:
1892
diff
changeset

574 
resweep:= true; 
4e9ad395c1d1
Loop sweeping to avoid stray pixels. Avoided at first hoping there was a cleverer approach. Fortunately sweep is infrequent.
nemo
parents:
1892
diff
changeset

575 
end; 
4e9ad395c1d1
Loop sweeping to avoid stray pixels. Avoided at first hoping there was a cleverer approach. Fortunately sweep is infrequent.
nemo
parents:
1892
diff
changeset

576 
end; 
1809  577 
if updateBlock then UpdateLandTexture(x * 32, 32, y * 32, 32); 
578 
LandDirty[y, x]:= 0; 

579 
end; 

1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

580 
end; 
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

581 
end; 
1792  582 

2695  583 
SweepDirty:= bRes; 
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset

584 
end; 
184  585 

2331
e4941a7986d6
Another try at keeping blowtorch/firepunch/jackhammer from going through indestructible stuff. Shame these routines don't use hedgehog movement
nemo
parents:
2236
diff
changeset

586 
// Return true if outside of land or not the value tested, used right now for some X/Y movement that does not use normal hedgehog movement in GSHandlers.inc 
e4941a7986d6
Another try at keeping blowtorch/firepunch/jackhammer from going through indestructible stuff. Shame these routines don't use hedgehog movement
nemo
parents:
2236
diff
changeset

587 
function CheckLandValue(X, Y: LongInt; Color: Word): boolean; 
e4941a7986d6
Another try at keeping blowtorch/firepunch/jackhammer from going through indestructible stuff. Shame these routines don't use hedgehog movement
nemo
parents:
2236
diff
changeset

588 
begin 
e4941a7986d6
Another try at keeping blowtorch/firepunch/jackhammer from going through indestructible stuff. Shame these routines don't use hedgehog movement
nemo
parents:
2236
diff
changeset

589 
CheckLandValue:= ((X and LAND_WIDTH_MASK <> 0) or (Y and LAND_HEIGHT_MASK <> 0)) or (Land[Y, X] <> Color) 
e4941a7986d6
Another try at keeping blowtorch/firepunch/jackhammer from going through indestructible stuff. Shame these routines don't use hedgehog movement
nemo
parents:
2236
diff
changeset

590 
end; 
184  591 
end. 