# HG changeset patch # User unc0rr # Date 1178141828 0 # Node ID 13b6ebc536272d6193eae40635624d67d3b3155e # Parent 2cfdc4bfc2be414f80008e9ebcd65e23d59263ea Fix collision info artifacts in Land array when two objects intersect diff -r 2cfdc4bfc2be -r 13b6ebc53627 hedgewars/uCollisions.pas --- a/hedgewars/uCollisions.pas Wed May 02 18:41:44 2007 +0000 +++ b/hedgewars/uCollisions.pas Wed May 02 21:37:08 2007 +0000 @@ -59,7 +59,7 @@ X:= hwRound(Gear^.X); Y:= hwRound(Gear^.Y); Radius:= Gear^.Radius; - FillRoundInLand(X, Y, Radius-1, $FF); + ChangeRoundInLand(X, Y, Radius - 1, +1); cGear:= Gear end; Gear^.CollIndex:= Count; @@ -70,7 +70,8 @@ begin if Gear^.CollIndex < Count then begin - with cinfos[Gear^.CollIndex] do FillRoundInLand(X, Y, Radius-1, 0); + with cinfos[Gear^.CollIndex] do + ChangeRoundInLand(X, Y, Radius - 1, -1); cinfos[Gear^.CollIndex]:= cinfos[Pred(Count)]; cinfos[Gear^.CollIndex].cGear^.CollIndex:= Gear^.CollIndex; Gear^.CollIndex:= High(Longword); diff -r 2cfdc4bfc2be -r 13b6ebc53627 hedgewars/uLandGraphics.pas --- a/hedgewars/uLandGraphics.pas Wed May 02 18:41:44 2007 +0000 +++ b/hedgewars/uLandGraphics.pas Wed May 02 21:37:08 2007 +0000 @@ -30,6 +30,7 @@ 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); +procedure ChangeRoundInLand(X, Y, Radius: LongInt; Delta: LongInt); function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt): boolean; @@ -49,6 +50,19 @@ for i:= max(x - dy, 0) to min(x + dy, 2047) do Land[y - dx, i]:= Value; end; +procedure ChangeCircleLines(x, y, dx, dy: LongInt; Delta: LongInt); +var i: LongInt; +begin +if ((y + dy) and $FFFFFC00) = 0 then + for i:= max(x - dx, 0) to min(x + dx, 2047) do inc(Land[y + dy, i], Delta); +if ((y - dy) and $FFFFFC00) = 0 then + for i:= max(x - dx, 0) to min(x + dx, 2047) do inc(Land[y - dy, i], Delta); +if ((y + dx) and $FFFFFC00) = 0 then + for i:= max(x - dy, 0) to min(x + dy, 2047) do inc(Land[y + dx, i], Delta); +if ((y - dx) and $FFFFFC00) = 0 then + for i:= max(x - dy, 0) to min(x + dy, 2047) do inc(Land[y - dx, i], Delta); +end; + procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword); var dx, dy, d: LongInt; begin @@ -69,6 +83,27 @@ if (dx = dy) then FillCircleLines(x, y, dx, dy, Value); end; +procedure ChangeRoundInLand(X, Y, Radius: LongInt; Delta: LongInt); +var dx, dy, d: LongInt; +begin + dx:= 0; + dy:= Radius; + d:= 3 - 2 * Radius; + while (dx < dy) do + begin + ChangeCircleLines(x, y, dx, dy, Delta); + 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, Delta); +end; + + procedure ClearLandPixel(y, x: LongInt); var p: PByteArray; begin