20 |
20 |
21 unit uLandGraphics; |
21 unit uLandGraphics; |
22 interface |
22 interface |
23 uses uFloat, uConsts, uTypes; |
23 uses uFloat, uConsts, uTypes; |
24 |
24 |
|
25 type |
|
26 fillType = (nullPixel, backgroundPixel, ebcPixel, icePixel, setNotCurrentMask, changePixelSetNotCurrent, setCurrentHog, changePixelNotSetNotCurrent); |
|
27 |
25 type TRangeArray = array[0..31] of record |
28 type TRangeArray = array[0..31] of record |
26 Left, Right: LongInt; |
29 Left, Right: LongInt; |
27 end; |
30 end; |
28 PRangeArray = ^TRangeArray; |
31 PRangeArray = ^TRangeArray; |
|
32 TLandCircleProcedure = procedure (landX, landY, pixelX, pixelY: Longint); |
29 |
33 |
30 function addBgColor(OldColor, NewColor: LongWord): LongWord; |
34 function addBgColor(OldColor, NewColor: LongWord): LongWord; |
31 function SweepDirty: boolean; |
35 function SweepDirty: boolean; |
32 function Despeckle(X, Y: LongInt): Boolean; |
36 function Despeckle(X, Y: LongInt): Boolean; |
33 procedure Smooth(X, Y: LongInt); |
37 procedure Smooth(X, Y: LongInt); |
34 function CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean; |
38 function CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean; |
35 function DrawExplosion(X, Y, Radius: LongInt): Longword; |
39 function DrawExplosion(X, Y, Radius: LongInt): Longword; |
36 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte); |
40 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte); |
37 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt); |
41 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt); |
38 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword); |
42 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword); |
|
43 function FillRoundInLand(X, Y, Radius: LongInt; fill: fillType): LongWord; |
39 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean); |
44 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean); |
40 function LandBackPixel(x, y: LongInt): LongWord; |
45 function LandBackPixel(x, y: LongInt): LongWord; |
41 procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword); |
46 procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword); |
42 procedure DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword); |
47 procedure DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword); |
43 procedure DumpLandToLog(x, y, r: LongInt); |
48 procedure DumpLandToLog(x, y, r: LongInt); |
44 |
49 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint); |
45 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean; indestructible: boolean): boolean; |
50 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean; indestructible: boolean): boolean; |
46 |
51 |
47 implementation |
52 implementation |
48 uses SDLh, uLandTexture, uVariables, uUtils, uDebug; |
53 uses SDLh, uLandTexture, uVariables, uUtils, uDebug; |
|
54 |
|
55 |
|
56 procedure calculatePixelsCoordinates(landX, landY: Longint; var pixelX, pixelY: Longint); inline; |
|
57 begin |
|
58 if (cReducedQuality and rqBlurryLand) = 0 then |
|
59 begin |
|
60 pixelX := landX; |
|
61 pixelY := landY; |
|
62 end |
|
63 else |
|
64 begin |
|
65 pixelX := LandX div 2; |
|
66 pixelY := LandY div 2; |
|
67 end; |
|
68 end; |
|
69 |
|
70 function drawPixelBG(landX, landY, pixelX, pixelY: Longint): Longword; inline; |
|
71 begin |
|
72 drawPixelBG := 0; |
|
73 if (Land[LandY, landX] and lfIndestructible) = 0 then |
|
74 begin |
|
75 if ((Land[landY, landX] and lfBasic) <> 0) and (((LandPixels[pixelY, pixelX] and AMask) shr AShift) = 255) and (not disableLandBack) then |
|
76 begin |
|
77 LandPixels[pixelY, pixelX]:= LandBackPixel(landX, landY); |
|
78 inc(drawPixelBG); |
|
79 end |
|
80 else if ((Land[landY, landX] and lfObject) <> 0) or (((LandPixels[pixelY, pixelX] and AMask) shr AShift) < 255) then |
|
81 LandPixels[pixelY, pixelX]:= 0 |
|
82 end; |
|
83 end; |
|
84 |
|
85 procedure drawPixelEBC(landX, landY, pixelX, pixelY: Longint); inline; |
|
86 begin |
|
87 if ((Land[landY, landX] and lfBasic) <> 0) or ((Land[landY, landX] and lfObject) <> 0) then |
|
88 begin |
|
89 LandPixels[pixelY, pixelX]:= ExplosionBorderColor; |
|
90 Land[landY, landX]:= (Land[landY, landX] or lfDamaged) and not lfIce; |
|
91 LandDirty[landY div 32, landX div 32]:= 1; |
|
92 end; |
|
93 end; |
|
94 |
|
95 function isLandscapeEdge(weight:Longint):boolean; inline; |
|
96 begin |
|
97 result := (weight < 8) and (weight >= 2); |
|
98 end; |
|
99 |
|
100 function getPixelWeight(x, y:Longint): Longint; |
|
101 var |
|
102 i, j:Longint; |
|
103 begin |
|
104 result := 0; |
|
105 for i := x - 1 to x + 1 do |
|
106 for j := y - 1 to y + 1 do |
|
107 begin |
|
108 if (i < 0) or |
|
109 (i > LAND_WIDTH - 1) or |
|
110 (j < 0) or |
|
111 (j > LAND_HEIGHT -1) then |
|
112 begin |
|
113 result := 9; |
|
114 exit; |
|
115 end; |
|
116 if Land[j, i] and lfLandMask and not lfIce = 0 then |
|
117 result := result + 1; |
|
118 end; |
|
119 end; |
|
120 |
|
121 |
|
122 procedure fillPixelFromIceSprite(pixelX, pixelY:Longint); inline; |
|
123 var |
|
124 iceSurface: PSDL_Surface; |
|
125 icePixels: PLongwordArray; |
|
126 w: LongWord; |
|
127 begin |
|
128 // So. 3 parameters here. Ice colour, Ice opacity, and a bias on the greyscaled pixel towards lightness |
|
129 iceSurface:= SpritesData[sprIceTexture].Surface; |
|
130 icePixels := iceSurface^.pixels; |
|
131 w:= LandPixels[pixelY, pixelX]; |
|
132 if w > 0 then |
|
133 begin |
|
134 w:= round(((w shr RShift and $FF) * RGB_LUMINANCE_RED + |
|
135 (w shr BShift and $FF) * RGB_LUMINANCE_GREEN + |
|
136 (w shr GShift and $FF) * RGB_LUMINANCE_BLUE)); |
|
137 if w < 128 then w:= w+128; |
|
138 if w > 255 then w:= 255; |
|
139 w:= (w shl RShift) or (w shl BShift) or (w shl GShift) or (LandPixels[pixelY, pixelX] and AMask); |
|
140 LandPixels[pixelY, pixelX]:= addBgColor(w, IceColor); |
|
141 LandPixels[pixelY, pixelX]:= addBgColor(LandPixels[pixelY, pixelX], icePixels^[iceSurface^.w * (pixelY mod iceSurface^.h) + (pixelX mod iceSurface^.w)]) |
|
142 end |
|
143 else |
|
144 begin |
|
145 LandPixels[pixelY, pixelX]:= IceColor and not AMask or $E8 shl AShift; |
|
146 LandPixels[pixelY, pixelX]:= addBgColor(LandPixels[pixelY, pixelX], icePixels^[iceSurface^.w * (pixelY mod iceSurface^.h) + (pixelX mod iceSurface^.w)]); |
|
147 // silly workaround to avoid having to make background erasure a tadb it smarter about sea ice |
|
148 if LandPixels[pixelY, pixelX] and AMask shr AShift = 255 then |
|
149 LandPixels[pixelY, pixelX]:= LandPixels[pixelY, pixelX] and not AMask or 254 shl AShift; |
|
150 end; |
|
151 end; |
|
152 |
|
153 |
|
154 procedure DrawPixelIce(landX, landY, pixelX, pixelY: Longint); inline; |
|
155 begin |
|
156 if ((Land[landY, landX] and lfIce) <> 0) then exit; |
|
157 if isLandscapeEdge(getPixelWeight(landX, landY)) then |
|
158 begin |
|
159 if (LandPixels[pixelY, pixelX] and AMask < 255) and (LandPixels[pixelY, pixelX] and AMask > 0) then |
|
160 LandPixels[pixelY, pixelX] := (IceEdgeColor and not AMask) or (LandPixels[pixelY, pixelX] and AMask) |
|
161 else if (LandPixels[pixelY, pixelX] and AMask < 255) or (Land[landY, landX] > 255) then |
|
162 LandPixels[pixelY, pixelX] := IceEdgeColor |
|
163 end |
|
164 else if Land[landY, landX] > 255 then |
|
165 begin |
|
166 fillPixelFromIceSprite(pixelX, pixelY); |
|
167 end; |
|
168 if Land[landY, landX] > 255 then Land[landY, landX] := Land[landY, landX] or lfIce and not lfDamaged; |
|
169 end; |
|
170 |
|
171 |
|
172 function FillLandCircleLine(y, fromPix, toPix: LongInt; fill : fillType): Longword; |
|
173 var px, py, i: LongInt; |
|
174 begin |
|
175 //get rid of compiler warning |
|
176 px := 0; |
|
177 py := 0; |
|
178 FillLandCircleLine := 0; |
|
179 case fill of |
|
180 backgroundPixel: |
|
181 for i:= fromPix to toPix do |
|
182 begin |
|
183 calculatePixelsCoordinates(i, y, px, py); |
|
184 inc(FillLandCircleLine, drawPixelBG(i, y, px, py)); |
|
185 end; |
|
186 ebcPixel: |
|
187 for i:= fromPix to toPix do |
|
188 begin |
|
189 calculatePixelsCoordinates(i, y, px, py); |
|
190 drawPixelEBC(i, y, px, py); |
|
191 end; |
|
192 nullPixel: |
|
193 for i:= fromPix to toPix do |
|
194 begin |
|
195 calculatePixelsCoordinates(i, y, px, py); |
|
196 if ((Land[y, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[y, i] > 255)) then |
|
197 LandPixels[py, px]:= 0 |
|
198 end; |
|
199 icePixel: |
|
200 for i:= fromPix to toPix do |
|
201 begin |
|
202 calculatePixelsCoordinates(i, y, px, py); |
|
203 DrawPixelIce(i, y, px, py); |
|
204 end; |
|
205 setNotCurrentMask: |
|
206 for i:= fromPix to toPix do |
|
207 begin |
|
208 Land[y, i]:= Land[y, i] and lfNotCurrentMask; |
|
209 end; |
|
210 changePixelSetNotCurrent: |
|
211 for i:= fromPix to toPix do |
|
212 begin |
|
213 if Land[y, i] and lfObjMask > 0 then |
|
214 Land[y, i]:= (Land[y, i] and lfNotObjMask) or ((Land[y, i] and lfObjMask) - 1); |
|
215 end; |
|
216 setCurrentHog: |
|
217 for i:= fromPix to toPix do |
|
218 begin |
|
219 Land[y, i]:= Land[y, i] or lfCurrentHog |
|
220 end; |
|
221 changePixelNotSetNotCurrent: |
|
222 for i:= fromPix to toPix do |
|
223 begin |
|
224 if Land[y, i] and lfObjMask < lfObjMask then |
|
225 Land[y, i]:= (Land[y, i] and lfNotObjMask) or ((Land[y, i] and lfObjMask) + 1) |
|
226 end; |
|
227 end; |
|
228 end; |
|
229 |
|
230 function FillLandCircleSegment(x, y, dx, dy: LongInt; fill : fillType): Longword; inline; |
|
231 begin |
|
232 FillLandCircleSegment := 0; |
|
233 if ((y + dy) and LAND_HEIGHT_MASK) = 0 then |
|
234 inc(FillLandCircleSegment, FillLandCircleLine(y + dy, Max(x - dx, 0), Min(x + dx, LAND_WIDTH - 1), fill)); |
|
235 if ((y - dy) and LAND_HEIGHT_MASK) = 0 then |
|
236 inc(FillLandCircleSegment, FillLandCircleLine(y - dy, Max(x - dx, 0), Min(x + dx, LAND_WIDTH - 1), fill)); |
|
237 if ((y + dx) and LAND_HEIGHT_MASK) = 0 then |
|
238 inc(FillLandCircleSegment, FillLandCircleLine(y + dx, Max(x - dy, 0), Min(x + dy, LAND_WIDTH - 1), fill)); |
|
239 if ((y - dx) and LAND_HEIGHT_MASK) = 0 then |
|
240 inc(FillLandCircleSegment, FillLandCircleLine(y - dx, Max(x - dy, 0), Min(x + dy, LAND_WIDTH - 1), fill)); |
|
241 end; |
|
242 |
|
243 function FillRoundInLand(X, Y, Radius: LongInt; fill: fillType): Longword; inline; |
|
244 var dx, dy, d: LongInt; |
|
245 begin |
|
246 dx:= 0; |
|
247 dy:= Radius; |
|
248 d:= 3 - 2 * Radius; |
|
249 FillRoundInLand := 0; |
|
250 while (dx < dy) do |
|
251 begin |
|
252 inc(FillRoundInLand, FillLandCircleSegment(x, y, dx, dy, fill)); |
|
253 if (d < 0) then |
|
254 d:= d + 4 * dx + 6 |
|
255 else |
|
256 begin |
|
257 d:= d + 4 * (dx - dy) + 10; |
|
258 dec(dy) |
|
259 end; |
|
260 inc(dx) |
|
261 end; |
|
262 if (dx = dy) then |
|
263 inc (FillRoundInLand, FillLandCircleSegment(x, y, dx, dy, fill)); |
|
264 end; |
|
265 |
49 |
266 |
50 function addBgColor(OldColor, NewColor: LongWord): LongWord; |
267 function addBgColor(OldColor, NewColor: LongWord): LongWord; |
51 // Factor ranges from 0 to 100% NewColor |
268 // Factor ranges from 0 to 100% NewColor |
52 var |
269 var |
53 oRed, oBlue, oGreen, oAlpha, nRed, nBlue, nGreen, nAlpha: byte; |
270 oRed, oBlue, oGreen, oAlpha, nRed, nBlue, nGreen, nAlpha: byte; |
97 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
314 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
98 if (Land[y - dx, i] and lfIndestructible) = 0 then |
315 if (Land[y - dx, i] and lfIndestructible) = 0 then |
99 Land[y - dx, i]:= Value; |
316 Land[y - dx, i]:= Value; |
100 end; |
317 end; |
101 |
318 |
102 procedure ChangeCircleLines(x, y, dx, dy: LongInt; doSet, isCurrent: boolean); |
|
103 var i: LongInt; |
|
104 begin |
|
105 if not doSet then |
|
106 begin |
|
107 if ((y + dy) and LAND_HEIGHT_MASK) = 0 then |
|
108 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
|
109 if isCurrent then |
|
110 Land[y + dy, i]:= Land[y + dy, i] and $FF7F |
|
111 else if Land[y + dy, i] and $007F > 0 then |
|
112 Land[y + dy, i]:= (Land[y + dy, i] and $FF80) or ((Land[y + dy, i] and $7F) - 1); |
|
113 if ((y - dy) and LAND_HEIGHT_MASK) = 0 then |
|
114 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
|
115 if isCurrent then |
|
116 Land[y - dy, i]:= Land[y - dy, i] and $FF7F |
|
117 else if Land[y - dy, i] and $007F > 0 then |
|
118 Land[y - dy, i]:= (Land[y - dy, i] and $FF80) or ((Land[y - dy, i] and $7F) - 1); |
|
119 if ((y + dx) and LAND_HEIGHT_MASK) = 0 then |
|
120 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
121 if isCurrent then |
|
122 Land[y + dx, i]:= Land[y + dx, i] and $FF7F |
|
123 else if Land[y + dx, i] and $007F > 0 then |
|
124 Land[y + dx, i]:= (Land[y + dx, i] and $FF80) or ((Land[y + dx, i] and $7F) - 1); |
|
125 if ((y - dx) and LAND_HEIGHT_MASK) = 0 then |
|
126 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
127 if isCurrent then |
|
128 Land[y - dx, i]:= Land[y - dx, i] and $FF7F |
|
129 else if Land[y - dx, i] and $007F > 0 then |
|
130 Land[y - dx, i]:= (Land[y - dx, i] and $FF80) or ((Land[y - dx, i] and $7F) - 1) |
|
131 end |
|
132 else |
|
133 begin |
|
134 if ((y + dy) and LAND_HEIGHT_MASK) = 0 then |
|
135 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
|
136 if isCurrent then |
|
137 Land[y + dy, i]:= Land[y + dy, i] or $80 |
|
138 else if Land[y + dy, i] and $007F < 127 then |
|
139 Land[y + dy, i]:= (Land[y + dy, i] and $FF80) or ((Land[y + dy, i] and $7F) + 1); |
|
140 if ((y - dy) and LAND_HEIGHT_MASK) = 0 then |
|
141 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
|
142 if isCurrent then |
|
143 Land[y - dy, i]:= Land[y - dy, i] or $80 |
|
144 else if Land[y - dy, i] and $007F < 127 then |
|
145 Land[y - dy, i]:= (Land[y - dy, i] and $FF80) or ((Land[y - dy, i] and $7F) + 1); |
|
146 if ((y + dx) and LAND_HEIGHT_MASK) = 0 then |
|
147 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
148 if isCurrent then |
|
149 Land[y + dx, i]:= Land[y + dx, i] or $80 |
|
150 else if Land[y + dx, i] and $007F < 127 then |
|
151 Land[y + dx, i]:= (Land[y + dx, i] and $FF80) or ((Land[y + dx, i] and $7F) + 1); |
|
152 if ((y - dx) and LAND_HEIGHT_MASK) = 0 then |
|
153 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
154 if isCurrent then |
|
155 Land[y - dx, i]:= Land[y - dx, i] or $80 |
|
156 else if Land[y - dx, i] and $007F < 127 then |
|
157 Land[y - dx, i]:= (Land[y - dx, i] and $FF80) or ((Land[y - dx, i] and $7F) + 1) |
|
158 end |
|
159 end; |
|
160 |
|
161 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword); |
319 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword); |
162 var dx, dy, d: LongInt; |
320 var dx, dy, d: LongInt; |
163 begin |
321 begin |
164 dx:= 0; |
322 dx:= 0; |
165 dy:= Radius; |
323 dy:= Radius; |
179 if (dx = dy) then |
337 if (dx = dy) then |
180 FillCircleLines(x, y, dx, dy, Value); |
338 FillCircleLines(x, y, dx, dy, Value); |
181 end; |
339 end; |
182 |
340 |
183 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean); |
341 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean); |
184 var dx, dy, d: LongInt; |
342 begin |
185 begin |
343 if not doSet and isCurrent then |
186 dx:= 0; |
344 FillRoundInLand(X, Y, Radius, setNotCurrentMask) |
187 dy:= Radius; |
345 else if not doSet and not IsCurrent then |
188 d:= 3 - 2 * Radius; |
346 FillRoundInLand(X, Y, Radius, changePixelSetNotCurrent) |
189 while (dx < dy) do |
347 else if doSet and IsCurrent then |
190 begin |
348 FillRoundInLand(X, Y, Radius, setCurrentHog) |
191 ChangeCircleLines(x, y, dx, dy, doSet, isCurrent); |
349 else if doSet and not IsCurrent then |
192 if (d < 0) then |
350 FillRoundInLand(X, Y, Radius, changePixelNotSetNotCurrent); |
193 d:= d + 4 * dx + 6 |
351 end; |
194 else |
352 |
195 begin |
353 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint); |
196 d:= d + 4 * (dx - dy) + 10; |
354 var |
197 dec(dy) |
355 i, j: integer; |
198 end; |
356 landRect: TSDL_Rect; |
199 inc(dx) |
357 begin |
200 end; |
358 for i := min(max(x - iceRadius, 0), LAND_WIDTH - 1) to min(max(x + iceRadius, 0), LAND_WIDTH - 1) do |
201 if (dx = dy) then |
359 begin |
202 ChangeCircleLines(x, y, dx, dy, doSet, isCurrent) |
360 for j := min(max(y, 0), LAND_HEIGHT - 1) to min(max(y + iceHeight, 0), LAND_HEIGHT - 1) do |
203 end; |
361 begin |
204 |
362 if Land[j, i] = 0 then |
205 procedure FillLandCircleLines0(x, y, dx, dy: LongInt); |
363 begin |
206 var i, t: LongInt; |
364 Land[j, i] := lfIce; |
207 begin |
365 fillPixelFromIceSprite(i, j); |
208 t:= y + dy; |
|
209 if (t and LAND_HEIGHT_MASK) = 0 then |
|
210 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
|
211 if ((Land[t, i] and lfIndestructible) = 0) and ((not disableLandBack) or (Land[t, i] > 255)) then |
|
212 if (cReducedQuality and rqBlurryLand) = 0 then |
|
213 LandPixels[t, i]:= 0 |
|
214 else |
|
215 LandPixels[t div 2, i div 2]:= 0; |
|
216 |
|
217 t:= y - dy; |
|
218 if (t and LAND_HEIGHT_MASK) = 0 then |
|
219 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
|
220 if ((Land[t, i] and lfIndestructible) = 0) and ((not disableLandBack) or (Land[t, i] > 255)) then |
|
221 if (cReducedQuality and rqBlurryLand) = 0 then |
|
222 LandPixels[t, i]:= 0 |
|
223 else |
|
224 LandPixels[t div 2, i div 2]:= 0; |
|
225 |
|
226 t:= y + dx; |
|
227 if (t and LAND_HEIGHT_MASK) = 0 then |
|
228 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
229 if ((Land[t, i] and lfIndestructible) = 0) and ((not disableLandBack) or (Land[t, i] > 255)) then |
|
230 if (cReducedQuality and rqBlurryLand) = 0 then |
|
231 LandPixels[t, i]:= 0 |
|
232 else |
|
233 LandPixels[t div 2, i div 2]:= 0; |
|
234 |
|
235 t:= y - dx; |
|
236 if (t and LAND_HEIGHT_MASK) = 0 then |
|
237 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
238 if ((Land[t, i] and lfIndestructible) = 0) and ((not disableLandBack) or (Land[t, i] > 255)) then |
|
239 if (cReducedQuality and rqBlurryLand) = 0 then |
|
240 LandPixels[t, i]:= 0 |
|
241 else |
|
242 LandPixels[t div 2, i div 2]:= 0; |
|
243 |
|
244 end; |
|
245 |
|
246 function FillLandCircleLinesBG(x, y, dx, dy: LongInt): Longword; |
|
247 var i, t, by, bx: LongInt; |
|
248 cnt: Longword; |
|
249 begin |
|
250 cnt:= 0; |
|
251 t:= y + dy; |
|
252 if (t and LAND_HEIGHT_MASK) = 0 then |
|
253 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
|
254 if (Land[t, i] and lfIndestructible) = 0 then |
|
255 begin |
|
256 if (cReducedQuality and rqBlurryLand) = 0 then |
|
257 begin |
|
258 by:= t; bx:= i; |
|
259 end |
|
260 else |
|
261 begin |
|
262 by:= t div 2; bx:= i div 2; |
|
263 end; |
|
264 if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and (not disableLandBack) then |
|
265 begin |
|
266 inc(cnt); |
|
267 LandPixels[by, bx]:= LandBackPixel(i, t) |
|
268 end |
|
269 else if ((Land[t, i] and lfObject) <> 0) or (((LandPixels[by,bx] and AMask) shr AShift) < 255) then |
|
270 LandPixels[by, bx]:= 0 |
|
271 end; |
366 end; |
272 |
367 end; |
273 t:= y - dy; |
368 end; |
274 if (t and LAND_HEIGHT_MASK) = 0 then |
369 landRect.x := min(max(x - iceRadius, 0), LAND_WIDTH - 1); |
275 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
370 landRect.y := min(max(y, 0), LAND_HEIGHT - 1); |
276 if (Land[t, i] and lfIndestructible) = 0 then |
371 landRect.w := min(2*iceRadius, LAND_WIDTH - landRect.x - 1); |
277 begin |
372 landRect.h := min(iceHeight, LAND_HEIGHT - landRect.y - 1); |
278 if (cReducedQuality and rqBlurryLand) = 0 then |
373 UpdateLandTexture(landRect.x, landRect.w, landRect.y, landRect.h, true); |
279 begin |
|
280 by:= t; bx:= i; |
|
281 end |
|
282 else |
|
283 begin |
|
284 by:= t div 2; bx:= i div 2; |
|
285 end; |
|
286 if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and (not disableLandBack) then |
|
287 begin |
|
288 inc(cnt); |
|
289 LandPixels[by, bx]:= LandBackPixel(i, t) |
|
290 end |
|
291 else if ((Land[t, i] and lfObject) <> 0) or (((LandPixels[by,bx] and AMask) shr AShift) < 255) then |
|
292 LandPixels[by, bx]:= 0 |
|
293 end; |
|
294 |
|
295 t:= y + dx; |
|
296 if (t and LAND_HEIGHT_MASK) = 0 then |
|
297 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
298 if (Land[t, i] and lfIndestructible) = 0 then |
|
299 begin |
|
300 if (cReducedQuality and rqBlurryLand) = 0 then |
|
301 begin |
|
302 by:= t; bx:= i; |
|
303 end |
|
304 else |
|
305 begin |
|
306 by:= t div 2; bx:= i div 2; |
|
307 end; |
|
308 if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and (not disableLandBack) then |
|
309 begin |
|
310 inc(cnt); |
|
311 LandPixels[by, bx]:= LandBackPixel(i, t) |
|
312 end |
|
313 else if ((Land[t, i] and lfObject) <> 0) or (((LandPixels[by,bx] and AMask) shr AShift) < 255) then |
|
314 LandPixels[by, bx]:= 0 |
|
315 end; |
|
316 t:= y - dx; |
|
317 if (t and LAND_HEIGHT_MASK) = 0 then |
|
318 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
319 if (Land[t, i] and lfIndestructible) = 0 then |
|
320 begin |
|
321 if (cReducedQuality and rqBlurryLand) = 0 then |
|
322 begin |
|
323 by:= t; bx:= i; |
|
324 end |
|
325 else |
|
326 begin |
|
327 by:= t div 2; bx:= i div 2; |
|
328 end; |
|
329 if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and (not disableLandBack) then |
|
330 begin |
|
331 inc(cnt); |
|
332 LandPixels[by, bx]:= LandBackPixel(i, t) |
|
333 end |
|
334 else if ((Land[t, i] and lfObject) <> 0) or (((LandPixels[by,bx] and AMask) shr AShift) < 255) then |
|
335 LandPixels[by, bx]:= 0 |
|
336 end; |
|
337 FillLandCircleLinesBG:= cnt; |
|
338 end; |
|
339 |
|
340 procedure FillLandCircleLinesEBC(x, y, dx, dy: LongInt); |
|
341 var i, t: LongInt; |
|
342 begin |
|
343 t:= y + dy; |
|
344 if (t and LAND_HEIGHT_MASK) = 0 then |
|
345 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
|
346 if ((Land[t, i] and lfBasic) <> 0) or ((Land[t, i] and lfObject) <> 0) then |
|
347 begin |
|
348 if (cReducedQuality and rqBlurryLand) = 0 then |
|
349 LandPixels[t, i]:= ExplosionBorderColor |
|
350 else |
|
351 LandPixels[t div 2, i div 2]:= ExplosionBorderColor; |
|
352 |
|
353 Land[t, i]:= Land[t, i] or lfDamaged; |
|
354 //Despeckle(i, t); |
|
355 LandDirty[t div 32, i div 32]:= 1; |
|
356 end; |
|
357 |
|
358 t:= y - dy; |
|
359 if (t and LAND_HEIGHT_MASK) = 0 then |
|
360 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
|
361 if ((Land[t, i] and lfBasic) <> 0) or ((Land[t, i] and lfObject) <> 0) then |
|
362 begin |
|
363 if (cReducedQuality and rqBlurryLand) = 0 then |
|
364 LandPixels[t, i]:= ExplosionBorderColor |
|
365 else |
|
366 LandPixels[t div 2, i div 2]:= ExplosionBorderColor; |
|
367 Land[t, i]:= Land[t, i] or lfDamaged; |
|
368 //Despeckle(i, t); |
|
369 LandDirty[t div 32, i div 32]:= 1; |
|
370 end; |
|
371 |
|
372 t:= y + dx; |
|
373 if (t and LAND_HEIGHT_MASK) = 0 then |
|
374 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
375 if ((Land[t, i] and lfBasic) <> 0) or ((Land[t, i] and lfObject) <> 0) then |
|
376 begin |
|
377 if (cReducedQuality and rqBlurryLand) = 0 then |
|
378 LandPixels[t, i]:= ExplosionBorderColor |
|
379 else |
|
380 LandPixels[t div 2, i div 2]:= ExplosionBorderColor; |
|
381 |
|
382 Land[t, i]:= Land[t, i] or lfDamaged; |
|
383 //Despeckle(i, t); |
|
384 LandDirty[t div 32, i div 32]:= 1; |
|
385 end; |
|
386 |
|
387 t:= y - dx; |
|
388 if (t and LAND_HEIGHT_MASK) = 0 then |
|
389 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
390 if ((Land[t, i] and lfBasic) <> 0) or ((Land[t, i] and lfObject) <> 0) then |
|
391 begin |
|
392 if (cReducedQuality and rqBlurryLand) = 0 then |
|
393 LandPixels[t, i]:= ExplosionBorderColor |
|
394 else |
|
395 LandPixels[t div 2, i div 2]:= ExplosionBorderColor; |
|
396 |
|
397 Land[t, i]:= Land[t, i] or lfDamaged; |
|
398 //Despeckle(i, y - dy); |
|
399 LandDirty[t div 32, i div 32]:= 1; |
|
400 end; |
|
401 end; |
374 end; |
402 |
375 |
403 function DrawExplosion(X, Y, Radius: LongInt): Longword; |
376 function DrawExplosion(X, Y, Radius: LongInt): Longword; |
404 var dx, dy, ty, tx, d: LongInt; |
377 var |
405 cnt: Longword; |
378 tx, ty, dx, dy: Longint; |
406 begin |
379 begin |
407 |
380 DrawExplosion := FillRoundInLand(x, y, Radius, backgroundPixel); |
408 // draw background land texture |
381 if Radius > 20 then |
409 begin |
382 FillRoundInLand(x, y, Radius - 15, nullPixel); |
410 cnt:= 0; |
|
411 dx:= 0; |
|
412 dy:= Radius; |
|
413 d:= 3 - 2 * Radius; |
|
414 |
|
415 while (dx < dy) do |
|
416 begin |
|
417 inc(cnt, FillLandCircleLinesBG(x, y, dx, dy)); |
|
418 if (d < 0) then |
|
419 d:= d + 4 * dx + 6 |
|
420 else |
|
421 begin |
|
422 d:= d + 4 * (dx - dy) + 10; |
|
423 dec(dy) |
|
424 end; |
|
425 inc(dx) |
|
426 end; |
|
427 if (dx = dy) then |
|
428 inc(cnt, FillLandCircleLinesBG(x, y, dx, dy)); |
|
429 end; |
|
430 |
|
431 // draw a hole in land |
|
432 if Radius > 20 then |
|
433 begin |
|
434 dx:= 0; |
|
435 dy:= Radius - 15; |
|
436 d:= 3 - 2 * dy; |
|
437 |
|
438 while (dx < dy) do |
|
439 begin |
|
440 FillLandCircleLines0(x, y, dx, dy); |
|
441 if (d < 0) then |
|
442 d:= d + 4 * dx + 6 |
|
443 else |
|
444 begin |
|
445 d:= d + 4 * (dx - dy) + 10; |
|
446 dec(dy) |
|
447 end; |
|
448 inc(dx) |
|
449 end; |
|
450 if (dx = dy) then |
|
451 FillLandCircleLines0(x, y, dx, dy); |
|
452 end; |
|
453 |
|
454 // FillRoundInLand after erasing land pixels to allow Land 0 check for mask.png to function |
|
455 FillRoundInLand(X, Y, Radius, 0); |
383 FillRoundInLand(X, Y, Radius, 0); |
456 |
384 FillRoundInLand(x, y, Radius + 4, ebcPixel); |
457 // draw explosion border |
385 tx:= Max(X - Radius - 5, 0); |
458 begin |
386 dx:= Min(X + Radius + 5, LAND_WIDTH) - tx; |
459 inc(Radius, 4); |
387 ty:= Max(Y - Radius - 5, 0); |
460 dx:= 0; |
388 dy:= Min(Y + Radius + 5, LAND_HEIGHT) - ty; |
461 dy:= Radius; |
389 UpdateLandTexture(tx, dx, ty, dy, false); |
462 d:= 3 - 2 * Radius; |
|
463 while (dx < dy) do |
|
464 begin |
|
465 FillLandCircleLinesEBC(x, y, dx, dy); |
|
466 if (d < 0) then |
|
467 d:= d + 4 * dx + 6 |
|
468 else |
|
469 begin |
|
470 d:= d + 4 * (dx - dy) + 10; |
|
471 dec(dy) |
|
472 end; |
|
473 inc(dx) |
|
474 end; |
|
475 if (dx = dy) then |
|
476 FillLandCircleLinesEBC(x, y, dx, dy); |
|
477 end; |
|
478 |
|
479 tx:= Max(X - Radius - 1, 0); |
|
480 dx:= Min(X + Radius + 1, LAND_WIDTH) - tx; |
|
481 ty:= Max(Y - Radius - 1, 0); |
|
482 dy:= Min(Y + Radius + 1, LAND_HEIGHT) - ty; |
|
483 UpdateLandTexture(tx, dx, ty, dy, false); |
|
484 DrawExplosion:= cnt |
|
485 end; |
390 end; |
486 |
391 |
487 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte); |
392 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte); |
488 var tx, ty, by, bx, i: LongInt; |
393 var tx, ty, by, bx, i: LongInt; |
489 begin |
394 begin |