Fix collision info artifacts in Land array when two objects intersect
authorunc0rr
Wed, 02 May 2007 21:37:08 +0000
changeset 504 13b6ebc53627
parent 503 2cfdc4bfc2be
child 505 fcba7d7aea0d
Fix collision info artifacts in Land array when two objects intersect
hedgewars/uCollisions.pas
hedgewars/uLandGraphics.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);
--- 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