--- a/hedgewars/GSHandlers.inc Wed May 02 21:37:08 2007 +0000
+++ b/hedgewars/GSHandlers.inc Fri May 04 19:59:51 2007 +0000
@@ -758,6 +758,7 @@
if (Gear^.Timer and $FF) = 0 then PlaySound(sndMineTick, false);
if Gear^.Timer = 0 then
begin
+ DeleteCI(Gear);
doMakeExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), 50, EXPLAutoSound);
DeleteGear(Gear)
end;
--- a/hedgewars/HHHandlers.inc Wed May 02 21:37:08 2007 +0000
+++ b/hedgewars/HHHandlers.inc Fri May 04 19:59:51 2007 +0000
@@ -149,9 +149,11 @@
StepTicks:= 200;
exit
end;
+
if ((Gear^.Message and gm_LJump ) <> 0) then
begin
Gear^.Message:= 0;
+ DeleteCI(Gear);
if not TestCollisionYwithGear(Gear, -1) then
if not TestCollisionXwithXYShift(Gear, _0, -2, hwSign(Gear^.dX)) then Gear^.Y:= Gear^.Y - _2 else
if not TestCollisionXwithXYShift(Gear, _0, -1, hwSign(Gear^.dX)) then Gear^.Y:= Gear^.Y - _1;
@@ -164,8 +166,10 @@
exit
end;
end;
+
if ((Gear^.Message and gm_HJump ) <> 0) then
begin
+ DeleteCI(Gear);
Gear^.Message:= 0;
if not TestCollisionYwithGear(Gear, -1) then
begin
@@ -175,9 +179,12 @@
exit
end;
end;
+
PrevdX:= hwSign(Gear^.dX);
if (Gear^.Message and gm_Left )<>0 then Gear^.dX:= -cLittle else
if (Gear^.Message and gm_Right )<>0 then Gear^.dX:= cLittle else exit;
+ DeleteCI(Gear);
+
StepTicks:= cHHStepTicks;
if PrevdX <> hwSign(Gear^.dX) then exit;
PHedgehog(Gear^.Hedgehog)^.visStepPos:= (PHedgehog(Gear^.Hedgehog)^.visStepPos + 1) and 7;
@@ -222,14 +229,16 @@
begin
Gear^.Y:= Gear^.Y - _6;
Gear^.dY:= _0;
- Gear^.State:= Gear^.State or gstFalling
+ Gear^.State:= Gear^.State or gstFalling;
+ exit
end;
end
end
end
end
end
- end
+ end;
+ AddGearCI(Gear)
end
end;
@@ -251,7 +260,7 @@
exit
end;
AllInactive:= false;
-DeleteCI(Gear);
+
if (TurnTimeLeft = 0) or (Gear^.Damage > 0) then
begin
TurnTimeLeft:= 0;
@@ -301,6 +310,7 @@
if ((hwAbs(Gear^.dX) + hwAbs(Gear^.dY)) < _0_55)
and ((Gear^.State and gstHHJumping) <> 0) then SetLittle(Gear^.dX);
Gear^.State:= Gear^.State and not (gstFalling or gstHHJumping or gstHHHJump);
+ AddGearCI(Gear);
StepTicks:= 300;
Gear^.dY:= _0
end;
--- a/hedgewars/uCollisions.pas Wed May 02 21:37:08 2007 +0000
+++ b/hedgewars/uCollisions.pas Fri May 04 19:59:51 2007 +0000
@@ -103,7 +103,19 @@
function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
var x, y, i: LongInt;
+ TestWord: LongWord;
begin
+if Gear^.IntersectGear <> nil then
+ with Gear^ do
+ if (hwRound(IntersectGear^.X) + IntersectGear^.Radius < hwRound(X) - Radius) or
+ (hwRound(IntersectGear^.X) - IntersectGear^.Radius > hwRound(X) + Radius) then
+ begin
+ IntersectGear:= nil;
+ TestWord:= 0
+ end else
+ TestWord:= COLOR_LAND - 1
+ else TestWord:= 0;
+
x:= hwRound(Gear^.X);
if Dir < 0 then x:= x - Gear^.Radius
else x:= x + Gear^.Radius;
@@ -113,13 +125,44 @@
i:= y + Gear^.Radius * 2 - 2;
repeat
if (y and $FFFFFC00) = 0 then
- if Land[y, x] <> 0 then exit(true);
+ if Land[y, x] > TestWord then exit(true);
inc(y)
until (y > i);
end;
TestCollisionXwithGear:= false
end;
+function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): boolean;
+var x, y, i: LongInt;
+ TestWord: LongWord;
+begin
+if Gear^.IntersectGear <> nil then
+ with Gear^ do
+ if (hwRound(IntersectGear^.Y) + IntersectGear^.Radius < hwRound(Y) - Radius) or
+ (hwRound(IntersectGear^.Y) - IntersectGear^.Radius > hwRound(Y) + Radius) then
+ begin
+ IntersectGear:= nil;
+ TestWord:= 0
+ end else
+ TestWord:= COLOR_LAND - 1
+ else TestWord:= 0;
+
+y:= hwRound(Gear^.Y);
+if Dir < 0 then y:= y - Gear^.Radius
+ else y:= y + Gear^.Radius;
+if (y and $FFFFFC00) = 0 then
+ begin
+ x:= hwRound(Gear^.X) - Gear^.Radius + 1;
+ i:= x + Gear^.Radius * 2 - 2;
+ repeat
+ if (x and $FFFFF800) = 0 then
+ if Land[y, x] > TestWord then exit(true);
+ inc(x)
+ until (x > i);
+ end;
+TestCollisionYwithGear:= false
+end;
+
function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean;
begin
Gear^.X:= Gear^.X + ShiftX;
@@ -129,25 +172,6 @@
Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
end;
-function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): boolean;
-var x, y, i: LongInt;
-begin
-y:= hwRound(Gear^.Y);
-if Dir < 0 then y:= y - Gear^.Radius
- else y:= y + Gear^.Radius;
-if (y and $FFFFFC00) = 0 then
- begin
- x:= hwRound(Gear^.X) - Gear^.Radius + 1;
- i:= x + Gear^.Radius * 2 - 2;
- repeat
- if (x and $FFFFF800) = 0 then
- if Land[y, x] <> 0 then exit(true);
- inc(x)
- until (x > i);
- end;
-TestCollisionYwithGear:= false
-end;
-
function TestCollisionY(Gear: PGear; Dir: LongInt): boolean;
var x, y, i: LongInt;
begin
--- a/hedgewars/uGears.pas Wed May 02 21:37:08 2007 +0000
+++ b/hedgewars/uGears.pas Fri May 04 19:59:51 2007 +0000
@@ -48,6 +48,7 @@
Tag: LongInt;
Surf: PSDL_Surface;
Z: Longword;
+ IntersectGear: PGear;
end;
function AddGear(X, Y: LongInt; Kind: TGearType; State: Longword; dX, dY: hwFloat; Timer: LongWord): PGear;
@@ -175,8 +176,13 @@
Result^.doStep:= doStepHandlers[Kind];
Result^.CollIndex:= High(Longword);
Result^.Timer:= Timer;
+
if CurrentTeam <> nil then
+ begin
Result^.Hedgehog:= @(CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog]);
+ Result^.IntersectGear:= CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog].Gear
+ end;
+
case Kind of
gtCloud: Result^.Z:= High(Result^.Z);
gtAmmo_Bomb: begin
--- a/hedgewars/uLandGraphics.pas Wed May 02 21:37:08 2007 +0000
+++ b/hedgewars/uLandGraphics.pas Fri May 04 19:59:51 2007 +0000
@@ -103,7 +103,6 @@
if (dx = dy) then ChangeCircleLines(x, y, dx, dy, Delta);
end;
-
procedure ClearLandPixel(y, x: LongInt);
var p: PByteArray;
begin