37 procedure Smooth(X, Y: LongInt); |
37 procedure Smooth(X, Y: LongInt); |
38 function CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean; |
38 function CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean; |
39 function DrawExplosion(X, Y, Radius: LongInt): Longword; |
39 function DrawExplosion(X, Y, Radius: LongInt): Longword; |
40 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte); |
40 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte); |
41 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt); |
41 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt); |
42 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword); |
42 function FillRoundInLand(X, Y, Radius: LongInt; Value: Longword): Longword; |
43 function FillRoundInLand(X, Y, Radius: LongInt; fill: fillType): LongWord; |
43 function FillRoundInLandFT(X, Y, Radius: LongInt; fill: fillType): Longword; |
44 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean); |
44 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean); |
45 function LandBackPixel(x, y: LongInt): LongWord; |
45 function LandBackPixel(x, y: LongInt): LongWord; |
46 procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword); |
46 procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword); |
47 procedure DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword); |
47 function DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword): Longword; |
48 procedure DumpLandToLog(x, y, r: LongInt); |
48 procedure DumpLandToLog(x, y, r: LongInt); |
49 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint); |
49 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint); |
50 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace, indestructible: boolean): boolean; inline; |
50 function TryPlaceOnLandSimple(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace, indestructible: boolean): boolean; inline; |
51 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace, indestructible: boolean; LandFlags: Word): boolean; |
51 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean; LandFlags: Word): boolean; inline; |
|
52 function ForcePlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; LandFlags: Word; Tint: LongWord; Behind, flipHoriz, flipVert: boolean): boolean; inline; |
|
53 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace, outOfMap, force, behind, flipHoriz, flipVert: boolean; LandFlags: Word; Tint: LongWord): boolean; |
|
54 procedure EraseLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; LandFlags: Word; eraseOnLFMatch, onlyEraseLF, flipHoriz, flipVert: boolean); |
|
55 function GetPlaceCollisionTex(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt): PTexture; |
52 |
56 |
53 implementation |
57 implementation |
54 uses SDLh, uLandTexture, uVariables, uUtils, uDebug; |
58 uses SDLh, uLandTexture, uTextures, uVariables, uUtils, uDebug, uScript; |
55 |
59 |
56 |
60 |
57 procedure calculatePixelsCoordinates(landX, landY: Longint; var pixelX, pixelY: Longint); inline; |
61 procedure calculatePixelsCoordinates(landX, landY: Longint; var pixelX, pixelY: Longint); inline; |
58 begin |
62 begin |
59 if (cReducedQuality and rqBlurryLand) = 0 then |
63 if (cReducedQuality and rqBlurryLand) = 0 then |
77 begin |
81 begin |
78 LandPixels[pixelY, pixelX]:= LandBackPixel(landX, landY); |
82 LandPixels[pixelY, pixelX]:= LandBackPixel(landX, landY); |
79 inc(drawPixelBG); |
83 inc(drawPixelBG); |
80 end |
84 end |
81 else if ((Land[landY, landX] and lfObject) <> 0) or (((LandPixels[pixelY, pixelX] and AMask) shr AShift) < 255) then |
85 else if ((Land[landY, landX] and lfObject) <> 0) or (((LandPixels[pixelY, pixelX] and AMask) shr AShift) < 255) then |
82 LandPixels[pixelY, pixelX]:= 0 |
86 LandPixels[pixelY, pixelX]:= ExplosionBorderColorNoA |
83 end; |
87 end; |
84 end; |
88 end; |
85 |
89 |
86 procedure drawPixelEBC(landX, landY, pixelX, pixelY: Longint); inline; |
90 procedure drawPixelEBC(landX, landY, pixelX, pixelY: Longint); inline; |
87 begin |
91 begin |
88 if ((Land[landY, landX] and lfBasic) <> 0) or ((Land[landY, landX] and lfObject) <> 0) then |
92 if (Land[landY, landX] and lfIndestructible = 0) and |
|
93 (((Land[landY, landX] and lfBasic) <> 0) or ((Land[landY, landX] and lfObject) <> 0)) then |
89 begin |
94 begin |
90 LandPixels[pixelY, pixelX]:= ExplosionBorderColor; |
95 LandPixels[pixelY, pixelX]:= ExplosionBorderColor; |
91 Land[landY, landX]:= (Land[landY, landX] or lfDamaged) and not lfIce; |
96 Land[landY, landX]:= (Land[landY, landX] or lfDamaged) and (not lfIce); |
92 LandDirty[landY div 32, landX div 32]:= 1; |
97 LandDirty[landY div 32, landX div 32]:= 1; |
93 end; |
98 end; |
94 end; |
99 end; |
95 |
100 |
96 function isLandscapeEdge(weight:Longint):boolean; inline; |
101 function isLandscapeEdge(weight:Longint):boolean; inline; |
97 begin |
102 begin |
98 result := (weight < 8) and (weight >= 2); |
103 isLandscapeEdge := (weight < 8) and (weight >= 2); |
99 end; |
104 end; |
100 |
105 |
101 function getPixelWeight(x, y:Longint): Longint; |
106 function getPixelWeight(x, y:Longint): Longint; |
102 var |
107 var |
103 i, j:Longint; |
108 i, j, r: Longint; |
104 begin |
109 begin |
105 result := 0; |
110 r := 0; |
106 for i := x - 1 to x + 1 do |
111 for i := x - 1 to x + 1 do |
107 for j := y - 1 to y + 1 do |
112 for j := y - 1 to y + 1 do |
108 begin |
113 begin |
109 if (i < 0) or |
114 if (i < 0) or |
110 (i > LAND_WIDTH - 1) or |
115 (i > LAND_WIDTH - 1) or |
111 (j < 0) or |
116 (j < 0) or |
112 (j > LAND_HEIGHT -1) then |
117 (j > LAND_HEIGHT -1) then |
113 begin |
118 exit(9); |
114 result := 9; |
119 |
115 exit; |
120 if Land[j, i] and lfLandMask and (not lfIce) = 0 then |
116 end; |
121 inc(r) |
117 if Land[j, i] and lfLandMask and not lfIce = 0 then |
122 end; |
118 result := result + 1; |
123 |
119 end; |
124 getPixelWeight:= r |
120 end; |
125 end; |
121 |
126 |
122 |
127 |
123 procedure fillPixelFromIceSprite(pixelX, pixelY:Longint); inline; |
128 procedure fillPixelFromIceSprite(pixelX, pixelY:Longint); inline; |
124 var |
129 var |
142 LandPixels[pixelY, pixelX]:= addBgColor(w, IceColor); |
147 LandPixels[pixelY, pixelX]:= addBgColor(w, IceColor); |
143 LandPixels[pixelY, pixelX]:= addBgColor(LandPixels[pixelY, pixelX], icePixels^[iceSurface^.w * (pixelY mod iceSurface^.h) + (pixelX mod iceSurface^.w)]) |
148 LandPixels[pixelY, pixelX]:= addBgColor(LandPixels[pixelY, pixelX], icePixels^[iceSurface^.w * (pixelY mod iceSurface^.h) + (pixelX mod iceSurface^.w)]) |
144 end |
149 end |
145 else |
150 else |
146 begin |
151 begin |
147 LandPixels[pixelY, pixelX]:= IceColor and not AMask or $E8 shl AShift; |
152 LandPixels[pixelY, pixelX]:= IceColor and (not AMask) or $E8 shl AShift; |
148 LandPixels[pixelY, pixelX]:= addBgColor(LandPixels[pixelY, pixelX], icePixels^[iceSurface^.w * (pixelY mod iceSurface^.h) + (pixelX mod iceSurface^.w)]); |
153 LandPixels[pixelY, pixelX]:= addBgColor(LandPixels[pixelY, pixelX], icePixels^[iceSurface^.w * (pixelY mod iceSurface^.h) + (pixelX mod iceSurface^.w)]); |
149 // silly workaround to avoid having to make background erasure a tadb it smarter about sea ice |
154 // silly workaround to avoid having to make background erasure a tadb it smarter about sea ice |
150 if LandPixels[pixelY, pixelX] and AMask shr AShift = 255 then |
155 if LandPixels[pixelY, pixelX] and AMask shr AShift = 255 then |
151 LandPixels[pixelY, pixelX]:= LandPixels[pixelY, pixelX] and not AMask or 254 shl AShift; |
156 LandPixels[pixelY, pixelX]:= LandPixels[pixelY, pixelX] and (not AMask) or 254 shl AShift; |
152 end; |
157 end; |
153 end; |
158 end; |
154 |
159 |
155 |
160 |
156 procedure DrawPixelIce(landX, landY, pixelX, pixelY: Longint); inline; |
161 procedure DrawPixelIce(landX, landY, pixelX, pixelY: Longint); inline; |
157 begin |
162 begin |
158 if ((Land[landY, landX] and lfIce) <> 0) then exit; |
163 if ((Land[landY, landX] and lfIce) <> 0) then exit; |
159 if isLandscapeEdge(getPixelWeight(landX, landY)) then |
164 if isLandscapeEdge(getPixelWeight(landX, landY)) then |
160 begin |
165 begin |
161 if (LandPixels[pixelY, pixelX] and AMask < 255) and (LandPixels[pixelY, pixelX] and AMask > 0) then |
166 if (LandPixels[pixelY, pixelX] and AMask < 255) and (LandPixels[pixelY, pixelX] and AMask > 0) then |
162 LandPixels[pixelY, pixelX] := (IceEdgeColor and not AMask) or (LandPixels[pixelY, pixelX] and AMask) |
167 LandPixels[pixelY, pixelX] := (IceEdgeColor and (not AMask)) or (LandPixels[pixelY, pixelX] and AMask) |
163 else if (LandPixels[pixelY, pixelX] and AMask < 255) or (Land[landY, landX] > 255) then |
168 else if (LandPixels[pixelY, pixelX] and AMask < 255) or (Land[landY, landX] > 255) then |
164 LandPixels[pixelY, pixelX] := IceEdgeColor |
169 LandPixels[pixelY, pixelX] := IceEdgeColor |
165 end |
170 end |
166 else if Land[landY, landX] > 255 then |
171 else if Land[landY, landX] > 255 then |
167 begin |
172 begin |
168 fillPixelFromIceSprite(pixelX, pixelY); |
173 fillPixelFromIceSprite(pixelX, pixelY); |
169 end; |
174 end; |
170 if Land[landY, landX] > 255 then Land[landY, landX] := Land[landY, landX] or lfIce and not lfDamaged; |
175 if Land[landY, landX] > 255 then Land[landY, landX] := Land[landY, landX] or lfIce and (not lfDamaged); |
171 end; |
176 end; |
172 |
177 |
173 |
178 |
174 function FillLandCircleLine(y, fromPix, toPix: LongInt; fill : fillType): Longword; |
179 function FillLandCircleLineFT(y, fromPix, toPix: LongInt; fill : fillType): Longword; |
175 var px, py, i: LongInt; |
180 var px, py, i: LongInt; |
176 begin |
181 begin |
177 //get rid of compiler warning |
182 //get rid of compiler warning |
178 px := 0; |
183 px := 0; |
179 py := 0; |
184 py := 0; |
180 FillLandCircleLine := 0; |
185 FillLandCircleLineFT := 0; |
181 case fill of |
186 case fill of |
182 backgroundPixel: |
187 backgroundPixel: |
183 for i:= fromPix to toPix do |
188 for i:= fromPix to toPix do |
184 begin |
189 begin |
185 calculatePixelsCoordinates(i, y, px, py); |
190 calculatePixelsCoordinates(i, y, px, py); |
186 inc(FillLandCircleLine, drawPixelBG(i, y, px, py)); |
191 inc(FillLandCircleLineFT, drawPixelBG(i, y, px, py)); |
187 end; |
192 end; |
188 ebcPixel: |
193 ebcPixel: |
189 for i:= fromPix to toPix do |
194 for i:= fromPix to toPix do |
190 begin |
195 begin |
191 calculatePixelsCoordinates(i, y, px, py); |
196 calculatePixelsCoordinates(i, y, px, py); |
192 drawPixelEBC(i, y, px, py); |
197 drawPixelEBC(i, y, px, py); |
193 end; |
198 end; |
194 nullPixel: |
199 nullPixel: |
195 for i:= fromPix to toPix do |
200 for i:= fromPix to toPix do |
196 begin |
201 begin |
197 calculatePixelsCoordinates(i, y, px, py); |
202 calculatePixelsCoordinates(i, y, px, py); |
198 if ((Land[y, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[y, i] > 255)) then |
203 if ((Land[y, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[y, i] > 255)) then |
199 LandPixels[py, px]:= 0 |
204 LandPixels[py, px]:= ExplosionBorderColorNoA; |
200 end; |
205 end; |
201 icePixel: |
206 icePixel: |
202 for i:= fromPix to toPix do |
207 for i:= fromPix to toPix do |
203 begin |
208 begin |
204 calculatePixelsCoordinates(i, y, px, py); |
209 calculatePixelsCoordinates(i, y, px, py); |
205 DrawPixelIce(i, y, px, py); |
210 DrawPixelIce(i, y, px, py); |
206 end; |
211 end; |
207 setNotCurrentMask: |
212 setNotCurrentMask: |
208 for i:= fromPix to toPix do |
213 for i:= fromPix to toPix do |
209 begin |
214 begin |
210 Land[y, i]:= Land[y, i] and lfNotCurrentMask; |
215 Land[y, i]:= Land[y, i] and lfNotCurrentMask; |
211 end; |
216 end; |
212 changePixelSetNotCurrent: |
217 changePixelSetNotCurrent: |
213 for i:= fromPix to toPix do |
218 for i:= fromPix to toPix do |
214 begin |
219 begin |
215 if Land[y, i] and lfObjMask > 0 then |
220 if Land[y, i] and lfObjMask > 0 then |
216 Land[y, i]:= (Land[y, i] and lfNotObjMask) or ((Land[y, i] and lfObjMask) - 1); |
221 Land[y, i]:= Land[y, i] - 1; |
217 end; |
222 end; |
218 setCurrentHog: |
223 setCurrentHog: |
219 for i:= fromPix to toPix do |
224 for i:= fromPix to toPix do |
220 begin |
225 begin |
221 Land[y, i]:= Land[y, i] or lfCurrentHog |
226 Land[y, i]:= Land[y, i] or lfCurrentHog |
222 end; |
227 end; |
223 changePixelNotSetNotCurrent: |
228 changePixelNotSetNotCurrent: |
224 for i:= fromPix to toPix do |
229 for i:= fromPix to toPix do |
225 begin |
230 begin |
226 if Land[y, i] and lfObjMask < lfObjMask then |
231 if Land[y, i] and lfObjMask < lfObjMask then |
227 Land[y, i]:= (Land[y, i] and lfNotObjMask) or ((Land[y, i] and lfObjMask) + 1) |
232 Land[y, i]:= Land[y, i] + 1 |
228 end; |
233 end; |
229 end; |
234 end; |
230 end; |
235 end; |
231 |
236 |
232 function FillLandCircleSegment(x, y, dx, dy: LongInt; fill : fillType): Longword; inline; |
237 function FillLandCircleSegmentFT(x, y, dx, dy: LongInt; fill : fillType): Longword; inline; |
233 begin |
238 begin |
234 FillLandCircleSegment := 0; |
239 FillLandCircleSegmentFT := 0; |
235 if ((y + dy) and LAND_HEIGHT_MASK) = 0 then |
240 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)); |
241 inc(FillLandCircleSegmentFT, FillLandCircleLineFT(y + dy, Max(x - dx, 0), Min(x + dx, LAND_WIDTH - 1), fill)); |
237 if ((y - dy) and LAND_HEIGHT_MASK) = 0 then |
242 if ((y - dy) and LAND_HEIGHT_MASK) = 0 then |
238 inc(FillLandCircleSegment, FillLandCircleLine(y - dy, Max(x - dx, 0), Min(x + dx, LAND_WIDTH - 1), fill)); |
243 inc(FillLandCircleSegmentFT, FillLandCircleLineFT(y - dy, Max(x - dx, 0), Min(x + dx, LAND_WIDTH - 1), fill)); |
239 if ((y + dx) and LAND_HEIGHT_MASK) = 0 then |
244 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)); |
245 inc(FillLandCircleSegmentFT, FillLandCircleLineFT(y + dx, Max(x - dy, 0), Min(x + dy, LAND_WIDTH - 1), fill)); |
241 if ((y - dx) and LAND_HEIGHT_MASK) = 0 then |
246 if ((y - dx) and LAND_HEIGHT_MASK) = 0 then |
242 inc(FillLandCircleSegment, FillLandCircleLine(y - dx, Max(x - dy, 0), Min(x + dy, LAND_WIDTH - 1), fill)); |
247 inc(FillLandCircleSegmentFT, FillLandCircleLineFT(y - dx, Max(x - dy, 0), Min(x + dy, LAND_WIDTH - 1), fill)); |
243 end; |
248 end; |
244 |
249 |
245 function FillRoundInLand(X, Y, Radius: LongInt; fill: fillType): Longword; inline; |
250 function FillRoundInLandFT(X, Y, Radius: LongInt; fill: fillType): Longword; inline; |
246 var dx, dy, d: LongInt; |
251 var dx, dy, d: LongInt; |
247 begin |
252 begin |
248 dx:= 0; |
253 dx:= 0; |
249 dy:= Radius; |
254 dy:= Radius; |
250 d:= 3 - 2 * Radius; |
255 d:= 3 - 2 * Radius; |
251 FillRoundInLand := 0; |
256 FillRoundInLandFT := 0; |
252 while (dx < dy) do |
257 while (dx < dy) do |
253 begin |
258 begin |
254 inc(FillRoundInLand, FillLandCircleSegment(x, y, dx, dy, fill)); |
259 inc(FillRoundInLandFT, FillLandCircleSegmentFT(x, y, dx, dy, fill)); |
255 if (d < 0) then |
260 if (d < 0) then |
256 d:= d + 4 * dx + 6 |
261 d:= d + 4 * dx + 6 |
257 else |
262 else |
258 begin |
263 begin |
259 d:= d + 4 * (dx - dy) + 10; |
264 d:= d + 4 * (dx - dy) + 10; |
260 dec(dy) |
265 dec(dy) |
261 end; |
266 end; |
262 inc(dx) |
267 inc(dx) |
263 end; |
268 end; |
264 if (dx = dy) then |
269 if (dx = dy) then |
265 inc (FillRoundInLand, FillLandCircleSegment(x, y, dx, dy, fill)); |
270 inc (FillRoundInLandFT, FillLandCircleSegmentFT(x, y, dx, dy, fill)); |
266 end; |
271 end; |
267 |
272 |
268 |
273 |
269 function addBgColor(OldColor, NewColor: LongWord): LongWord; |
274 function addBgColor(OldColor, NewColor: LongWord): LongWord; |
270 // Factor ranges from 0 to 100% NewColor |
275 // Factor ranges from 0 to 100% NewColor |
295 nAlpha := min(255, oAlpha + nAlpha); |
300 nAlpha := min(255, oAlpha + nAlpha); |
296 |
301 |
297 addBgColor := (nAlpha shl AShift) or (nRed shl RShift) or (nGreen shl GShift) or (nBlue shl BShift); |
302 addBgColor := (nAlpha shl AShift) or (nRed shl RShift) or (nGreen shl GShift) or (nBlue shl BShift); |
298 end; |
303 end; |
299 |
304 |
300 procedure FillCircleLines(x, y, dx, dy: LongInt; Value: Longword); |
305 function FillCircleLines(x, y, dx, dy: LongInt; Value: Longword): Longword; |
301 var i: LongInt; |
306 var i: LongInt; |
302 begin |
307 begin |
303 if ((y + dy) and LAND_HEIGHT_MASK) = 0 then |
308 FillCircleLines:= 0; |
304 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
309 |
305 if (Land[y + dy, i] and lfIndestructible) = 0 then |
310 if ((y + dy) and LAND_HEIGHT_MASK) = 0 then |
306 Land[y + dy, i]:= Value; |
311 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
307 if ((y - dy) and LAND_HEIGHT_MASK) = 0 then |
312 if (Land[y + dy, i] and lfIndestructible) = 0 then |
308 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
313 begin |
309 if (Land[y - dy, i] and lfIndestructible) = 0 then |
314 if Land[y + dy, i] <> Value then inc(FillCircleLines); |
310 Land[y - dy, i]:= Value; |
315 Land[y + dy, i]:= Value; |
311 if ((y + dx) and LAND_HEIGHT_MASK) = 0 then |
316 end; |
312 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
317 if ((y - dy) and LAND_HEIGHT_MASK) = 0 then |
313 if (Land[y + dx, i] and lfIndestructible) = 0 then |
318 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
314 Land[y + dx, i]:= Value; |
319 if (Land[y - dy, i] and lfIndestructible) = 0 then |
315 if ((y - dx) and LAND_HEIGHT_MASK) = 0 then |
320 begin |
316 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
321 if Land[y - dy, i] <> Value then inc(FillCircleLines); |
317 if (Land[y - dx, i] and lfIndestructible) = 0 then |
322 Land[y - dy, i]:= Value; |
318 Land[y - dx, i]:= Value; |
323 end; |
319 end; |
324 if ((y + dx) and LAND_HEIGHT_MASK) = 0 then |
320 |
325 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
321 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword); |
326 if (Land[y + dx, i] and lfIndestructible) = 0 then |
|
327 begin |
|
328 if Land[y + dx, i] <> Value then inc(FillCircleLines); |
|
329 Land[y + dx, i]:= Value; |
|
330 end; |
|
331 if ((y - dx) and LAND_HEIGHT_MASK) = 0 then |
|
332 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
333 if (Land[y - dx, i] and lfIndestructible) = 0 then |
|
334 begin |
|
335 if Land[y - dx, i] <> Value then inc(FillCircleLines); |
|
336 Land[y - dx, i]:= Value; |
|
337 end; |
|
338 end; |
|
339 |
|
340 function FillRoundInLand(X, Y, Radius: LongInt; Value: Longword): Longword; |
322 var dx, dy, d: LongInt; |
341 var dx, dy, d: LongInt; |
323 begin |
342 begin |
|
343 FillRoundInLand:= 0; |
324 dx:= 0; |
344 dx:= 0; |
325 dy:= Radius; |
345 dy:= Radius; |
326 d:= 3 - 2 * Radius; |
346 d:= 3 - 2 * Radius; |
327 while (dx < dy) do |
347 while (dx < dy) do |
328 begin |
348 begin |
329 FillCircleLines(x, y, dx, dy, Value); |
349 inc(FillRoundInLand, FillCircleLines(x, y, dx, dy, Value)); |
330 if (d < 0) then |
350 if (d < 0) then |
331 d:= d + 4 * dx + 6 |
351 d:= d + 4 * dx + 6 |
332 else |
352 else |
333 begin |
353 begin |
334 d:= d + 4 * (dx - dy) + 10; |
354 d:= d + 4 * (dx - dy) + 10; |
335 dec(dy) |
355 dec(dy) |
336 end; |
356 end; |
337 inc(dx) |
357 inc(dx) |
338 end; |
358 end; |
339 if (dx = dy) then |
359 if (dx = dy) then |
340 FillCircleLines(x, y, dx, dy, Value); |
360 inc(FillRoundInLand, FillCircleLines(x, y, dx, dy, Value)); |
341 end; |
361 end; |
342 |
362 |
343 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean); |
363 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean); |
344 begin |
364 begin |
345 if not doSet and isCurrent then |
365 if not doSet and isCurrent then |
346 FillRoundInLand(X, Y, Radius, setNotCurrentMask) |
366 FillRoundInLandFT(X, Y, Radius, setNotCurrentMask) |
347 else if not doSet and not IsCurrent then |
367 else if not doSet and (not IsCurrent) then |
348 FillRoundInLand(X, Y, Radius, changePixelSetNotCurrent) |
368 FillRoundInLandFT(X, Y, Radius, changePixelSetNotCurrent) |
349 else if doSet and IsCurrent then |
369 else if doSet and IsCurrent then |
350 FillRoundInLand(X, Y, Radius, setCurrentHog) |
370 FillRoundInLandFT(X, Y, Radius, setCurrentHog) |
351 else if doSet and not IsCurrent then |
371 else if doSet and (not IsCurrent) then |
352 FillRoundInLand(X, Y, Radius, changePixelNotSetNotCurrent); |
372 FillRoundInLandFT(X, Y, Radius, changePixelNotSetNotCurrent); |
353 end; |
373 end; |
354 |
374 |
355 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint); |
375 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint); |
356 var |
376 var |
357 i, j: integer; |
377 i, j, iceL, iceR, IceT, iceB: LongInt; |
358 landRect: TSDL_Rect; |
378 landRect: TSDL_Rect; |
359 begin |
379 begin |
360 for i := min(max(x - iceRadius, 0), LAND_WIDTH - 1) to min(max(x + iceRadius, 0), LAND_WIDTH - 1) do |
380 // figure out bottom/left/right/top coords of ice to draw |
361 begin |
381 |
362 for j := min(max(y, 0), LAND_HEIGHT - 1) to min(max(y + iceHeight, 0), LAND_HEIGHT - 1) do |
382 // determine absolute limits first |
|
383 iceT:= 0; |
|
384 iceB:= min(cWaterLine, LAND_HEIGHT - 1); |
|
385 |
|
386 iceL:= 0; |
|
387 iceR:= LAND_WIDTH - 1; |
|
388 |
|
389 if WorldEdge <> weNone then |
|
390 begin |
|
391 iceL:= max(leftX, iceL); |
|
392 iceR:= min(rightX, iceR); |
|
393 end; |
|
394 |
|
395 // adjust based on location but without violating absolute limits |
|
396 if y >= cWaterLine then |
|
397 begin |
|
398 iceL:= max(x - iceRadius, iceL); |
|
399 iceR:= min(x + iceRadius, iceR); |
|
400 iceT:= max(cWaterLine - iceHeight, iceT); |
|
401 end |
|
402 else {if WorldEdge = weSea then} |
|
403 begin |
|
404 iceT:= max(y - iceRadius, iceT); |
|
405 iceB:= min(y + iceRadius, iceB); |
|
406 if x <= leftX then |
|
407 iceR:= min(leftX + iceHeight, iceR) |
|
408 else {if x >= rightX then} |
|
409 iceL:= max(LongInt(rightX) - iceHeight, iceL); |
|
410 end; |
|
411 |
|
412 // don't continue if all ice is outside land array |
|
413 if (iceL > iceR) or (iceT > iceB) then |
|
414 exit(); |
|
415 |
|
416 for i := iceL to iceR do |
|
417 begin |
|
418 for j := iceT to iceB do |
363 begin |
419 begin |
364 if Land[j, i] = 0 then |
420 if Land[j, i] = 0 then |
365 begin |
421 begin |
366 Land[j, i] := lfIce; |
422 Land[j, i] := lfIce; |
367 fillPixelFromIceSprite(i, j); |
423 if (cReducedQuality and rqBlurryLand) = 0 then |
|
424 fillPixelFromIceSprite(i, j) |
|
425 else |
|
426 fillPixelFromIceSprite(i div 2, j div 2); |
368 end; |
427 end; |
369 end; |
428 end; |
370 end; |
429 end; |
371 landRect.x := min(max(x - iceRadius, 0), LAND_WIDTH - 1); |
430 |
372 landRect.y := min(max(y, 0), LAND_HEIGHT - 1); |
431 landRect.x := iceL; |
373 landRect.w := min(2*iceRadius, LAND_WIDTH - landRect.x - 1); |
432 landRect.y := iceT; |
374 landRect.h := min(iceHeight, LAND_HEIGHT - landRect.y - 1); |
433 landRect.w := iceR - IceL + 1; |
|
434 landRect.h := iceB - iceT + 1; |
|
435 |
375 UpdateLandTexture(landRect.x, landRect.w, landRect.y, landRect.h, true); |
436 UpdateLandTexture(landRect.x, landRect.w, landRect.y, landRect.h, true); |
376 end; |
437 end; |
377 |
438 |
378 function DrawExplosion(X, Y, Radius: LongInt): Longword; |
439 function DrawExplosion(X, Y, Radius: LongInt): Longword; |
379 var |
440 var |
380 tx, ty, dx, dy: Longint; |
441 tx, ty, dx, dy: Longint; |
381 begin |
442 begin |
382 DrawExplosion := FillRoundInLand(x, y, Radius, backgroundPixel); |
443 DrawExplosion := FillRoundInLandFT(x, y, Radius, backgroundPixel); |
383 if Radius > 20 then |
444 if Radius > 20 then |
384 FillRoundInLand(x, y, Radius - 15, nullPixel); |
445 FillRoundInLandFT(x, y, Radius - 15, nullPixel); |
385 FillRoundInLand(X, Y, Radius, 0); |
446 FillRoundInLand(X, Y, Radius, 0); |
386 FillRoundInLand(x, y, Radius + 4, ebcPixel); |
447 FillRoundInLandFT(x, y, Radius + 4, ebcPixel); |
387 tx:= Max(X - Radius - 5, 0); |
448 tx:= Max(X - Radius - 5, 0); |
388 dx:= Min(X + Radius + 5, LAND_WIDTH) - tx; |
449 dx:= Min(X + Radius + 5, LAND_WIDTH) - tx; |
389 ty:= Max(Y - Radius - 5, 0); |
450 ty:= Max(Y - Radius - 5, 0); |
390 dy:= Min(Y + Radius + 5, LAND_HEIGHT) - ty; |
451 dy:= Min(Y + Radius + 5, LAND_HEIGHT) - ty; |
391 UpdateLandTexture(tx, dx, ty, dy, false); |
452 UpdateLandTexture(tx, dx, ty, dy, false); |
455 tx:= hwRound(X); |
516 tx:= hwRound(X); |
456 ty:= hwRound(Y); |
517 ty:= hwRound(Y); |
457 if ((ty and LAND_HEIGHT_MASK) = 0) and ((tx and LAND_WIDTH_MASK) = 0) and (((Land[ty, tx] and lfBasic) <> 0) |
518 if ((ty and LAND_HEIGHT_MASK) = 0) and ((tx and LAND_WIDTH_MASK) = 0) and (((Land[ty, tx] and lfBasic) <> 0) |
458 or ((Land[ty, tx] and lfObject) <> 0)) then |
519 or ((Land[ty, tx] and lfObject) <> 0)) then |
459 begin |
520 begin |
460 Land[ty, tx]:= (Land[ty, tx] or lfDamaged) and not lfIce; |
521 Land[ty, tx]:= (Land[ty, tx] or lfDamaged) and (not lfIce); |
461 if despeckle then |
522 if despeckle then |
462 LandDirty[ty div 32, tx div 32]:= 1; |
523 LandDirty[ty div 32, tx div 32]:= 1; |
463 if (cReducedQuality and rqBlurryLand) = 0 then |
524 if (cReducedQuality and rqBlurryLand) = 0 then |
464 LandPixels[ty, tx]:= ExplosionBorderColor |
525 LandPixels[ty, tx]:= ExplosionBorderColor |
465 else |
526 else |
466 LandPixels[ty div 2, tx div 2]:= ExplosionBorderColor |
527 LandPixels[ty div 2, tx div 2]:= ExplosionBorderColor |
467 end |
528 end |
468 end; |
529 end; |
469 end; |
530 end; |
470 |
531 |
|
532 type TWrapNeeded = (wnNone, wnLeft, wnRight); |
471 |
533 |
472 // |
534 // |
473 // - (dX, dY) - direction, vector of length = 0.5 |
535 // - (dX, dY) - direction, vector of length = 0.5 |
474 // |
536 // |
475 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt); |
537 function DrawTunnel_real(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt): TWrapNeeded; |
476 var nx, ny, dX8, dY8: hwFloat; |
538 var nx, ny, dX8, dY8: hwFloat; |
477 i, t, tx, ty, by, bx, stX, stY, ddy, ddx: Longint; |
539 i, t, tx, ty, by, bx, stX, stY, ddy, ddx: Longint; |
478 despeckle : Boolean; |
540 despeckle : Boolean; |
479 begin // (-dY, dX) is (dX, dY) rotated by PI/2 |
541 begin // (-dY, dX) is (dX, dY) rotated by PI/2 |
|
542 DrawTunnel_real:= wnNone; |
|
543 |
480 stY:= hwRound(Y); |
544 stY:= hwRound(Y); |
481 stX:= hwRound(X); |
545 stX:= hwRound(X); |
482 |
546 |
483 despeckle:= HalfWidth > 1; |
547 despeckle:= HalfWidth > 1; |
484 |
548 |
576 end; |
640 end; |
577 nx:= nx - dY; |
641 nx:= nx - dY; |
578 ny:= ny + dX; |
642 ny:= ny + dX; |
579 end; |
643 end; |
580 |
644 |
581 tx:= Max(stX - HalfWidth * 2 - 4 - abs(hwRound(dX * ticks)), 0); |
645 tx:= stX - HalfWidth * 2 - 4 - abs(hwRound(dX * ticks)); |
|
646 ddx:= stX + HalfWidth * 2 + 4 + abs(hwRound(dX * ticks)); |
|
647 |
|
648 if WorldEdge = weWrap then |
|
649 begin |
|
650 if (tx < leftX) or (ddx < leftX) then |
|
651 DrawTunnel_real:= wnLeft |
|
652 else if (tx > rightX) or (ddx > rightX) then |
|
653 DrawTunnel_real:= wnRight; |
|
654 end; |
|
655 |
|
656 tx:= Max(tx, 0); |
582 ty:= Max(stY - HalfWidth * 2 - 4 - abs(hwRound(dY * ticks)), 0); |
657 ty:= Max(stY - HalfWidth * 2 - 4 - abs(hwRound(dY * ticks)), 0); |
583 ddx:= Min(stX + HalfWidth * 2 + 4 + abs(hwRound(dX * ticks)), LAND_WIDTH) - tx; |
658 ddx:= Min(ddx, LAND_WIDTH) - tx; |
584 ddy:= Min(stY + HalfWidth * 2 + 4 + abs(hwRound(dY * ticks)), LAND_HEIGHT) - ty; |
659 ddy:= Min(stY + HalfWidth * 2 + 4 + abs(hwRound(dY * ticks)), LAND_HEIGHT) - ty; |
585 |
660 |
586 UpdateLandTexture(tx, ddx, ty, ddy, false) |
661 UpdateLandTexture(tx, ddx, ty, ddy, false) |
587 end; |
662 end; |
588 |
663 |
589 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace, indestructible: boolean): boolean; inline; |
664 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt); |
590 begin |
665 var wn: TWrapNeeded; |
591 TryPlaceOnLand:= TryPlaceOnLand(cpX, cpY, Obj, Frame, doPlace, indestructible, 0); |
666 begin |
592 end; |
667 wn:= DrawTunnel_real(X, Y, dX, dY, ticks, HalfWidth); |
593 |
668 if wn <> wnNone then |
594 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace, indestructible: boolean; LandFlags: Word): boolean; |
669 begin |
|
670 if wn = wnLeft then |
|
671 DrawTunnel_real(X + int2hwFloat(playWidth), Y, dX, dY, ticks, HalfWidth) |
|
672 else |
|
673 DrawTunnel_real(X - int2hwFloat(playWidth), Y, dX, dY, ticks, HalfWidth); |
|
674 end; |
|
675 end; |
|
676 |
|
677 function TryPlaceOnLandSimple(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace, indestructible: boolean): boolean; inline; |
|
678 var lf: Word; |
|
679 begin |
|
680 if indestructible then |
|
681 lf:= lfIndestructible |
|
682 else |
|
683 lf:= 0; |
|
684 TryPlaceOnLandSimple:= TryPlaceOnLand(cpX, cpY, Obj, Frame, doPlace, false, false, false, false, false, lf, $FFFFFFFF); |
|
685 end; |
|
686 |
|
687 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean; LandFlags: Word): boolean; inline; |
|
688 begin |
|
689 TryPlaceOnLand:= TryPlaceOnLand(cpX, cpY, Obj, Frame, doPlace, false, false, false, false, false, LandFlags, $FFFFFFFF); |
|
690 end; |
|
691 |
|
692 function ForcePlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; LandFlags: Word; Tint: LongWord; Behind, flipHoriz, flipVert: boolean): boolean; inline; |
|
693 begin |
|
694 ForcePlaceOnLand:= TryPlaceOnLand(cpX, cpY, Obj, Frame, true, false, true, behind, flipHoriz, flipVert, LandFlags, Tint) |
|
695 end; |
|
696 |
|
697 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace, outOfMap, force, behind, flipHoriz, flipVert: boolean; LandFlags: Word; Tint: LongWord): boolean; |
595 var X, Y, bpp, h, w, row, col, gx, gy, numFramesFirstCol: LongInt; |
698 var X, Y, bpp, h, w, row, col, gx, gy, numFramesFirstCol: LongInt; |
596 p: PByteArray; |
699 p: PByteArray; |
597 Image: PSDL_Surface; |
700 Image: PSDL_Surface; |
|
701 pixel: LongWord; |
598 begin |
702 begin |
599 TryPlaceOnLand:= false; |
703 TryPlaceOnLand:= false; |
600 numFramesFirstCol:= SpritesData[Obj].imageHeight div SpritesData[Obj].Height; |
704 numFramesFirstCol:= SpritesData[Obj].imageHeight div SpritesData[Obj].Height; |
601 |
705 |
|
706 if outOfMap then doPlace:= false; // just using for a check |
|
707 |
602 TryDo(SpritesData[Obj].Surface <> nil, 'Assert SpritesData[Obj].Surface failed', true); |
708 TryDo(SpritesData[Obj].Surface <> nil, 'Assert SpritesData[Obj].Surface failed', true); |
|
709 |
603 Image:= SpritesData[Obj].Surface; |
710 Image:= SpritesData[Obj].Surface; |
604 w:= SpritesData[Obj].Width; |
711 w:= SpritesData[Obj].Width; |
605 h:= SpritesData[Obj].Height; |
712 h:= SpritesData[Obj].Height; |
|
713 if flipVert then flipSurface(Image, true); |
|
714 if flipHoriz then flipSurface(Image, false); |
606 row:= Frame mod numFramesFirstCol; |
715 row:= Frame mod numFramesFirstCol; |
607 col:= Frame div numFramesFirstCol; |
716 col:= Frame div numFramesFirstCol; |
608 |
717 |
609 if SDL_MustLock(Image) then |
718 if SDL_MustLock(Image) then |
610 SDLTry(SDL_LockSurface(Image) >= 0, 'SDL_LockSurface', true); |
719 SDLTry(SDL_LockSurface(Image) >= 0, 'TryPlaceOnLand', true); |
611 |
720 |
612 bpp:= Image^.format^.BytesPerPixel; |
721 bpp:= Image^.format^.BytesPerPixel; |
613 TryDo(bpp = 4, 'It should be 32 bpp sprite', true); |
722 TryDo(bpp = 4, 'It should be 32 bpp sprite', true); |
614 // Check that sprite fits free space |
723 // Check that sprite fits free space |
615 p:= @(PByteArray(Image^.pixels)^[ Image^.pitch * row * h + col * w * 4 ]); |
724 p:= PByteArray(@(PByteArray(Image^.pixels)^[ Image^.pitch * row * h + col * w * 4 ])); |
616 case bpp of |
725 case bpp of |
617 4: for y:= 0 to Pred(h) do |
726 4: for y:= 0 to Pred(h) do |
618 begin |
727 begin |
619 for x:= 0 to Pred(w) do |
728 for x:= 0 to Pred(w) do |
620 if (PLongword(@(p^[x * 4]))^) <> 0 then |
729 if ((PLongword(@(p^[x * 4]))^) and AMask) <> 0 then |
621 if ((cpY + y) <= Longint(topY)) or ((cpY + y) >= LAND_HEIGHT) or |
730 if (outOfMap and |
622 ((cpX + x) <= Longint(leftX)) or ((cpX + x) >= Longint(rightX)) or (Land[cpY + y, cpX + x] <> 0) then |
731 ((cpY + y) < LAND_HEIGHT) and ((cpY + y) >= 0) and |
623 begin |
732 ((cpX + x) < LAND_WIDTH) and ((cpX + x) >= 0) and |
624 if SDL_MustLock(Image) then |
733 ((not force) and (Land[cpY + y, cpX + x] <> 0))) or |
625 SDL_UnlockSurface(Image); |
734 |
626 exit; |
735 (not outOfMap and |
627 end; |
736 (((cpY + y) <= Longint(topY)) or ((cpY + y) >= LAND_HEIGHT) or |
628 p:= @(p^[Image^.pitch]); |
737 ((cpX + x) <= Longint(leftX)) or ((cpX + x) >= Longint(rightX)) or |
629 end; |
738 ((not force) and (Land[cpY + y, cpX + x] <> 0)))) then |
|
739 begin |
|
740 if SDL_MustLock(Image) then |
|
741 SDL_UnlockSurface(Image); |
|
742 exit |
|
743 end; |
|
744 p:= PByteArray(@(p^[Image^.pitch])) |
|
745 end |
630 end; |
746 end; |
631 |
747 |
632 TryPlaceOnLand:= true; |
748 TryPlaceOnLand:= true; |
633 if not doPlace then |
749 if not doPlace then |
634 begin |
750 begin |
636 SDL_UnlockSurface(Image); |
752 SDL_UnlockSurface(Image); |
637 exit |
753 exit |
638 end; |
754 end; |
639 |
755 |
640 // Checked, now place |
756 // Checked, now place |
641 p:= @(PByteArray(Image^.pixels)^[ Image^.pitch * row * h + col * w * 4 ]); |
757 p:= PByteArray(@(PByteArray(Image^.pixels)^[ Image^.pitch * row * h + col * w * 4 ])); |
642 case bpp of |
758 case bpp of |
643 4: for y:= 0 to Pred(h) do |
759 4: for y:= 0 to Pred(h) do |
644 begin |
760 begin |
645 for x:= 0 to Pred(w) do |
761 for x:= 0 to Pred(w) do |
646 if (PLongword(@(p^[x * 4]))^) <> 0 then |
762 if ((PLongword(@(p^[x * 4]))^) and AMask) <> 0 then |
647 begin |
763 begin |
648 if (cReducedQuality and rqBlurryLand) = 0 then |
764 if (cReducedQuality and rqBlurryLand) = 0 then |
649 begin |
765 begin |
650 gX:= cpX + x; |
766 gX:= cpX + x; |
651 gY:= cpY + y; |
767 gY:= cpY + y; |
652 end |
768 end |
653 else |
769 else |
654 begin |
770 begin |
655 gX:= (cpX + x) div 2; |
771 gX:= (cpX + x) div 2; |
656 gY:= (cpY + y) div 2; |
772 gY:= (cpY + y) div 2; |
657 end; |
773 end; |
658 if indestructible then |
774 if not behind or (Land[cpY + y, cpX + x] and lfLandMask = 0) then |
659 Land[cpY + y, cpX + x]:= lfIndestructible or LandFlags |
775 begin |
660 else if (LandPixels[gY, gX] and AMask) shr AShift = 255 then // This test assumes lfBasic and lfObject differ only graphically |
776 if (LandFlags and lfBasic <> 0) or |
661 Land[cpY + y, cpX + x]:= lfBasic or LandFlags |
777 (((LandPixels[gY, gX] and AMask) shr AShift = 255) and // This test assumes lfBasic and lfObject differ only graphically |
662 else |
778 (LandFlags or lfObject = 0)) then |
663 Land[cpY + y, cpX + x]:= lfObject or LandFlags; |
779 Land[cpY + y, cpX + x]:= lfBasic or LandFlags |
664 LandPixels[gY, gX]:= PLongword(@(p^[x * 4]))^ |
780 else Land[cpY + y, cpX + x]:= lfObject or LandFlags |
|
781 end; |
|
782 if not behind or (LandPixels[gY, gX] = 0) then |
|
783 begin |
|
784 if tint = $FFFFFFFF then |
|
785 LandPixels[gY, gX]:= PLongword(@(p^[x * 4]))^ |
|
786 else |
|
787 begin |
|
788 pixel:= PLongword(@(p^[x * 4]))^; |
|
789 LandPixels[gY, gX]:= |
|
790 ceil((pixel shr RShift and $FF) * ((tint shr 24) / 255)) shl RShift or |
|
791 ceil((pixel shr GShift and $FF) * ((tint shr 16 and $ff) / 255)) shl GShift or |
|
792 ceil((pixel shr BShift and $FF) * ((tint shr 8 and $ff) / 255)) shl BShift or |
|
793 ceil((pixel shr AShift and $FF) * ((tint and $ff) / 255)) shl AShift; |
|
794 end |
|
795 end |
665 end; |
796 end; |
666 p:= @(p^[Image^.pitch]); |
797 p:= PByteArray(@(p^[Image^.pitch])); |
667 end; |
798 end; |
668 end; |
799 end; |
669 if SDL_MustLock(Image) then |
800 if SDL_MustLock(Image) then |
670 SDL_UnlockSurface(Image); |
801 SDL_UnlockSurface(Image); |
|
802 |
|
803 if flipVert then flipSurface(Image, true); |
|
804 if flipHoriz then flipSurface(Image, false); |
|
805 |
|
806 x:= Max(cpX, leftX); |
|
807 w:= Min(cpX + Image^.w, LAND_WIDTH) - x; |
|
808 y:= Max(cpY, topY); |
|
809 h:= Min(cpY + Image^.h, LAND_HEIGHT) - y; |
|
810 UpdateLandTexture(x, w, y, h, true); |
|
811 |
|
812 ScriptCall('onSpritePlacement', ord(Obj), cpX + w div 2, cpY + h div 2); |
|
813 if Obj = sprAmGirder then |
|
814 ScriptCall('onGirderPlacement', frame, cpX + w div 2, cpY + h div 2) |
|
815 else if Obj = sprAmRubber then |
|
816 ScriptCall('onRubberPlacement', frame, cpX + w div 2, cpY + h div 2); |
|
817 |
|
818 end; |
|
819 |
|
820 procedure EraseLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; LandFlags: Word; eraseOnLFMatch, onlyEraseLF, flipHoriz, flipVert: boolean); |
|
821 var X, Y, bpp, h, w, row, col, gx, gy, numFramesFirstCol: LongInt; |
|
822 p: PByteArray; |
|
823 Image: PSDL_Surface; |
|
824 begin |
|
825 numFramesFirstCol:= SpritesData[Obj].imageHeight div SpritesData[Obj].Height; |
|
826 |
|
827 TryDo(SpritesData[Obj].Surface <> nil, 'Assert SpritesData[Obj].Surface failed', true); |
|
828 |
|
829 Image:= SpritesData[Obj].Surface; |
|
830 w:= SpritesData[Obj].Width; |
|
831 h:= SpritesData[Obj].Height; |
|
832 if flipVert then flipSurface(Image, true); |
|
833 if flipHoriz then flipSurface(Image, false); |
|
834 row:= Frame mod numFramesFirstCol; |
|
835 col:= Frame div numFramesFirstCol; |
|
836 |
|
837 if SDL_MustLock(Image) then |
|
838 SDLTry(SDL_LockSurface(Image) >= 0, 'EraseLand', true); |
|
839 |
|
840 bpp:= Image^.format^.BytesPerPixel; |
|
841 TryDo(bpp = 4, 'It should be 32 bpp sprite', true); |
|
842 // Check that sprite fits free space |
|
843 p:= PByteArray(@(PByteArray(Image^.pixels)^[ Image^.pitch * row * h + col * w * 4 ])); |
|
844 case bpp of |
|
845 4: for y:= 0 to Pred(h) do |
|
846 begin |
|
847 for x:= 0 to Pred(w) do |
|
848 if ((PLongword(@(p^[x * 4]))^) and AMask) <> 0 then |
|
849 if ((cpY + y) <= Longint(topY)) or ((cpY + y) >= LAND_HEIGHT) or |
|
850 ((cpX + x) <= Longint(leftX)) or ((cpX + x) >= Longint(rightX)) then |
|
851 begin |
|
852 if SDL_MustLock(Image) then |
|
853 SDL_UnlockSurface(Image); |
|
854 exit |
|
855 end; |
|
856 p:= PByteArray(@(p^[Image^.pitch])) |
|
857 end |
|
858 end; |
|
859 |
|
860 // Checked, now place |
|
861 p:= PByteArray(@(PByteArray(Image^.pixels)^[ Image^.pitch * row * h + col * w * 4 ])); |
|
862 case bpp of |
|
863 4: for y:= 0 to Pred(h) do |
|
864 begin |
|
865 for x:= 0 to Pred(w) do |
|
866 if ((PLongword(@(p^[x * 4]))^) and AMask) <> 0 then |
|
867 begin |
|
868 if (cReducedQuality and rqBlurryLand) = 0 then |
|
869 begin |
|
870 gX:= cpX + x; |
|
871 gY:= cpY + y; |
|
872 end |
|
873 else |
|
874 begin |
|
875 gX:= (cpX + x) div 2; |
|
876 gY:= (cpY + y) div 2; |
|
877 end; |
|
878 if (not eraseOnLFMatch or (Land[cpY + y, cpX + x] and LandFlags <> 0)) and |
|
879 ((PLongword(@(p^[x * 4]))^) and AMask <> 0) then |
|
880 begin |
|
881 if not onlyEraseLF then |
|
882 begin |
|
883 LandPixels[gY, gX]:= 0; |
|
884 Land[cpY + y, cpX + x]:= 0 |
|
885 end |
|
886 else Land[cpY + y, cpX + x]:= Land[cpY + y, cpX + x] and (not LandFlags) |
|
887 end |
|
888 end; |
|
889 p:= PByteArray(@(p^[Image^.pitch])); |
|
890 end; |
|
891 end; |
|
892 if SDL_MustLock(Image) then |
|
893 SDL_UnlockSurface(Image); |
|
894 |
|
895 if flipVert then flipSurface(Image, true); |
|
896 if flipHoriz then flipSurface(Image, false); |
671 |
897 |
672 x:= Max(cpX, leftX); |
898 x:= Max(cpX, leftX); |
673 w:= Min(cpX + Image^.w, LAND_WIDTH) - x; |
899 w:= Min(cpX + Image^.w, LAND_WIDTH) - x; |
674 y:= Max(cpY, topY); |
900 y:= Max(cpY, topY); |
675 h:= Min(cpY + Image^.h, LAND_HEIGHT) - y; |
901 h:= Min(cpY + Image^.h, LAND_HEIGHT) - y; |
676 UpdateLandTexture(x, w, y, h, true) |
902 UpdateLandTexture(x, w, y, h, true) |
677 end; |
903 end; |
678 |
904 |
|
905 function GetPlaceCollisionTex(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt): PTexture; |
|
906 var X, Y, bpp, h, w, row, col, numFramesFirstCol: LongInt; |
|
907 p, pt: PLongWordArray; |
|
908 Image, finalSurface: PSDL_Surface; |
|
909 begin |
|
910 GetPlaceCollisionTex:= nil; |
|
911 numFramesFirstCol:= SpritesData[Obj].imageHeight div SpritesData[Obj].Height; |
|
912 |
|
913 TryDo(SpritesData[Obj].Surface <> nil, 'Assert SpritesData[Obj].Surface failed', true); |
|
914 Image:= SpritesData[Obj].Surface; |
|
915 w:= SpritesData[Obj].Width; |
|
916 h:= SpritesData[Obj].Height; |
|
917 row:= Frame mod numFramesFirstCol; |
|
918 col:= Frame div numFramesFirstCol; |
|
919 |
|
920 if SDL_MustLock(Image) then |
|
921 SDLTry(SDL_LockSurface(Image) >= 0, 'SDL_LockSurface', true); |
|
922 |
|
923 bpp:= Image^.format^.BytesPerPixel; |
|
924 TryDo(bpp = 4, 'It should be 32 bpp sprite', true); |
|
925 |
|
926 |
|
927 |
|
928 finalSurface:= SDL_CreateRGBSurface(SDL_SWSURFACE, w, h, 32, RMask, GMask, BMask, AMask); |
|
929 |
|
930 TryDo(finalSurface <> nil, 'GetPlaceCollisionTex: fail to create surface', true); |
|
931 |
|
932 if SDL_MustLock(finalSurface) then |
|
933 SDLTry(SDL_LockSurface(finalSurface) >= 0, 'GetPlaceCollisionTex', true); |
|
934 |
|
935 p:= PLongWordArray(@(PLongWordArray(Image^.pixels)^[ (Image^.pitch div 4) * row * h + col * w ])); |
|
936 pt:= PLongWordArray(finalSurface^.pixels); |
|
937 |
|
938 for y:= 0 to Pred(h) do |
|
939 begin |
|
940 for x:= 0 to Pred(w) do |
|
941 if ((p^[x] and AMask) <> 0) |
|
942 and (((cpY + y) < Longint(topY)) or ((cpY + y) >= LAND_HEIGHT) or |
|
943 ((cpX + x) < Longint(leftX)) or ((cpX + x) > Longint(rightX)) or (Land[cpY + y, cpX + x] <> 0)) then |
|
944 pt^[x]:= cWhiteColor |
|
945 else |
|
946 (pt^[x]):= cWhiteColor and (not AMask); |
|
947 p:= PLongWordArray(@(p^[Image^.pitch div 4])); |
|
948 pt:= PLongWordArray(@(pt^[finalSurface^.pitch div 4])); |
|
949 end; |
|
950 |
|
951 if SDL_MustLock(Image) then |
|
952 SDL_UnlockSurface(Image); |
|
953 |
|
954 if SDL_MustLock(finalSurface) then |
|
955 SDL_UnlockSurface(finalSurface); |
|
956 |
|
957 GetPlaceCollisionTex:= Surface2Tex(finalSurface, true); |
|
958 |
|
959 SDL_FreeSurface(finalSurface); |
|
960 end; |
|
961 |
|
962 |
679 function Despeckle(X, Y: LongInt): boolean; |
963 function Despeckle(X, Y: LongInt): boolean; |
680 var nx, ny, i, j, c, xx, yy: LongInt; |
964 var nx, ny, i, j, c, xx, yy: LongInt; |
681 pixelsweep: boolean; |
965 pixelsweep: boolean; |
|
966 |
682 begin |
967 begin |
683 Despeckle:= true; |
968 Despeckle:= true; |
684 |
969 |
685 if (cReducedQuality and rqBlurryLand) = 0 then |
970 if (cReducedQuality and rqBlurryLand) = 0 then |
686 begin |
971 begin |
780 LandPixels[y,x]:= |
1131 LandPixels[y,x]:= |
781 (((((LandPixels[y,x] and RMask shr RShift) * 3 div 4)+((ExplosionBorderColor and RMask) shr RShift) div 4) and $FF) shl RShift) or |
1132 (((((LandPixels[y,x] and RMask shr RShift) * 3 div 4)+((ExplosionBorderColor and RMask) shr RShift) div 4) and $FF) shl RShift) or |
782 (((((LandPixels[y,x] and GMask shr GShift) * 3 div 4)+((ExplosionBorderColor and GMask) shr GShift) div 4) and $FF) shl GShift) or |
1133 (((((LandPixels[y,x] and GMask shr GShift) * 3 div 4)+((ExplosionBorderColor and GMask) shr GShift) div 4) and $FF) shl GShift) or |
783 (((((LandPixels[y,x] and BMask shr BShift) * 3 div 4)+((ExplosionBorderColor and BMask) shr BShift) div 4) and $FF) shl BShift) or ($FF shl AShift) |
1134 (((((LandPixels[y,x] and BMask shr BShift) * 3 div 4)+((ExplosionBorderColor and BMask) shr BShift) div 4) and $FF) shl BShift) or ($FF shl AShift) |
784 end; |
1135 end; |
|
1136 { |
785 if (Land[y, x-1] = lfObject) then |
1137 if (Land[y, x-1] = lfObject) then |
786 Land[y, x]:= lfObject |
1138 Land[y, x]:= lfObject |
787 else if (Land[y, x+1] = lfObject) then |
1139 else if (Land[y, x+1] = lfObject) then |
788 Land[y, x]:= lfObject |
1140 Land[y, x]:= lfObject |
789 else if (Land[y+1, x] = lfObject) then |
1141 else if (Land[y+1, x] = lfObject) then |
790 Land[y, x]:= lfObject |
1142 Land[y, x]:= lfObject |
791 else if (Land[y-1, x] = lfObject) then |
1143 else if (Land[y-1, x] = lfObject) then |
792 Land[y, x]:= lfObject |
1144 Land[y, x]:= lfObject |
793 else Land[y,x]:= lfBasic |
1145 else Land[y,x]:= lfBasic |
|
1146 } |
794 end |
1147 end |
795 end |
1148 end |
796 else if ((cReducedQuality and rqBlurryLand) = 0) and (LandPixels[Y, X] and AMask = 255) |
1149 else if ((cReducedQuality and rqBlurryLand) = 0) and ((LandPixels[Y, X] and AMask) = AMask) |
797 and (Land[Y, X] and (lfDamaged or lfBasic) = lfBasic) |
1150 and (Land[Y, X] and (lfDamaged or lfBasic) = lfBasic) |
798 and (Y > LongInt(topY) + 1) and (Y < LAND_HEIGHT-2) and (X > LongInt(leftX) + 1) and (X < LongInt(rightX) - 1) then |
1151 and (Y > LongInt(topY) + 1) and (Y < LAND_HEIGHT-2) and (X > LongInt(leftX) + 1) and (X < LongInt(rightX) - 1) then |
799 begin |
1152 begin |
800 if ((((Land[y, x-1] and lfDamaged) <> 0) and (((Land[y+1,x] and lfDamaged) <> 0)) or ((Land[y-1,x] and lfDamaged) <> 0)) |
1153 if ((((Land[y, x-1] and lfDamaged) <> 0) and (((Land[y+1,x] and lfDamaged) <> 0)) or ((Land[y-1,x] and lfDamaged) <> 0)) |
801 or (((Land[y, x+1] and lfDamaged) <> 0) and (((Land[y-1,x] and lfDamaged) <> 0) or ((Land[y+1,x] and lfDamaged) <> 0)))) then |
1154 or (((Land[y, x+1] and lfDamaged) <> 0) and (((Land[y-1,x] and lfDamaged) <> 0) or ((Land[y+1,x] and lfDamaged) <> 0)))) then |
975 if ((x and LAND_WIDTH_MASK) = 0) and ((y and LAND_HEIGHT_MASK) = 0) then |
1334 if ((x and LAND_WIDTH_MASK) = 0) and ((y and LAND_HEIGHT_MASK) = 0) then |
976 Land[y, x]:= Color; |
1335 Land[y, x]:= Color; |
977 end |
1336 end |
978 end; |
1337 end; |
979 |
1338 |
980 procedure DrawDots(x, y, xx, yy: Longint; Color: Longword); inline; |
1339 function DrawDots(x, y, xx, yy: Longint; Color: Longword): Longword; inline; |
981 begin |
1340 begin |
982 if (((x + xx) and LAND_WIDTH_MASK) = 0) and (((y + yy) and LAND_HEIGHT_MASK) = 0) then Land[y + yy, x + xx]:= Color; |
1341 DrawDots:= 0; |
983 if (((x + xx) and LAND_WIDTH_MASK) = 0) and (((y - yy) and LAND_HEIGHT_MASK) = 0) then Land[y - yy, x + xx]:= Color; |
1342 |
984 if (((x - xx) and LAND_WIDTH_MASK) = 0) and (((y + yy) and LAND_HEIGHT_MASK) = 0) then Land[y + yy, x - xx]:= Color; |
1343 if (((x + xx) and LAND_WIDTH_MASK) = 0) and (((y + yy) and LAND_HEIGHT_MASK) = 0) and (Land[y + yy, x + xx] <> Color) then |
985 if (((x - xx) and LAND_WIDTH_MASK) = 0) and (((y - yy) and LAND_HEIGHT_MASK) = 0) then Land[y - yy, x - xx]:= Color; |
1344 begin inc(DrawDots); Land[y + yy, x + xx]:= Color; end; |
986 if (((x + yy) and LAND_WIDTH_MASK) = 0) and (((y + xx) and LAND_HEIGHT_MASK) = 0) then Land[y + xx, x + yy]:= Color; |
1345 if (((x + xx) and LAND_WIDTH_MASK) = 0) and (((y - yy) and LAND_HEIGHT_MASK) = 0) and (Land[y - yy, x + xx] <> Color) then |
987 if (((x + yy) and LAND_WIDTH_MASK) = 0) and (((y - xx) and LAND_HEIGHT_MASK) = 0) then Land[y - xx, x + yy]:= Color; |
1346 begin inc(DrawDots); Land[y - yy, x + xx]:= Color; end; |
988 if (((x - yy) and LAND_WIDTH_MASK) = 0) and (((y + xx) and LAND_HEIGHT_MASK) = 0) then Land[y + xx, x - yy]:= Color; |
1347 if (((x - xx) and LAND_WIDTH_MASK) = 0) and (((y + yy) and LAND_HEIGHT_MASK) = 0) and (Land[y + yy, x - xx] <> Color) then |
989 if (((x - yy) and LAND_WIDTH_MASK) = 0) and (((y - xx) and LAND_HEIGHT_MASK) = 0) then Land[y - xx, x - yy]:= Color; |
1348 begin inc(DrawDots); Land[y + yy, x - xx]:= Color; end; |
990 end; |
1349 if (((x - xx) and LAND_WIDTH_MASK) = 0) and (((y - yy) and LAND_HEIGHT_MASK) = 0) and (Land[y - yy, x - xx] <> Color) then |
991 |
1350 begin inc(DrawDots); Land[y - yy, x - xx]:= Color; end; |
992 procedure DrawLines(X1, Y1, X2, Y2, XX, YY: LongInt; color: Longword); |
1351 if (((x + yy) and LAND_WIDTH_MASK) = 0) and (((y + xx) and LAND_HEIGHT_MASK) = 0) and (Land[y + xx, x + yy] <> Color) then |
|
1352 begin inc(DrawDots); Land[y + xx, x + yy]:= Color; end; |
|
1353 if (((x + yy) and LAND_WIDTH_MASK) = 0) and (((y - xx) and LAND_HEIGHT_MASK) = 0) and (Land[y - xx, x + yy] <> Color) then |
|
1354 begin inc(DrawDots); Land[y - xx, x + yy]:= Color; end; |
|
1355 if (((x - yy) and LAND_WIDTH_MASK) = 0) and (((y + xx) and LAND_HEIGHT_MASK) = 0) and (Land[y + xx, x - yy] <> Color) then |
|
1356 begin inc(DrawDots); Land[y + xx, x - yy]:= Color; end; |
|
1357 if (((x - yy) and LAND_WIDTH_MASK) = 0) and (((y - xx) and LAND_HEIGHT_MASK) = 0) and (Land[y - xx, x - yy] <> Color) then |
|
1358 begin inc(DrawDots); Land[y - xx, x - yy]:= Color; end; |
|
1359 end; |
|
1360 |
|
1361 function DrawLines(X1, Y1, X2, Y2, XX, YY: LongInt; color: Longword): Longword; |
993 var |
1362 var |
994 eX, eY, dX, dY: LongInt; |
1363 eX, eY, dX, dY: LongInt; |
995 i, sX, sY, x, y, d: LongInt; |
1364 i, sX, sY, x, y, d: LongInt; |
996 f: boolean; |
1365 f: boolean; |
997 begin |
1366 begin |
998 eX:= 0; |
1367 eX:= 0; |
999 eY:= 0; |
1368 eY:= 0; |
1000 dX:= X2 - X1; |
1369 dX:= X2 - X1; |
1001 dY:= Y2 - Y1; |
1370 dY:= Y2 - Y1; |
|
1371 DrawLines:= 0; |
1002 |
1372 |
1003 if (dX > 0) then |
1373 if (dX > 0) then |
1004 sX:= 1 |
1374 sX:= 1 |
1005 else |
1375 else |
1006 if (dX < 0) then |
1376 if (dX < 0) then |