--- a/hedgewars/uLandGraphics.pas Wed Feb 20 02:21:58 2013 +0100
+++ b/hedgewars/uLandGraphics.pas Tue Apr 02 21:00:57 2013 +0200
@@ -22,10 +22,14 @@
interface
uses uFloat, uConsts, uTypes;
+type
+ fillType = (nullPixel, backgroundPixel, ebcPixel, icePixel, setNotCurrentMask, changePixelSetNotCurrent, setCurrentHog, changePixelNotSetNotCurrent);
+
type TRangeArray = array[0..31] of record
Left, Right: LongInt;
end;
PRangeArray = ^TRangeArray;
+TLandCircleProcedure = procedure (landX, landY, pixelX, pixelY: Longint);
function addBgColor(OldColor, NewColor: LongWord): LongWord;
function SweepDirty: boolean;
@@ -36,17 +40,230 @@
procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
+function FillRoundInLand(X, Y, Radius: LongInt; fill: fillType): LongWord;
procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean);
function LandBackPixel(x, y: LongInt): LongWord;
procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword);
procedure DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword);
procedure DumpLandToLog(x, y, r: LongInt);
-
+procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint);
function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean; indestructible: boolean): boolean;
implementation
uses SDLh, uLandTexture, uVariables, uUtils, uDebug;
+
+procedure calculatePixelsCoordinates(landX, landY: Longint; var pixelX, pixelY: Longint); inline;
+begin
+if (cReducedQuality and rqBlurryLand) = 0 then
+ begin
+ pixelX := landX;
+ pixelY := landY;
+ end
+else
+ begin
+ pixelX := LandX div 2;
+ pixelY := LandY div 2;
+ end;
+end;
+
+function drawPixelBG(landX, landY, pixelX, pixelY: Longint): Longword; inline;
+begin
+drawPixelBG := 0;
+if (Land[LandY, landX] and lfIndestructible) = 0 then
+ begin
+ if ((Land[landY, landX] and lfBasic) <> 0) and (((LandPixels[pixelY, pixelX] and AMask) shr AShift) = 255) and (not disableLandBack) then
+ begin
+ LandPixels[pixelY, pixelX]:= LandBackPixel(landX, landY);
+ inc(drawPixelBG);
+ end
+ else if ((Land[landY, landX] and lfObject) <> 0) or (((LandPixels[pixelY, pixelX] and AMask) shr AShift) < 255) then
+ LandPixels[pixelY, pixelX]:= 0
+ end;
+end;
+
+procedure drawPixelEBC(landX, landY, pixelX, pixelY: Longint); inline;
+begin
+if ((Land[landY, landX] and lfBasic) <> 0) or ((Land[landY, landX] and lfObject) <> 0) then
+ begin
+ LandPixels[pixelY, pixelX]:= ExplosionBorderColor;
+ Land[landY, landX]:= (Land[landY, landX] or lfDamaged) and not lfIce;
+ LandDirty[landY div 32, landX div 32]:= 1;
+ end;
+end;
+
+function isLandscapeEdge(weight:Longint):boolean; inline;
+begin
+result := (weight < 8) and (weight >= 2);
+end;
+
+function getPixelWeight(x, y:Longint): Longint;
+var
+ i, j:Longint;
+begin
+result := 0;
+for i := x - 1 to x + 1 do
+ for j := y - 1 to y + 1 do
+ begin
+ if (i < 0) or
+ (i > LAND_WIDTH - 1) or
+ (j < 0) or
+ (j > LAND_HEIGHT -1) then
+ begin
+ result := 9;
+ exit;
+ end;
+ if Land[j, i] and lfLandMask and not lfIce = 0 then
+ result := result + 1;
+ end;
+end;
+
+
+procedure fillPixelFromIceSprite(pixelX, pixelY:Longint); inline;
+var
+ iceSurface: PSDL_Surface;
+ icePixels: PLongwordArray;
+ w: LongWord;
+begin
+ // So. 3 parameters here. Ice colour, Ice opacity, and a bias on the greyscaled pixel towards lightness
+ iceSurface:= SpritesData[sprIceTexture].Surface;
+ icePixels := iceSurface^.pixels;
+ w:= LandPixels[pixelY, pixelX];
+ if w > 0 then
+ begin
+ w:= round(((w shr RShift and $FF) * RGB_LUMINANCE_RED +
+ (w shr BShift and $FF) * RGB_LUMINANCE_GREEN +
+ (w shr GShift and $FF) * RGB_LUMINANCE_BLUE));
+ if w < 128 then w:= w+128;
+ if w > 255 then w:= 255;
+ w:= (w shl RShift) or (w shl BShift) or (w shl GShift) or (LandPixels[pixelY, pixelX] and AMask);
+ LandPixels[pixelY, pixelX]:= addBgColor(w, IceColor);
+ LandPixels[pixelY, pixelX]:= addBgColor(LandPixels[pixelY, pixelX], icePixels^[iceSurface^.w * (pixelY mod iceSurface^.h) + (pixelX mod iceSurface^.w)])
+ end
+ else
+ begin
+ LandPixels[pixelY, pixelX]:= IceColor and not AMask or $E8 shl AShift;
+ LandPixels[pixelY, pixelX]:= addBgColor(LandPixels[pixelY, pixelX], icePixels^[iceSurface^.w * (pixelY mod iceSurface^.h) + (pixelX mod iceSurface^.w)]);
+ // silly workaround to avoid having to make background erasure a tadb it smarter about sea ice
+ if LandPixels[pixelY, pixelX] and AMask shr AShift = 255 then
+ LandPixels[pixelY, pixelX]:= LandPixels[pixelY, pixelX] and not AMask or 254 shl AShift;
+ end;
+end;
+
+
+procedure DrawPixelIce(landX, landY, pixelX, pixelY: Longint); inline;
+begin
+if ((Land[landY, landX] and lfIce) <> 0) then exit;
+if isLandscapeEdge(getPixelWeight(landX, landY)) then
+ begin
+ if (LandPixels[pixelY, pixelX] and AMask < 255) and (LandPixels[pixelY, pixelX] and AMask > 0) then
+ LandPixels[pixelY, pixelX] := (IceEdgeColor and not AMask) or (LandPixels[pixelY, pixelX] and AMask)
+ else if (LandPixels[pixelY, pixelX] and AMask < 255) or (Land[landY, landX] > 255) then
+ LandPixels[pixelY, pixelX] := IceEdgeColor
+ end
+else if Land[landY, landX] > 255 then
+ begin
+ fillPixelFromIceSprite(pixelX, pixelY);
+ end;
+if Land[landY, landX] > 255 then Land[landY, landX] := Land[landY, landX] or lfIce and not lfDamaged;
+end;
+
+
+function FillLandCircleLine(y, fromPix, toPix: LongInt; fill : fillType): Longword;
+var px, py, i: LongInt;
+begin
+//get rid of compiler warning
+ px := 0;
+ py := 0;
+ FillLandCircleLine := 0;
+ case fill of
+ backgroundPixel:
+ for i:= fromPix to toPix do
+ begin
+ calculatePixelsCoordinates(i, y, px, py);
+ inc(FillLandCircleLine, drawPixelBG(i, y, px, py));
+ end;
+ ebcPixel:
+ for i:= fromPix to toPix do
+ begin
+ calculatePixelsCoordinates(i, y, px, py);
+ drawPixelEBC(i, y, px, py);
+ end;
+ nullPixel:
+ for i:= fromPix to toPix do
+ begin
+ calculatePixelsCoordinates(i, y, px, py);
+ if ((Land[y, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[y, i] > 255)) then
+ LandPixels[py, px]:= 0
+ end;
+ icePixel:
+ for i:= fromPix to toPix do
+ begin
+ calculatePixelsCoordinates(i, y, px, py);
+ DrawPixelIce(i, y, px, py);
+ end;
+ setNotCurrentMask:
+ for i:= fromPix to toPix do
+ begin
+ Land[y, i]:= Land[y, i] and lfNotCurrentMask;
+ end;
+ changePixelSetNotCurrent:
+ for i:= fromPix to toPix do
+ begin
+ if Land[y, i] and lfObjMask > 0 then
+ Land[y, i]:= (Land[y, i] and lfNotObjMask) or ((Land[y, i] and lfObjMask) - 1);
+ end;
+ setCurrentHog:
+ for i:= fromPix to toPix do
+ begin
+ Land[y, i]:= Land[y, i] or lfCurrentHog
+ end;
+ changePixelNotSetNotCurrent:
+ for i:= fromPix to toPix do
+ begin
+ if Land[y, i] and lfObjMask < lfObjMask then
+ Land[y, i]:= (Land[y, i] and lfNotObjMask) or ((Land[y, i] and lfObjMask) + 1)
+ end;
+ end;
+end;
+
+function FillLandCircleSegment(x, y, dx, dy: LongInt; fill : fillType): Longword; inline;
+begin
+ FillLandCircleSegment := 0;
+if ((y + dy) and LAND_HEIGHT_MASK) = 0 then
+ inc(FillLandCircleSegment, FillLandCircleLine(y + dy, Max(x - dx, 0), Min(x + dx, LAND_WIDTH - 1), fill));
+if ((y - dy) and LAND_HEIGHT_MASK) = 0 then
+ inc(FillLandCircleSegment, FillLandCircleLine(y - dy, Max(x - dx, 0), Min(x + dx, LAND_WIDTH - 1), fill));
+if ((y + dx) and LAND_HEIGHT_MASK) = 0 then
+ inc(FillLandCircleSegment, FillLandCircleLine(y + dx, Max(x - dy, 0), Min(x + dy, LAND_WIDTH - 1), fill));
+if ((y - dx) and LAND_HEIGHT_MASK) = 0 then
+ inc(FillLandCircleSegment, FillLandCircleLine(y - dx, Max(x - dy, 0), Min(x + dy, LAND_WIDTH - 1), fill));
+end;
+
+function FillRoundInLand(X, Y, Radius: LongInt; fill: fillType): Longword; inline;
+var dx, dy, d: LongInt;
+begin
+dx:= 0;
+dy:= Radius;
+d:= 3 - 2 * Radius;
+FillRoundInLand := 0;
+while (dx < dy) do
+ begin
+ inc(FillRoundInLand, FillLandCircleSegment(x, y, dx, dy, fill));
+ if (d < 0) then
+ d:= d + 4 * dx + 6
+ else
+ begin
+ d:= d + 4 * (dx - dy) + 10;
+ dec(dy)
+ end;
+ inc(dx)
+ end;
+if (dx = dy) then
+ inc (FillRoundInLand, FillLandCircleSegment(x, y, dx, dy, fill));
+end;
+
+
function addBgColor(OldColor, NewColor: LongWord): LongWord;
// Factor ranges from 0 to 100% NewColor
var
@@ -99,65 +316,6 @@
Land[y - dx, i]:= Value;
end;
-procedure ChangeCircleLines(x, y, dx, dy: LongInt; doSet, isCurrent: boolean);
-var i: LongInt;
-begin
-if not doSet then
- begin
- if ((y + dy) and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
- if isCurrent then
- Land[y + dy, i]:= Land[y + dy, i] and $FF7F
- else if Land[y + dy, i] and $007F > 0 then
- Land[y + dy, i]:= (Land[y + dy, i] and $FF80) or ((Land[y + dy, i] and $7F) - 1);
- if ((y - dy) and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
- if isCurrent then
- Land[y - dy, i]:= Land[y - dy, i] and $FF7F
- else if Land[y - dy, i] and $007F > 0 then
- Land[y - dy, i]:= (Land[y - dy, i] and $FF80) or ((Land[y - dy, i] and $7F) - 1);
- if ((y + dx) and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
- if isCurrent then
- Land[y + dx, i]:= Land[y + dx, i] and $FF7F
- else if Land[y + dx, i] and $007F > 0 then
- Land[y + dx, i]:= (Land[y + dx, i] and $FF80) or ((Land[y + dx, i] and $7F) - 1);
- if ((y - dx) and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
- if isCurrent then
- Land[y - dx, i]:= Land[y - dx, i] and $FF7F
- else if Land[y - dx, i] and $007F > 0 then
- Land[y - dx, i]:= (Land[y - dx, i] and $FF80) or ((Land[y - dx, i] and $7F) - 1)
- end
-else
- begin
- if ((y + dy) and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
- if isCurrent then
- Land[y + dy, i]:= Land[y + dy, i] or $80
- else if Land[y + dy, i] and $007F < 127 then
- Land[y + dy, i]:= (Land[y + dy, i] and $FF80) or ((Land[y + dy, i] and $7F) + 1);
- if ((y - dy) and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
- if isCurrent then
- Land[y - dy, i]:= Land[y - dy, i] or $80
- else if Land[y - dy, i] and $007F < 127 then
- Land[y - dy, i]:= (Land[y - dy, i] and $FF80) or ((Land[y - dy, i] and $7F) + 1);
- if ((y + dx) and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
- if isCurrent then
- Land[y + dx, i]:= Land[y + dx, i] or $80
- else if Land[y + dx, i] and $007F < 127 then
- Land[y + dx, i]:= (Land[y + dx, i] and $FF80) or ((Land[y + dx, i] and $7F) + 1);
- if ((y - dx) and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
- if isCurrent then
- Land[y - dx, i]:= Land[y - dx, i] or $80
- else if Land[y - dx, i] and $007F < 127 then
- Land[y - dx, i]:= (Land[y - dx, i] and $FF80) or ((Land[y - dx, i] and $7F) + 1)
- end
-end;
-
procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
var dx, dy, d: LongInt;
begin
@@ -181,307 +339,54 @@
end;
procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean);
-var dx, dy, d: LongInt;
begin
-dx:= 0;
-dy:= Radius;
-d:= 3 - 2 * Radius;
-while (dx < dy) do
- begin
- ChangeCircleLines(x, y, dx, dy, doSet, isCurrent);
- if (d < 0) then
- d:= d + 4 * dx + 6
- else
- begin
- d:= d + 4 * (dx - dy) + 10;
- dec(dy)
- end;
- inc(dx)
- end;
-if (dx = dy) then
- ChangeCircleLines(x, y, dx, dy, doSet, isCurrent)
-end;
-
-procedure FillLandCircleLines0(x, y, dx, dy: LongInt);
-var i, t: LongInt;
-begin
-t:= y + dy;
-if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
- if ((Land[t, i] and lfIndestructible) = 0) and ((not disableLandBack) or (Land[t, i] > 255)) then
- if (cReducedQuality and rqBlurryLand) = 0 then
- LandPixels[t, i]:= 0
- else
- LandPixels[t div 2, i div 2]:= 0;
-
-t:= y - dy;
-if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
- if ((Land[t, i] and lfIndestructible) = 0) and ((not disableLandBack) or (Land[t, i] > 255)) then
- if (cReducedQuality and rqBlurryLand) = 0 then
- LandPixels[t, i]:= 0
- else
- LandPixels[t div 2, i div 2]:= 0;
-
-t:= y + dx;
-if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
- if ((Land[t, i] and lfIndestructible) = 0) and ((not disableLandBack) or (Land[t, i] > 255)) then
- if (cReducedQuality and rqBlurryLand) = 0 then
- LandPixels[t, i]:= 0
- else
- LandPixels[t div 2, i div 2]:= 0;
-
-t:= y - dx;
-if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
- if ((Land[t, i] and lfIndestructible) = 0) and ((not disableLandBack) or (Land[t, i] > 255)) then
- if (cReducedQuality and rqBlurryLand) = 0 then
- LandPixels[t, i]:= 0
- else
- LandPixels[t div 2, i div 2]:= 0;
-
+if not doSet and isCurrent then
+ FillRoundInLand(X, Y, Radius, setNotCurrentMask)
+else if not doSet and not IsCurrent then
+ FillRoundInLand(X, Y, Radius, changePixelSetNotCurrent)
+else if doSet and IsCurrent then
+ FillRoundInLand(X, Y, Radius, setCurrentHog)
+else if doSet and not IsCurrent then
+ FillRoundInLand(X, Y, Radius, changePixelNotSetNotCurrent);
end;
-function FillLandCircleLinesBG(x, y, dx, dy: LongInt): Longword;
-var i, t, by, bx: LongInt;
- cnt: Longword;
+procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint);
+var
+ i, j: integer;
+ landRect: TSDL_Rect;
begin
-cnt:= 0;
-t:= y + dy;
-if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
- if (Land[t, i] and lfIndestructible) = 0 then
- begin
- if (cReducedQuality and rqBlurryLand) = 0 then
- begin
- by:= t; bx:= i;
- end
- else
- begin
- by:= t div 2; bx:= i div 2;
- end;
- if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and (not disableLandBack) then
- begin
- inc(cnt);
- LandPixels[by, bx]:= LandBackPixel(i, t)
- end
- else if ((Land[t, i] and lfObject) <> 0) or (((LandPixels[by,bx] and AMask) shr AShift) < 255) then
- LandPixels[by, bx]:= 0
- end;
-
-t:= y - dy;
-if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
- if (Land[t, i] and lfIndestructible) = 0 then
- begin
- if (cReducedQuality and rqBlurryLand) = 0 then
- begin
- by:= t; bx:= i;
- end
- else
- begin
- by:= t div 2; bx:= i div 2;
- end;
- if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and (not disableLandBack) then
- begin
- inc(cnt);
- LandPixels[by, bx]:= LandBackPixel(i, t)
- end
- else if ((Land[t, i] and lfObject) <> 0) or (((LandPixels[by,bx] and AMask) shr AShift) < 255) then
- LandPixels[by, bx]:= 0
- end;
-
-t:= y + dx;
-if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
- if (Land[t, i] and lfIndestructible) = 0 then
- begin
- if (cReducedQuality and rqBlurryLand) = 0 then
- begin
- by:= t; bx:= i;
- end
- else
- begin
- by:= t div 2; bx:= i div 2;
- end;
- if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and (not disableLandBack) then
- begin
- inc(cnt);
- LandPixels[by, bx]:= LandBackPixel(i, t)
- end
- else if ((Land[t, i] and lfObject) <> 0) or (((LandPixels[by,bx] and AMask) shr AShift) < 255) then
- LandPixels[by, bx]:= 0
- end;
-t:= y - dx;
-if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
- if (Land[t, i] and lfIndestructible) = 0 then
+for i := min(max(x - iceRadius, 0), LAND_WIDTH - 1) to min(max(x + iceRadius, 0), LAND_WIDTH - 1) do
+ begin
+ for j := min(max(y, 0), LAND_HEIGHT - 1) to min(max(y + iceHeight, 0), LAND_HEIGHT - 1) do
+ begin
+ if Land[j, i] = 0 then
begin
- if (cReducedQuality and rqBlurryLand) = 0 then
- begin
- by:= t; bx:= i;
- end
- else
- begin
- by:= t div 2; bx:= i div 2;
- end;
- if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and (not disableLandBack) then
- begin
- inc(cnt);
- LandPixels[by, bx]:= LandBackPixel(i, t)
- end
- else if ((Land[t, i] and lfObject) <> 0) or (((LandPixels[by,bx] and AMask) shr AShift) < 255) then
- LandPixels[by, bx]:= 0
- end;
-FillLandCircleLinesBG:= cnt;
-end;
-
-procedure FillLandCircleLinesEBC(x, y, dx, dy: LongInt);
-var i, t: LongInt;
-begin
-t:= y + dy;
-if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
- if ((Land[t, i] and lfBasic) <> 0) or ((Land[t, i] and lfObject) <> 0) then
- begin
- if (cReducedQuality and rqBlurryLand) = 0 then
- LandPixels[t, i]:= ExplosionBorderColor
- else
- LandPixels[t div 2, i div 2]:= ExplosionBorderColor;
-
- Land[t, i]:= Land[t, i] or lfDamaged;
- //Despeckle(i, t);
- LandDirty[t div 32, i div 32]:= 1;
+ Land[j, i] := lfIce;
+ fillPixelFromIceSprite(i, j);
end;
-
-t:= y - dy;
-if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
- if ((Land[t, i] and lfBasic) <> 0) or ((Land[t, i] and lfObject) <> 0) then
- begin
- if (cReducedQuality and rqBlurryLand) = 0 then
- LandPixels[t, i]:= ExplosionBorderColor
- else
- LandPixels[t div 2, i div 2]:= ExplosionBorderColor;
- Land[t, i]:= Land[t, i] or lfDamaged;
- //Despeckle(i, t);
- LandDirty[t div 32, i div 32]:= 1;
- end;
-
-t:= y + dx;
-if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
- if ((Land[t, i] and lfBasic) <> 0) or ((Land[t, i] and lfObject) <> 0) then
- begin
- if (cReducedQuality and rqBlurryLand) = 0 then
- LandPixels[t, i]:= ExplosionBorderColor
- else
- LandPixels[t div 2, i div 2]:= ExplosionBorderColor;
-
- Land[t, i]:= Land[t, i] or lfDamaged;
- //Despeckle(i, t);
- LandDirty[t div 32, i div 32]:= 1;
- end;
-
-t:= y - dx;
-if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
- if ((Land[t, i] and lfBasic) <> 0) or ((Land[t, i] and lfObject) <> 0) then
- begin
- if (cReducedQuality and rqBlurryLand) = 0 then
- LandPixels[t, i]:= ExplosionBorderColor
- else
- LandPixels[t div 2, i div 2]:= ExplosionBorderColor;
-
- Land[t, i]:= Land[t, i] or lfDamaged;
- //Despeckle(i, y - dy);
- LandDirty[t div 32, i div 32]:= 1;
- end;
+ end;
+ end;
+landRect.x := min(max(x - iceRadius, 0), LAND_WIDTH - 1);
+landRect.y := min(max(y, 0), LAND_HEIGHT - 1);
+landRect.w := min(2*iceRadius, LAND_WIDTH - landRect.x - 1);
+landRect.h := min(iceHeight, LAND_HEIGHT - landRect.y - 1);
+UpdateLandTexture(landRect.x, landRect.w, landRect.y, landRect.h, true);
end;
function DrawExplosion(X, Y, Radius: LongInt): Longword;
-var dx, dy, ty, tx, d: LongInt;
- cnt: Longword;
+var
+ tx, ty, dx, dy: Longint;
begin
-
-// draw background land texture
- begin
- cnt:= 0;
- dx:= 0;
- dy:= Radius;
- d:= 3 - 2 * Radius;
-
- while (dx < dy) do
- begin
- inc(cnt, FillLandCircleLinesBG(x, y, dx, dy));
- if (d < 0) then
- d:= d + 4 * dx + 6
- else
- begin
- d:= d + 4 * (dx - dy) + 10;
- dec(dy)
- end;
- inc(dx)
- end;
- if (dx = dy) then
- inc(cnt, FillLandCircleLinesBG(x, y, dx, dy));
- end;
-
-// draw a hole in land
-if Radius > 20 then
- begin
- dx:= 0;
- dy:= Radius - 15;
- d:= 3 - 2 * dy;
-
- while (dx < dy) do
- begin
- FillLandCircleLines0(x, y, dx, dy);
- if (d < 0) then
- d:= d + 4 * dx + 6
- else
- begin
- d:= d + 4 * (dx - dy) + 10;
- dec(dy)
- end;
- inc(dx)
- end;
- if (dx = dy) then
- FillLandCircleLines0(x, y, dx, dy);
- end;
-
- // FillRoundInLand after erasing land pixels to allow Land 0 check for mask.png to function
+ DrawExplosion := FillRoundInLand(x, y, Radius, backgroundPixel);
+ if Radius > 20 then
+ FillRoundInLand(x, y, Radius - 15, nullPixel);
FillRoundInLand(X, Y, Radius, 0);
-
-// draw explosion border
- begin
- inc(Radius, 4);
- dx:= 0;
- dy:= Radius;
- d:= 3 - 2 * Radius;
- while (dx < dy) do
- begin
- FillLandCircleLinesEBC(x, y, dx, dy);
- if (d < 0) then
- d:= d + 4 * dx + 6
- else
- begin
- d:= d + 4 * (dx - dy) + 10;
- dec(dy)
- end;
- inc(dx)
- end;
- if (dx = dy) then
- FillLandCircleLinesEBC(x, y, dx, dy);
- end;
-
-tx:= Max(X - Radius - 1, 0);
-dx:= Min(X + Radius + 1, LAND_WIDTH) - tx;
-ty:= Max(Y - Radius - 1, 0);
-dy:= Min(Y + Radius + 1, LAND_HEIGHT) - ty;
-UpdateLandTexture(tx, dx, ty, dy, false);
-DrawExplosion:= cnt
+ FillRoundInLand(x, y, Radius + 4, ebcPixel);
+ tx:= Max(X - Radius - 5, 0);
+ dx:= Min(X + Radius + 5, LAND_WIDTH) - tx;
+ ty:= Max(Y - Radius - 5, 0);
+ dy:= Min(Y + Radius + 5, LAND_HEIGHT) - ty;
+ UpdateLandTexture(tx, dx, ty, dy, false);
end;
procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
@@ -525,7 +430,7 @@
else
LandPixels[ty div 2, tx div 2]:= ExplosionBorderColor;
- Land[ty, tx]:= Land[ty, tx] or lfDamaged;
+ Land[ty, tx]:= (Land[ty, tx] or lfDamaged) and not lfIce;
LandDirty[ty div 32, tx div 32]:= 1;
end;
inc(y, dY)
@@ -535,6 +440,33 @@
UpdateLandTexture(0, LAND_WIDTH, 0, LAND_HEIGHT, false)
end;
+
+
+procedure DrawExplosionBorder(X, Y, dx, dy:hwFloat; despeckle : Boolean);
+var
+ t, tx, ty :Longint;
+begin
+for t:= 0 to 7 do
+ begin
+ X:= X + dX;
+ Y:= Y + dY;
+ tx:= hwRound(X);
+ ty:= hwRound(Y);
+ if ((ty and LAND_HEIGHT_MASK) = 0) and ((tx and LAND_WIDTH_MASK) = 0) and (((Land[ty, tx] and lfBasic) <> 0)
+ or ((Land[ty, tx] and lfObject) <> 0)) then
+ begin
+ Land[ty, tx]:= (Land[ty, tx] or lfDamaged) and not lfIce;
+ if despeckle then
+ LandDirty[ty div 32, tx div 32]:= 1;
+ if (cReducedQuality and rqBlurryLand) = 0 then
+ LandPixels[ty, tx]:= ExplosionBorderColor
+ else
+ LandPixels[ty div 2, tx div 2]:= ExplosionBorderColor
+ end
+ end;
+end;
+
+
//
// - (dX, dY) - direction, vector of length = 0.5
//
@@ -567,6 +499,7 @@
and ((tx and LAND_WIDTH_MASK) = 0)
and (((Land[ty, tx] and lfBasic) <> 0) or ((Land[ty, tx] and lfObject) <> 0)) then
begin
+ Land[ty, tx]:= Land[ty, tx] and not lfIce;
if despeckle then
begin
Land[ty, tx]:= Land[ty, tx] or lfDamaged;
@@ -586,24 +519,7 @@
begin
X:= nx - dX8;
Y:= ny - dY8;
- for t:= 0 to 7 do
- begin
- X:= X + dX;
- Y:= Y + dY;
- tx:= hwRound(X);
- ty:= hwRound(Y);
- if ((ty and LAND_HEIGHT_MASK) = 0) and ((tx and LAND_WIDTH_MASK) = 0) and (((Land[ty, tx] and lfBasic) <> 0)
- or ((Land[ty, tx] and lfObject) <> 0)) then
- begin
- Land[ty, tx]:= Land[ty, tx] or lfDamaged;
- if despeckle then
- LandDirty[ty div 32, tx div 32]:= 1;
- if (cReducedQuality and rqBlurryLand) = 0 then
- LandPixels[ty, tx]:= ExplosionBorderColor
- else
- LandPixels[ty div 2, tx div 2]:= ExplosionBorderColor
- end
- end;
+ DrawExplosionBorder(X, Y, dx, dy, despeckle);
X:= nx;
Y:= ny;
for t:= 0 to ticks do
@@ -629,24 +545,7 @@
Land[ty, tx]:= 0;
end
end;
- for t:= 0 to 7 do
- begin
- X:= X + dX;
- Y:= Y + dY;
- tx:= hwRound(X);
- ty:= hwRound(Y);
- if ((ty and LAND_HEIGHT_MASK) = 0) and ((tx and LAND_WIDTH_MASK) = 0) and (((Land[ty, tx] and lfBasic) <> 0)
- or ((Land[ty, tx] and lfObject) <> 0)) then
- begin
- Land[ty, tx]:= Land[ty, tx] or lfDamaged;
- if despeckle then
- LandDirty[ty div 32, tx div 32]:= 1;
- if (cReducedQuality and rqBlurryLand) = 0 then
- LandPixels[ty, tx]:= ExplosionBorderColor
- else
- LandPixels[ty div 2, tx div 2]:= ExplosionBorderColor
- end
- end;
+ DrawExplosionBorder(X, Y, dx, dy, despeckle);
nx:= nx - dY;
ny:= ny + dX;
end;
@@ -664,7 +563,7 @@
if ((ty and LAND_HEIGHT_MASK) = 0) and ((tx and LAND_WIDTH_MASK) = 0) and (((Land[ty, tx] and lfBasic) <> 0)
or ((Land[ty, tx] and lfObject) <> 0)) then
begin
- Land[ty, tx]:= Land[ty, tx] or lfDamaged;
+ Land[ty, tx]:= (Land[ty, tx] or lfDamaged) and not lfIce;
if despeckle then
LandDirty[ty div 32, tx div 32]:= 1;
if (cReducedQuality and rqBlurryLand) = 0 then
@@ -790,7 +689,7 @@
yy:= Y div 2;
end;
- pixelsweep:= ((Land[Y, X] and $FF00) = 0) and (LandPixels[yy, xx] <> 0);
+ pixelsweep:= (Land[Y, X] <= lfAllObjMask) and (LandPixels[yy, xx] <> 0);
if (((Land[Y, X] and lfDamaged) <> 0) and ((Land[Y, X] and lfIndestructible) = 0)) or pixelsweep then
begin
c:= 0;
@@ -891,7 +790,7 @@
end
end
else if ((cReducedQuality and rqBlurryLand) = 0) and (LandPixels[Y, X] and AMask = 255)
-and ((Land[Y, X] and (lfDamaged or lfBasic) = lfBasic) or (Land[Y, X] and (lfDamaged or lfBasic) = lfBasic))
+and (Land[Y, X] and (lfDamaged or lfBasic) = lfBasic)
and (Y > LongInt(topY) + 1) and (Y < LAND_HEIGHT-2) and (X > LongInt(leftX) + 1) and (X < LongInt(rightX) - 1) then
begin
if ((((Land[y, x-1] and lfDamaged) <> 0) and (((Land[y+1,x] and lfDamaged) <> 0)) or ((Land[y-1,x] and lfDamaged) <> 0))