author  unc0rr 
Wed, 18 Mar 2009 15:48:43 +0000  
changeset 1899  5763f46d7486 
parent 1892  fddc1201df25 
child 2167  4e9ad395c1d1 
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 

184  19 
unit uLandGraphics; 
20 
interface 

409  21 
uses uFloat, uConsts; 
345  22 
{$INCLUDE options.inc} 
184  23 

24 
type PRangeArray = ^TRangeArray; 

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

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

1792  29 
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

30 
function Despeckle(X, Y: LongInt): boolean; 
371  31 
procedure DrawExplosion(X, Y, Radius: LongInt); 
32 
procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte); 

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

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

511  35 
procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet: boolean); 
184  36 

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

184  39 
implementation 
1806  40 
uses SDLh, uMisc, uLand, uLandTexture; 
184  41 

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

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

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

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

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

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

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

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

184  61 
end; 
62 

511  63 
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

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

65 
begin 
511  66 
if not doSet then 
67 
begin 

1753  68 
if ((y + dy) and LAND_HEIGHT_MASK) = 0 then 
1760  69 
for i:= max(x  dx, 0) to min(x + dx, LAND_WIDTH  1) do 
1861  70 
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  71 
if ((y  dy) and LAND_HEIGHT_MASK) = 0 then 
1760  72 
for i:= max(x  dx, 0) to min(x + dx, LAND_WIDTH  1) do 
1861  73 
if (Land[y  dy, i] > 0) and (Land[y  dy, i] < 256) then dec(Land[y  dy, i]); 
1753  74 
if ((y + dx) and LAND_HEIGHT_MASK) = 0 then 
1760  75 
for i:= max(x  dy, 0) to min(x + dy, LAND_WIDTH  1) do 
1861  76 
if (Land[y + dx, i] > 0) and (Land[y + dx, i] < 256) then dec(Land[y + dx, i]); 
1753  77 
if ((y  dx) and LAND_HEIGHT_MASK) = 0 then 
1760  78 
for i:= max(x  dy, 0) to min(x + dy, LAND_WIDTH  1) do 
1861  79 
if (Land[y  dx, i] > 0) and (Land[y  dx, i] < 256) then dec(Land[y  dx, i]); 
511  80 
end else 
81 
begin 

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

85 
inc(Land[y + dy, i]); 

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

89 
inc(Land[y  dy, i]); 

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

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

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

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

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

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

100 

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

184  103 
begin 
104 
dx:= 0; 

105 
dy:= Radius; 

106 
d:= 3  2 * Radius; 

107 
while (dx < dy) do 

108 
begin 

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

110 
if (d < 0) 

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

112 
else begin 

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

114 
dec(dy) 

115 
end; 

116 
inc(dx) 

117 
end; 

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

119 
end; 

120 

511  121 
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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

137 
end; 
511  138 
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

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

140 

371  141 
procedure FillLandCircleLines0(x, y, dx, dy: LongInt); 
142 
var i: LongInt; 

184  143 
begin 
1753  144 
if ((y + dy) and LAND_HEIGHT_MASK) = 0 then 
1760  145 
for i:= max(x  dx, 0) to min(x + dx, LAND_WIDTH  1) do 
1849  146 
if Land[y + dy, i] = COLOR_LAND then 
1753  147 
LandPixels[y + dy, i]:= 0; 
148 
if ((y  dy) and LAND_HEIGHT_MASK) = 0 then 

1760  149 
for i:= max(x  dx, 0) to min(x + dx, LAND_WIDTH  1) do 
1849  150 
if Land[y  dy, i] = COLOR_LAND then 
1753  151 
LandPixels[y  dy, i]:= 0; 
152 
if ((y + dx) and LAND_HEIGHT_MASK) = 0 then 

1760  153 
for i:= max(x  dy, 0) to min(x + dy, LAND_WIDTH  1) do 
1849  154 
if Land[y + dx, i] = COLOR_LAND then 
1753  155 
LandPixels[y + dx, i]:= 0; 
156 
if ((y  dx) and LAND_HEIGHT_MASK) = 0 then 

1760  157 
for i:= max(x  dy, 0) to min(x + dy, LAND_WIDTH  1) do 
1849  158 
if Land[y  dx, i] = COLOR_LAND then 
1753  159 
LandPixels[y  dx, i]:= 0; 
184  160 
end; 
161 

371  162 
procedure FillLandCircleLinesEBC(x, y, dx, dy: LongInt); 
163 
var i: LongInt; 

