# HG changeset patch
# User sheepluva
# Date 1318288057 -7200
# Node ID bee90df261093340998b2b413a2a01a30497c2dc
# Parent  0cb751caf0accad14c72cabd9d0f324f7642c82e
something for nemo to play around with

diff -r 0cb751caf0ac -r bee90df26109 hedgewars/uCollisions.pas
--- a/hedgewars/uCollisions.pas	Tue Oct 11 00:06:46 2011 +0200
+++ b/hedgewars/uCollisions.pas	Tue Oct 11 01:07:37 2011 +0200
@@ -51,6 +51,8 @@
 function  TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt; withGear: boolean = true): boolean;
 
 function  TestRectancleForObstacle(x1, y1, x2, y2: LongInt; landOnly: boolean): boolean;
+
+function  CalcSlopeTangentBelowGear(Gear: PGear; var outDeltaX, outDeltaY: LongInt): boolean;
 function  CalcSlopeTangent(Gear: PGear; collisionX, collisionY: LongInt; var outDeltaX, outDeltaY: LongInt; TestWord: LongWord): Boolean;
 
 implementation
@@ -517,6 +519,51 @@
 exit(true);
 end;
 
+function CalcSlopeTangentBelowGear(Gear: PGear; var outDeltaX, outDeltaY: LongInt): boolean;
+var dx, dy: hwFloat;
+    collX, i, y, x, gx: LongInt;
+    isColl, succ: Boolean;
+begin
+// save original dx/dy
+dx:= Gear^.dX;
+dy:= Gear^.dY;
+
+Gear^.dX.QWordValue:= 0;
+Gear^.dY:= _1;
+
+y:= hwRound(Gear^.Y) + Gear^.Radius;
+gx:= hwRound(Gear^.X);
+collX := gx;
+isColl:= false;
+
+if (y and LAND_HEIGHT_MASK) = 0 then
+   begin
+   x:= hwRound(Gear^.X) - Gear^.Radius + 1;
+   i:= x + Gear^.Radius * 2 - 2;
+   repeat
+     if (x and LAND_WIDTH_MASK) = 0 then
+        if Land[y, x] > 255 then
+            if not isColl or (abs(x-gx) < abs(collX-gx)) then
+                begin
+                isColl:= true;
+                collX := x;
+                end;
+     inc(x)
+   until (x > i);
+   end;
+
+if isColl then
+    succ := CalcSlopeTangent(Gear, collX, y, outDeltaX, outDeltaY, 255)
+else
+    succ := false;
+
+// restore original dx/dy
+Gear^.dX:= dx;
+Gear^.dY:= dy;
+
+CalcSlopeTangentBelowGear := succ;
+end;
+
 procedure initModule;
 begin
     Count:= 0;