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); |
39 procedure FillRoundInLandWithIce(X, Y, Radius: LongInt); |
43 function FillRoundInLand(X, Y, Radius: LongInt; fill: fillType): LongWord; |
40 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean); |
44 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean); |
41 function LandBackPixel(x, y: LongInt): LongWord; |
45 function LandBackPixel(x, y: LongInt): LongWord; |
42 procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword); |
46 procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword); |
43 procedure DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword); |
47 procedure DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword); |
44 procedure DumpLandToLog(x, y, r: LongInt); |
48 procedure DumpLandToLog(x, y, r: LongInt); |
45 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint); |
49 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint); |
46 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; |
47 |
51 |
48 implementation |
52 implementation |
49 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 |
50 |
266 |
51 function addBgColor(OldColor, NewColor: LongWord): LongWord; |
267 function addBgColor(OldColor, NewColor: LongWord): LongWord; |
52 // Factor ranges from 0 to 100% NewColor |
268 // Factor ranges from 0 to 100% NewColor |
53 var |
269 var |
54 oRed, oBlue, oGreen, oAlpha, nRed, nBlue, nGreen, nAlpha: byte; |
270 oRed, oBlue, oGreen, oAlpha, nRed, nBlue, nGreen, nAlpha: byte; |
98 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 |
99 if (Land[y - dx, i] and lfIndestructible) = 0 then |
315 if (Land[y - dx, i] and lfIndestructible) = 0 then |
100 Land[y - dx, i]:= Value; |
316 Land[y - dx, i]:= Value; |
101 end; |
317 end; |
102 |
318 |
103 procedure ChangeCircleLines(x, y, dx, dy: LongInt; doSet, isCurrent: boolean); |
|
104 var i: LongInt; |
|
105 begin |
|
106 if not doSet then |
|
107 begin |
|
108 if ((y + dy) and LAND_HEIGHT_MASK) = 0 then |
|
109 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
|
110 if isCurrent then |
|
111 Land[y + dy, i]:= Land[y + dy, i] and lfNotCurrentMask |
|
112 else if Land[y + dy, i] and lfObjMask > 0 then |
|
113 Land[y + dy, i]:= (Land[y + dy, i] and lfNotObjMask) or ((Land[y + dy, i] and lfObjMask) - 1); |
|
114 if ((y - dy) and LAND_HEIGHT_MASK) = 0 then |
|
115 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
|
116 if isCurrent then |
|
117 Land[y - dy, i]:= Land[y - dy, i] and lfNotCurrentMask |
|
118 else if Land[y - dy, i] and lfObjMask > 0 then |
|
119 Land[y - dy, i]:= (Land[y - dy, i] and lfNotObjMask) or ((Land[y - dy, i] and lfObjMask) - 1); |
|
120 if ((y + dx) and LAND_HEIGHT_MASK) = 0 then |
|
121 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
122 if isCurrent then |
|
123 Land[y + dx, i]:= Land[y + dx, i] and lfNotCurrentMask |
|
124 else if Land[y + dx, i] and lfObjMask > 0 then |
|
125 Land[y + dx, i]:= (Land[y + dx, i] and lfNotObjMask) or ((Land[y + dx, i] and lfObjMask) - 1); |
|
126 if ((y - dx) and LAND_HEIGHT_MASK) = 0 then |
|
127 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
128 if isCurrent then |
|
129 Land[y - dx, i]:= Land[y - dx, i] and lfNotCurrentMask |
|
130 else if Land[y - dx, i] and lfObjMask > 0 then |
|
131 Land[y - dx, i]:= (Land[y - dx, i] and lfNotObjMask) or ((Land[y - dx, i] and lfObjMask) - 1) |
|
132 end |
|
133 else |
|
134 begin |
|
135 if ((y + dy) and LAND_HEIGHT_MASK) = 0 then |
|
136 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
|
137 if isCurrent then |
|
138 Land[y + dy, i]:= Land[y + dy, i] or lfCurrentHog |
|
139 else if Land[y + dy, i] and lfObjMask < lfObjMask then |
|
140 Land[y + dy, i]:= (Land[y + dy, i] and lfNotObjMask) or ((Land[y + dy, i] and lfObjMask) + 1); |
|
141 if ((y - dy) and LAND_HEIGHT_MASK) = 0 then |
|
142 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
|
143 if isCurrent then |
|
144 Land[y - dy, i]:= Land[y - dy, i] or lfCurrentHog |
|
145 else if Land[y - dy, i] and lfObjMask < lfObjMask then |
|
146 Land[y - dy, i]:= (Land[y - dy, i] and lfNotObjMask) or ((Land[y - dy, i] and lfObjMask) + 1); |
|
147 if ((y + dx) and LAND_HEIGHT_MASK) = 0 then |
|
148 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
149 if isCurrent then |
|
150 Land[y + dx, i]:= Land[y + dx, i] or lfCurrentHog |
|
151 else if Land[y + dx, i] and lfObjMask < lfObjMask then |
|
152 Land[y + dx, i]:= (Land[y + dx, i] and lfNotObjMask) or ((Land[y + dx, i] and lfObjMask) + 1); |
|
153 if ((y - dx) and LAND_HEIGHT_MASK) = 0 then |
|
154 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
155 if isCurrent then |
|
156 Land[y - dx, i]:= Land[y - dx, i] or lfCurrentHog |
|
157 else if Land[y - dx, i] and lfObjMask < lfObjMask then |
|
158 Land[y - dx, i]:= (Land[y - dx, i] and lfNotObjMask) or ((Land[y - dx, i] and lfObjMask) + 1) |
|
159 end |
|
160 end; |
|
161 |
|
162 |
|
163 |
|
164 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword); |
319 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword); |
165 var dx, dy, d: LongInt; |
320 var dx, dy, d: LongInt; |
166 begin |
321 begin |
167 dx:= 0; |
322 dx:= 0; |
168 dy:= Radius; |
323 dy:= Radius; |
182 if (dx = dy) then |
337 if (dx = dy) then |
183 FillCircleLines(x, y, dx, dy, Value); |
338 FillCircleLines(x, y, dx, dy, Value); |
184 end; |
339 end; |
185 |
340 |
186 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean); |
341 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean); |
187 var dx, dy, d: LongInt; |
342 begin |
188 begin |
343 if not doSet and isCurrent then |
189 dx:= 0; |
344 FillRoundInLand(X, Y, Radius, setNotCurrentMask) |
190 dy:= Radius; |
345 else if not doSet and not IsCurrent then |
191 d:= 3 - 2 * Radius; |
346 FillRoundInLand(X, Y, Radius, changePixelSetNotCurrent) |
192 while (dx < dy) do |
347 else if doSet and IsCurrent then |
193 begin |
348 FillRoundInLand(X, Y, Radius, setCurrentHog) |
194 ChangeCircleLines(x, y, dx, dy, doSet, isCurrent); |
349 else if doSet and not IsCurrent then |
195 if (d < 0) then |
350 FillRoundInLand(X, Y, Radius, changePixelNotSetNotCurrent); |
196 d:= d + 4 * dx + 6 |
351 end; |
197 else |
|
198 begin |
|
199 d:= d + 4 * (dx - dy) + 10; |
|
200 dec(dy) |
|
201 end; |
|
202 inc(dx) |
|
203 end; |
|
204 if (dx = dy) then |
|
205 ChangeCircleLines(x, y, dx, dy, doSet, isCurrent) |
|
206 end; |
|
207 |
|
208 procedure FillLandCircleLines0(x, y, dx, dy: LongInt); |
|
209 var i, t: LongInt; |
|
210 begin |
|
211 t:= y + dy; |
|
212 if (t and LAND_HEIGHT_MASK) = 0 then |
|
213 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
|
214 if ((Land[t, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[t, i] > 255)) then |
|
215 if (cReducedQuality and rqBlurryLand) = 0 then |
|
216 LandPixels[t, i]:= 0 |
|
217 else |
|
218 LandPixels[t div 2, i div 2]:= 0; |
|
219 |
|
220 t:= y - dy; |
|
221 if (t and LAND_HEIGHT_MASK) = 0 then |
|
222 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
|
223 if ((Land[t, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[t, i] > 255)) then |
|
224 if (cReducedQuality and rqBlurryLand) = 0 then |
|
225 LandPixels[t, i]:= 0 |
|
226 else |
|
227 LandPixels[t div 2, i div 2]:= 0; |
|
228 |
|
229 t:= y + dx; |
|
230 if (t and LAND_HEIGHT_MASK) = 0 then |
|
231 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
232 if ((Land[t, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[t, i] > 255)) then |
|
233 if (cReducedQuality and rqBlurryLand) = 0 then |
|
234 LandPixels[t, i]:= 0 |
|
235 else |
|
236 LandPixels[t div 2, i div 2]:= 0; |
|
237 |
|
238 t:= y - dx; |
|
239 if (t and LAND_HEIGHT_MASK) = 0 then |
|
240 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
241 if ((Land[t, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[t, i] > 255)) then |
|
242 if (cReducedQuality and rqBlurryLand) = 0 then |
|
243 LandPixels[t, i]:= 0 |
|
244 else |
|
245 LandPixels[t div 2, i div 2]:= 0; |
|
246 |
|
247 end; |
|
248 |
|
249 |
|
250 function isLandscapeEdge(weight:Longint):boolean; inline; |
|
251 begin |
|
252 result := (weight < 8) and (weight >= 2); |
|
253 end; |
|
254 |
|
255 function getPixelWeight(x, y:Longint): Longint; |
|
256 var |
|
257 i, j:Longint; |
|
258 begin |
|
259 result := 0; |
|
260 for i := x - 1 to x + 1 do |
|
261 for j := y - 1 to y + 1 do |
|
262 begin |
|
263 if (i < 0) or |
|
264 (i > LAND_WIDTH - 1) or |
|
265 (j < 0) or |
|
266 (j > LAND_HEIGHT -1) then |
|
267 begin |
|
268 result := 9; |
|
269 exit; |
|
270 end; |
|
271 |
|
272 if Land[j, i] and lfLandMask and not lfIce = 0 then |
|
273 result := result + 1; |
|
274 end; |
|
275 end; |
|
276 |
|
277 procedure drawIcePixel(y, x:Longint); |
|
278 var |
|
279 iceSurface: PSDL_Surface; |
|
280 icePixels: PLongwordArray; |
|
281 //pictureX, pictureY: LongInt; |
|
282 w{, c}: LongWord; |
|
283 //weight: Longint; |
|
284 begin |
|
285 // So. 3 parameters here. Ice colour, Ice opacity, and a bias on the greyscaled pixel towards lightness |
|
286 iceSurface:= SpritesData[sprIceTexture].Surface; |
|
287 icePixels := iceSurface^.pixels; |
|
288 w:= LandPixels[y, x]; |
|
289 if w > 0 then |
|
290 begin |
|
291 w:= round(((w shr RShift and $FF) * RGB_LUMINANCE_RED + |
|
292 (w shr BShift and $FF) * RGB_LUMINANCE_GREEN + |
|
293 (w shr GShift and $FF) * RGB_LUMINANCE_BLUE)); |
|
294 if w < 128 then w:= w+128; |
|
295 if w > 255 then w:= 255; |
|
296 w:= (w shl RShift) or (w shl BShift) or (w shl GShift) or (LandPixels[y,x] and AMask); |
|
297 LandPixels[y, x]:= addBgColor(w, IceColor); |
|
298 LandPixels[y, x]:= addBgColor(LandPixels[y, x], icePixels^[iceSurface^.w * (y mod iceSurface^.h) + (x mod iceSurface^.w)]) |
|
299 end |
|
300 else |
|
301 begin |
|
302 LandPixels[y, x]:= IceColor and not AMask or $E8 shl AShift; |
|
303 LandPixels[y, x]:= addBgColor(LandPixels[y, x], icePixels^[iceSurface^.w * (y mod iceSurface^.h) + (x mod iceSurface^.w)]); |
|
304 // silly workaround to avoid having to make background erasure a tadb it smarter about sea ice |
|
305 if LandPixels[y, x] and AMask shr AShift = 255 then |
|
306 LandPixels[y, x]:= LandPixels[y, x] and not AMask or 254 shl AShift; |
|
307 end; |
|
308 end; |
|
309 |
|
310 function getIncrementInquarter(dx, dy, quarter: Longint): Longint; inline; |
|
311 const directionX : array [0..3] of Longint = (0, 0, 1, -1); |
|
312 const directionY : array [0..3] of Longint = (1, -1, 0, 0); |
|
313 begin |
|
314 getIncrementInquarter := directionX[quarter] * dx + directionY[quarter] * dy; |
|
315 end; |
|
316 |
|
317 function getIncrementInquarter2(dx, dy, quarter: Longint): Longint; inline; |
|
318 const directionY : array [0..3] of Longint = (0, 0, 1, 1); |
|
319 const directionX : array [0..3] of Longint = (1, 1, 0, 0); |
|
320 begin |
|
321 getIncrementInquarter2 := directionX[quarter] * dx + directionY[quarter] * dy; |
|
322 end; |
|
323 |
|
324 procedure FillLandCircleLinesIce(x, y, dx, dy: LongInt); |
|
325 var q, i, t, px, py: LongInt; |
|
326 begin |
|
327 for q := 0 to 3 do |
|
328 begin |
|
329 t:= y + getIncrementInquarter(dx, dy, q); |
|
330 if (t and LAND_HEIGHT_MASK) = 0 then |
|
331 for i:= Max(x - getIncrementInquarter2(dx, dy, q), 0) to Min(x + getIncrementInquarter2(dx, dy, q), LAND_WIDTH - 1) do |
|
332 if Land[t, i] and lfIce = 0 then |
|
333 begin |
|
334 if (cReducedQuality and rqBlurryLand) = 0 then |
|
335 begin |
|
336 px:= i; py:= t |
|
337 end |
|
338 else |
|
339 begin |
|
340 px:= i div 2; py:= t div 2 |
|
341 end; |
|
342 if isLandscapeEdge(getPixelWeight(i, t)) then |
|
343 begin |
|
344 if (LandPixels[py, px] and AMask < 255) and (LandPixels[py, px] and AMask > 0) then |
|
345 LandPixels[py, px] := (IceEdgeColor and not AMask) or (LandPixels[py, px] and AMask) |
|
346 else if (LandPixels[py, px] and AMask < 255) or (Land[t, i] > 255) then |
|
347 LandPixels[py, px] := IceEdgeColor |
|
348 end |
|
349 else if Land[t, i] > 255 then |
|
350 begin |
|
351 drawIcePixel(py, px) |
|
352 end; |
|
353 if Land[t, i] > 255 then Land[t, i] := Land[t, i] or lfIce and not lfDamaged; |
|
354 end; |
|
355 end |
|
356 end; |
|
357 |
|
358 procedure FillRoundInLandWithIce(X, Y, Radius: LongInt); |
|
359 var dx, dy, d: LongInt; |
|
360 landRect: TSDL_Rect; |
|
361 begin |
|
362 dx:= 0; |
|
363 dy:= Radius; |
|
364 d:= 3 - 2 * Radius; |
|
365 while (dx < dy) do |
|
366 begin |
|
367 FillLandCircleLinesIce(x, y, dx, dy); |
|
368 if (d < 0) then |
|
369 d:= d + 4 * dx + 6 |
|
370 else |
|
371 begin |
|
372 d:= d + 4 * (dx - dy) + 10; |
|
373 dec(dy) |
|
374 end; |
|
375 inc(dx) |
|
376 end; |
|
377 if (dx = dy) then |
|
378 FillLandCircleLinesIce(x, y, dx, dy); |
|
379 landRect.x := min(max(x - Radius, 0), LAND_WIDTH - 1); |
|
380 landRect.y := min(max(y - Radius, 0), LAND_HEIGHT - 1); |
|
381 landRect.w := min(2*Radius, LAND_WIDTH - landRect.x - 1); |
|
382 landRect.h := min(2*Radius, LAND_HEIGHT - landRect.y - 1); |
|
383 UpdateLandTexture(landRect.x, landRect.w, landRect.y, landRect.h, true); |
|
384 end; |
|
385 |
|
386 |
352 |
387 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint); |
353 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint); |
388 var |
354 var |
389 i, j: integer; |
355 i, j: integer; |
390 landRect: TSDL_Rect; |
356 landRect: TSDL_Rect; |
394 for j := min(max(y, 0), LAND_HEIGHT - 1) to min(max(y + iceHeight, 0), LAND_HEIGHT - 1) do |
360 for j := min(max(y, 0), LAND_HEIGHT - 1) to min(max(y + iceHeight, 0), LAND_HEIGHT - 1) do |
395 begin |
361 begin |
396 if Land[j, i] = 0 then |
362 if Land[j, i] = 0 then |
397 begin |
363 begin |
398 Land[j, i] := lfIce; |
364 Land[j, i] := lfIce; |
399 drawIcePixel(j, i); |
365 fillPixelFromIceSprite(i, j); |
400 end; |
366 end; |
401 end; |
367 end; |
402 end; |
368 end; |
403 landRect.x := min(max(x - iceRadius, 0), LAND_WIDTH - 1); |
369 landRect.x := min(max(x - iceRadius, 0), LAND_WIDTH - 1); |
404 landRect.y := min(max(y, 0), LAND_HEIGHT - 1); |
370 landRect.y := min(max(y, 0), LAND_HEIGHT - 1); |
405 landRect.w := min(2*iceRadius, LAND_WIDTH - landRect.x - 1); |
371 landRect.w := min(2*iceRadius, LAND_WIDTH - landRect.x - 1); |
406 landRect.h := min(iceHeight, LAND_HEIGHT - landRect.y - 1); |
372 landRect.h := min(iceHeight, LAND_HEIGHT - landRect.y - 1); |
407 UpdateLandTexture(landRect.x, landRect.w, landRect.y, landRect.h, true); |
373 UpdateLandTexture(landRect.x, landRect.w, landRect.y, landRect.h, true); |
408 end; |
374 end; |
409 |
375 |
410 |
|
411 |
|
412 function FillLandCircleLinesBG(x, y, dx, dy: LongInt): Longword; |
|
413 var i, t, by, bx: LongInt; |
|
414 cnt: Longword; |
|
415 begin |
|
416 cnt:= 0; |
|
417 t:= y + dy; |
|
418 if (t and LAND_HEIGHT_MASK) = 0 then |
|
419 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
|
420 if (Land[t, i] and lfIndestructible) = 0 then |
|
421 begin |
|
422 if (cReducedQuality and rqBlurryLand) = 0 then |
|
423 begin |
|
424 by:= t; bx:= i; |
|
425 end |
|
426 else |
|
427 begin |
|
428 by:= t div 2; bx:= i div 2; |
|
429 end; |
|
430 if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and (not disableLandBack) then |
|
431 begin |
|
432 inc(cnt); |
|
433 LandPixels[by, bx]:= LandBackPixel(i, t) |
|
434 end |
|
435 else if ((Land[t, i] and lfObject) <> 0) or (((LandPixels[by,bx] and AMask) shr AShift) < 255) then |
|
436 LandPixels[by, bx]:= 0 |
|
437 end; |
|
438 |
|
439 t:= y - dy; |
|
440 if (t and LAND_HEIGHT_MASK) = 0 then |
|
441 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
|
442 if (Land[t, i] and lfIndestructible) = 0 then |
|
443 begin |
|
444 if (cReducedQuality and rqBlurryLand) = 0 then |
|
445 begin |
|
446 by:= t; bx:= i; |
|
447 end |
|
448 else |
|
449 begin |
|
450 by:= t div 2; bx:= i div 2; |
|
451 end; |
|
452 if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and (not disableLandBack) then |
|
453 begin |
|
454 inc(cnt); |
|
455 LandPixels[by, bx]:= LandBackPixel(i, t) |
|
456 end |
|
457 else if ((Land[t, i] and lfObject) <> 0) or (((LandPixels[by,bx] and AMask) shr AShift) < 255) then |
|
458 LandPixels[by, bx]:= 0 |
|
459 end; |
|
460 |
|
461 t:= y + dx; |
|
462 if (t and LAND_HEIGHT_MASK) = 0 then |
|
463 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
464 if (Land[t, i] and lfIndestructible) = 0 then |
|
465 begin |
|
466 if (cReducedQuality and rqBlurryLand) = 0 then |
|
467 begin |
|
468 by:= t; bx:= i; |
|
469 end |
|
470 else |
|
471 begin |
|
472 by:= t div 2; bx:= i div 2; |
|
473 end; |
|
474 if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and (not disableLandBack) then |
|
475 begin |
|
476 inc(cnt); |
|
477 LandPixels[by, bx]:= LandBackPixel(i, t) |
|
478 end |
|
479 else if ((Land[t, i] and lfObject) <> 0) or (((LandPixels[by,bx] and AMask) shr AShift) < 255) then |
|
480 LandPixels[by, bx]:= 0 |
|
481 end; |
|
482 t:= y - dx; |
|
483 if (t and LAND_HEIGHT_MASK) = 0 then |
|
484 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
485 if (Land[t, i] and lfIndestructible) = 0 then |
|
486 begin |
|
487 if (cReducedQuality and rqBlurryLand) = 0 then |
|
488 begin |
|
489 by:= t; bx:= i; |
|
490 end |
|
491 else |
|
492 begin |
|
493 by:= t div 2; bx:= i div 2; |
|
494 end; |
|
495 if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and (not disableLandBack) then |
|
496 begin |
|
497 inc(cnt); |
|
498 LandPixels[by, bx]:= LandBackPixel(i, t) |
|
499 end |
|
500 else if ((Land[t, i] and lfObject) <> 0) or (((LandPixels[by,bx] and AMask) shr AShift) < 255) then |
|
501 LandPixels[by, bx]:= 0 |
|
502 end; |
|
503 FillLandCircleLinesBG:= cnt; |
|
504 end; |
|
505 |
|
506 procedure FillLandCircleLinesEBC(x, y, dx, dy: LongInt); |
|
507 var i, t: LongInt; |
|
508 begin |
|
509 t:= y + dy; |
|
510 if (t and LAND_HEIGHT_MASK) = 0 then |
|
511 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
|
512 if ((Land[t, i] and lfBasic) <> 0) or ((Land[t, i] and lfObject) <> 0) then |
|
513 begin |
|
514 if (cReducedQuality and rqBlurryLand) = 0 then |
|
515 LandPixels[t, i]:= ExplosionBorderColor |
|
516 else |
|
517 LandPixels[t div 2, i div 2]:= ExplosionBorderColor; |
|
518 |
|
519 Land[t, i]:= (Land[t, i] or lfDamaged) and not lfIce; |
|
520 //Despeckle(i, t); |
|
521 LandDirty[t div 32, i div 32]:= 1; |
|
522 end; |
|
523 |
|
524 t:= y - dy; |
|
525 if (t and LAND_HEIGHT_MASK) = 0 then |
|
526 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
|
527 if ((Land[t, i] and lfBasic) <> 0) or ((Land[t, i] and lfObject) <> 0) then |
|
528 begin |
|
529 if (cReducedQuality and rqBlurryLand) = 0 then |
|
530 LandPixels[t, i]:= ExplosionBorderColor |
|
531 else |
|
532 LandPixels[t div 2, i div 2]:= ExplosionBorderColor; |
|
533 Land[t, i]:= (Land[t, i] or lfDamaged) and not lfIce; |
|
534 //Despeckle(i, t); |
|
535 LandDirty[t div 32, i div 32]:= 1; |
|
536 end; |
|
537 |
|
538 t:= y + dx; |
|
539 if (t and LAND_HEIGHT_MASK) = 0 then |
|
540 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
541 if ((Land[t, i] and lfBasic) <> 0) or ((Land[t, i] and lfObject) <> 0) then |
|
542 begin |
|
543 if (cReducedQuality and rqBlurryLand) = 0 then |
|
544 LandPixels[t, i]:= ExplosionBorderColor |
|
545 else |
|
546 LandPixels[t div 2, i div 2]:= ExplosionBorderColor; |
|
547 |
|
548 Land[t, i]:= (Land[t, i] or lfDamaged) and not lfIce; |
|
549 //Despeckle(i, t); |
|
550 LandDirty[t div 32, i div 32]:= 1; |
|
551 end; |
|
552 |
|
553 t:= y - dx; |
|
554 if (t and LAND_HEIGHT_MASK) = 0 then |
|
555 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
556 if ((Land[t, i] and lfBasic) <> 0) or ((Land[t, i] and lfObject) <> 0) then |
|
557 begin |
|
558 if (cReducedQuality and rqBlurryLand) = 0 then |
|
559 LandPixels[t, i]:= ExplosionBorderColor |
|
560 else |
|
561 LandPixels[t div 2, i div 2]:= ExplosionBorderColor; |
|
562 |
|
563 Land[t, i]:= (Land[t, i] or lfDamaged) and not lfIce; |
|
564 //Despeckle(i, y - dy); |
|
565 LandDirty[t div 32, i div 32]:= 1; |
|
566 end; |
|
567 end; |
|
568 |
|
569 function DrawExplosion(X, Y, Radius: LongInt): Longword; |
376 function DrawExplosion(X, Y, Radius: LongInt): Longword; |
570 var dx, dy, ty, tx, d: LongInt; |
377 var |
571 cnt: Longword; |
378 tx, ty, dx, dy: Longint; |
572 begin |
379 begin |
573 |
380 DrawExplosion := FillRoundInLand(x, y, Radius, backgroundPixel); |
574 // draw background land texture |
381 if Radius > 20 then |
575 begin |
382 FillRoundInLand(x, y, Radius - 15, nullPixel); |
576 cnt:= 0; |
|
577 dx:= 0; |
|
578 dy:= Radius; |
|
579 d:= 3 - 2 * Radius; |
|
580 |
|
581 while (dx < dy) do |
|
582 begin |
|
583 inc(cnt, FillLandCircleLinesBG(x, y, dx, dy)); |
|
584 if (d < 0) then |
|
585 d:= d + 4 * dx + 6 |
|
586 else |
|
587 begin |
|
588 d:= d + 4 * (dx - dy) + 10; |
|
589 dec(dy) |
|
590 end; |
|
591 inc(dx) |
|
592 end; |
|
593 if (dx = dy) then |
|
594 inc(cnt, FillLandCircleLinesBG(x, y, dx, dy)); |
|
595 end; |
|
596 |
|
597 // draw a hole in land |
|
598 if Radius > 20 then |
|
599 begin |
|
600 dx:= 0; |
|
601 dy:= Radius - 15; |
|
602 d:= 3 - 2 * dy; |
|
603 |
|
604 while (dx < dy) do |
|
605 begin |
|
606 FillLandCircleLines0(x, y, dx, dy); |
|
607 if (d < 0) then |
|
608 d:= d + 4 * dx + 6 |
|
609 else |
|
610 begin |
|
611 d:= d + 4 * (dx - dy) + 10; |
|
612 dec(dy) |
|
613 end; |
|
614 inc(dx) |
|
615 end; |
|
616 if (dx = dy) then |
|
617 FillLandCircleLines0(x, y, dx, dy); |
|
618 end; |
|
619 |
|
620 // FillRoundInLand after erasing land pixels to allow Land 0 check for mask.png to function |
|
621 FillRoundInLand(X, Y, Radius, 0); |
383 FillRoundInLand(X, Y, Radius, 0); |
622 |
384 FillRoundInLand(x, y, Radius + 4, ebcPixel); |
623 // draw explosion border |
385 tx:= Max(X - Radius - 1, 0); |
624 begin |
386 dx:= Min(X + Radius + 1, LAND_WIDTH) - tx; |
625 inc(Radius, 4); |
387 ty:= Max(Y - Radius - 1, 0); |
626 dx:= 0; |
388 dy:= Min(Y + Radius + 1, LAND_HEIGHT) - ty; |
627 dy:= Radius; |
389 UpdateLandTexture(tx, dx, ty, dy, false); |
628 d:= 3 - 2 * Radius; |
|
629 while (dx < dy) do |
|
630 begin |
|
631 FillLandCircleLinesEBC(x, y, dx, dy); |
|
632 if (d < 0) then |
|
633 d:= d + 4 * dx + 6 |
|
634 else |
|
635 begin |
|
636 d:= d + 4 * (dx - dy) + 10; |
|
637 dec(dy) |
|
638 end; |
|
639 inc(dx) |
|
640 end; |
|
641 if (dx = dy) then |
|
642 FillLandCircleLinesEBC(x, y, dx, dy); |
|
643 end; |
|
644 |
|
645 tx:= Max(X - Radius - 1, 0); |
|
646 dx:= Min(X + Radius + 1, LAND_WIDTH) - tx; |
|
647 ty:= Max(Y - Radius - 1, 0); |
|
648 dy:= Min(Y + Radius + 1, LAND_HEIGHT) - ty; |
|
649 UpdateLandTexture(tx, dx, ty, dy, false); |
|
650 DrawExplosion:= cnt |
|
651 end; |
390 end; |
652 |
391 |
653 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte); |
392 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte); |
654 var tx, ty, by, bx, i: LongInt; |
393 var tx, ty, by, bx, i: LongInt; |
655 begin |
394 begin |