184  164 
begin 
1753  165 
if ((y + dy) and LAND_HEIGHT_MASK) = 0 then 
1760  166 
for i:= max(x  dx, 0) to min(x + dx, LAND_WIDTH  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

167 
if Land[y + dy, i] = COLOR_LAND 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

168 
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

169 
LandPixels[y + dy, i]:= cExplosionBorderColor; 
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

170 
// Despeckle(y + dy, 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

171 
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

172 
end; 
1753  173 
if ((y  dy) and LAND_HEIGHT_MASK) = 0 then 
1760  174 
for i:= max(x  dx, 0) to min(x + dx, LAND_WIDTH  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

175 
if Land[y  dy, i] = COLOR_LAND 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

176 
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

177 
LandPixels[y  dy, i]:= cExplosionBorderColor; 
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

178 
// Despeckle(y  dy, 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

179 
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

180 
end; 
1753  181 
if ((y + dx) and LAND_HEIGHT_MASK) = 0 then 
1760  182 
for i:= max(x  dy, 0) to min(x + dy, LAND_WIDTH  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

183 
if Land[y + dx, i] = COLOR_LAND 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

184 
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

185 
LandPixels[y + dx, i]:= cExplosionBorderColor; 
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

186 
// Despeckle(y + dx, 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

187 
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

188 
end; 
1753  189 
if ((y  dx) and LAND_HEIGHT_MASK) = 0 then 
1760  190 
for i:= max(x  dy, 0) to min(x + dy, LAND_WIDTH  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

191 
if Land[y  dx, i] = COLOR_LAND 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

192 
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

193 
LandPixels[y  dx, i]:= cExplosionBorderColor; 
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

194 
// Despeckle(y  dx, 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

195 
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

196 
end; 
184  197 
end; 
198 

371  199 
procedure DrawExplosion(X, Y, Radius: LongInt); 
1807  200 
var dx, dy, ty, tx, d: LongInt; 
184  201 
begin 
202 
dx:= 0; 

203 
dy:= Radius; 

204 
d:= 3  2 * Radius; 

205 
while (dx < dy) do 

206 
begin 

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

208 
if (d < 0) 

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

210 
else begin 

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

212 
dec(dy) 

213 
end; 

214 
inc(dx) 

215 
end; 

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

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

184  219 
inc(Radius, 4); 
220 
dx:= 0; 

221 
dy:= Radius; 

222 
d:= 3  2 * Radius; 

223 
while (dx < dy) do 

224 
begin 

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

226 
if (d < 0) 

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

228 
else begin 

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

230 
dec(dy) 

231 
end; 

232 
inc(dx) 

233 
end; 

351  234 
if (dx = dy) then FillLandCircleLinesEBC(x, y, dx, dy); 
235 

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

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

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

240 
UpdateLandTexture(tx, dx, ty, dy) 

184  241 
end; 
242 

371  243 
procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte); 
184  244 
var tx, ty, i: LongInt; 
245 
begin 

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

247 
begin 

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

1849  250 
if Land[ty, tx] = COLOR_LAND then 
1753  251 
LandPixels[ty, tx]:= 0; 
184  252 
inc(y, dY) 
253 
end; 

254 

255 
inc(Radius, 4); 

351  256 
dec(y, Count * dY); 
184  257 

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

259 
begin 

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

262 
if Land[ty, tx] = COLOR_LAND 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

263 
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

264 
LandPixels[ty, tx]:= cExplosionBorderColor; 
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

265 
LandDirty[trunc((y + dy)/32), trunc(i/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

266 
end; 
184  267 
inc(y, dY) 
268 
end; 

269 

818  270 

1807  271 
UpdateLandTexture(0, LAND_WIDTH, 0, LAND_HEIGHT) 
184  272 
end; 
273 

274 
// 

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

276 
// 

371  277 
procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt); 
358  278 
var nx, ny, dX8, dY8: hwFloat; 
1809  279 
i, t, tx, ty, stX, stY, ddy, ddx: Longint; 
184  280 
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

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

283 

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

286 

358  287 
dX8:= dX * 8; 
288 
dY8:= dY * 8; 

184  289 
for i:= 0 to 7 do 
290 
begin 

358  291 
X:= nx  dX8; 
292 
Y:= ny  dY8; 

184  293 
for t:= 8 to ticks + 8 do 
294 
{$include tunsetborder.inc} 

295 
nx:= nx  dY; 

296 
ny:= ny + dX; 

297 
end; 

298 

299 
for i:= HalfWidth to HalfWidth do 

300 
begin 

358  301 
X:= nx  dX8; 
302 
Y:= ny  dY8; 

184  303 
for t:= 0 to 7 do 
304 
{$include tunsetborder.inc} 

305 
X:= nx; 

306 
Y:= ny; 

307 
for t:= 0 to ticks do 

308 
begin 

309 
X:= X + dX; 

310 
Y:= Y + dY; 

351  311 
tx:= hwRound(X); 
312 
ty:= hwRound(Y); 

1753  313 
if ((ty and LAND_HEIGHT_MASK) = 0) and ((tx and LAND_WIDTH_MASK) = 0) then 
511  314 
if Land[ty, tx] = COLOR_LAND then 
184  315 
begin 
316 
Land[ty, tx]:= 0; 

768  317 
LandPixels[ty, tx]:= 0; 
184  318 
end 
319 
end; 

320 
for t:= 0 to 7 do 

321 
{$include tunsetborder.inc} 

322 
nx:= nx  dY; 

323 
ny:= ny + dX; 

324 
end; 

325 

326 
for i:= 0 to 7 do 

327 
begin 

358  328 
X:= nx  dX8; 
329 
Y:= ny  dY8; 

184  330 
for t:= 8 to ticks + 8 do 
331 
{$include tunsetborder.inc} 

332 
nx:= nx  dY; 

333 
ny:= ny + dX; 

334 
end; 

335 

1809  336 
tx:= max(stX  HalfWidth * 2  4  abs(hwRound(dX * ticks)), 0); 
1807  337 
ty:= max(stY  HalfWidth * 2  4  abs(hwRound(dY * ticks)), 0); 
1809  338 
ddx:= min(stX + HalfWidth * 2 + 4 + abs(hwRound(dX * ticks)), LAND_WIDTH)  tx; 
339 
ddy:= min(stY + HalfWidth * 2 + 4 + abs(hwRound(dY * ticks)), LAND_HEIGHT)  ty; 

340 

341 
UpdateLandTexture(tx, ddx, ty, ddy) 

184  342 
end; 
343 

520  344 
function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean): boolean; 
769
788efc1d649f
 Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset

345 
var X, Y, bpp, h, w: LongInt; 
409  346 
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

347 
Image: PSDL_Surface; 
409  348 
begin 
769
788efc1d649f
 Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset

349 
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

350 
Image:= SpritesData[Obj].Surface; 
409  351 
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

352 
h:= SpritesData[Obj].Height; 
409  353 

354 
if SDL_MustLock(Image) then 

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

356 

357 
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

358 
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

359 
// Check that sprite fits free space 
409  360 
p:= @(PByteArray(Image^.pixels)^[Image^.pitch * Frame * h]); 
361 
case bpp of 

362 
4: for y:= 0 to Pred(h) do 

363 
begin 

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

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

1792  366 
if ((cpY + y) < Longint(topY)) or 
367 
((cpY + y) > LAND_HEIGHT) or 

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

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

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

372 
if SDL_MustLock(Image) then 

373 
SDL_UnlockSurface(Image); 

374 
exit(false) 

375 
end; 

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

377 
end; 

378 
end; 

379 

520  380 
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

381 
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

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

383 
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

384 
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

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

386 
end; 
520  387 

409  388 
// Checked, now place 
389 
p:= @(PByteArray(Image^.pixels)^[Image^.pitch * Frame * h]); 

390 
case bpp of 

391 
4: for y:= 0 to Pred(h) do 

392 
begin 

393 
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

394 
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

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

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

397 
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

398 
end; 
409  399 
p:= @(p^[Image^.pitch]); 
400 
end; 

401 
end; 

402 
if SDL_MustLock(Image) then 

403 
SDL_UnlockSurface(Image); 

404 

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

1792  407 
y:= max(cpY, topY); 
1753  408 
h:= min(cpY + Image^.h, LAND_HEIGHT)  y; 
1807  409 
UpdateLandTexture(x, w, y, h) 
409  410 
end; 
411 

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

412 
// 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

413 
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

414 
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

415 
begin 
1792  416 
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

417 
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

418 
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

419 
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

420 
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

421 
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

422 
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

423 
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

424 
nx:= X + j; 
1753  425 
if ((ny and LAND_HEIGHT_MASK) = 0) and ((nx and LAND_WIDTH_MASK) = 0) then 
1892  426 
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

427 
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

428 
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

429 

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

430 
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

431 
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

432 
LandPixels[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

433 
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

434 
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

435 
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

436 
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

437 
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

438 
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

439 

1792  440 
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

441 
var x, y, xx, yy: LongInt; 
1809  442 
Result, updateBlock: 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

443 
begin 
1792  444 
Result:= false; 
445 

1761  446 
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

447 
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

448 

1761  449 
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

450 
begin 
1809  451 
if LandDirty[y, x] <> 0 then 
452 
begin 

453 
updateBlock:= false; 

454 
for yy:= y * 32 to y * 32 + 31 do 

455 
for xx:= x * 32 to x * 32 + 31 do 

456 
if Despeckle(xx, yy) then 

457 
begin 

458 
Result:= true; 

459 
updateBlock:= true; 

460 
end; 

461 
if updateBlock then UpdateLandTexture(x * 32, 32, y * 32, 32); 

462 
LandDirty[y, x]:= 0; 

463 
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

464 
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

465 
end; 
1792  466 

467 
SweepDirty:= Result 

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

468 
end; 
184  469 

470 
end. 