fix sticky rope issue
authorsheepluva
Fri, 31 Dec 2010 21:39:12 +0100
changeset 4798 84fb1ff0a1c0
parent 4797 15a443eec371
child 4799 0f408159a33f
fix sticky rope issue
hedgewars/GSHandlers.inc
hedgewars/uCollisions.pas
--- a/hedgewars/GSHandlers.inc	Fri Dec 31 21:33:13 2010 +0100
+++ b/hedgewars/GSHandlers.inc	Fri Dec 31 21:39:12 2010 +0100
@@ -182,6 +182,14 @@
     else Gear^.State := Gear^.State and not gstCollision
 end;
 
+procedure CheckCollisionWithLand(Gear: PGear); inline;
+begin
+    if TestCollisionX(Gear, hwSign(Gear^.X)) or TestCollisionY(Gear, hwSign(Gear^.Y)
+       )
+        then Gear^.State := Gear^.State or      gstCollision
+    else Gear^.State := Gear^.State and not gstCollision
+end;
+
 procedure CheckHHDamage(Gear: PGear);
 var 
     dmg: Longword;
@@ -1585,9 +1593,7 @@
             end;
         end;
 
-    if ((hwRound(Gear^.Y) and LAND_HEIGHT_MASK) = 0) and ((hwRound(Gear^.X) and LAND_WIDTH_MASK) = 0) and ((Land[hwRound(Gear^.Y), hwRound(Gear^.X)] and $FF00) <> 0) then
-        Gear^.State:= Gear^.State or gstCollision
-    else Gear^.State:= Gear^.State and not gstCollision;
+    CheckCollisionWithLand(Gear);
 
     if (Gear^.State and gstCollision) <> 0 then
         if Gear^.Elasticity < _10 then
--- a/hedgewars/uCollisions.pas	Fri Dec 31 21:33:13 2010 +0100
+++ b/hedgewars/uCollisions.pas	Fri Dec 31 21:39:12 2010 +0100
@@ -44,6 +44,7 @@
 function  TestCollisionXKick(Gear: PGear; Dir: LongInt): boolean;
 function  TestCollisionYKick(Gear: PGear; Dir: LongInt): boolean;
 
+function  TestCollisionX(Gear: PGear; Dir: LongInt): boolean;
 function  TestCollisionY(Gear: PGear; Dir: LongInt): boolean;
 
 function  TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean;
@@ -289,6 +290,24 @@
 Gear^.X:= Gear^.X - ShiftX;
 Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
 end;
+function TestCollisionX(Gear: PGear; Dir: LongInt): boolean;
+var x, y, i: LongInt;
+begin
+x:= hwRound(Gear^.X);
+if Dir < 0 then x:= x - Gear^.Radius
+           else x:= x + Gear^.Radius;
+if (x and LAND_WIDTH_MASK) = 0 then
+   begin
+   y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
+   i:= y + Gear^.Radius * 2 - 2;
+   repeat
+     if (y and LAND_HEIGHT_MASK) = 0 then
+        if Land[y, x] > 255 then exit(true);
+     inc(y)
+   until (y > i);
+   end;
+TestCollisionX:= false
+end;
 
 function TestCollisionY(Gear: PGear; Dir: LongInt): boolean;
 var x, y, i: LongInt;