hedgewars/uCollisions.pas
author nemo
Mon, 10 Apr 2017 12:06:43 -0400
changeset 12213 bb5522e88ab2
parent 11589 c453620cc6d6
child 12898 8a40ce061d94
permissions -rw-r--r--
bulk copy of latest physfs to our misc/libphysfs since this seems to fix an off-by-1 error reliably hit in readln read of 1 byte probably introduced in the addition of the buffered read. Whether this is excessive or whether libphysfs should even be maintained by us is another matter. But at least we shouldn't crash

(*
 * Hedgewars, a free turn based strategy game
 * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; version 2 of the License
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
 *)

{$INCLUDE "options.inc"}

unit uCollisions;
interface
uses uFloat, uTypes;

const cMaxGearArrayInd = 1023;

type PGearArray = ^TGearArray;
    TGearArray = record
        ar: array[0..cMaxGearArrayInd] of PGear;
        Count: Longword
        end;

procedure initModule;
procedure freeModule;

procedure AddCI(Gear: PGear);
procedure DeleteCI(Gear: PGear);

function  CheckGearsCollision(Gear: PGear): PGearArray;

function  TestCollisionXwithGear(Gear: PGear; Dir: LongInt): Word;
function  TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word;

function  TestCollisionXKick(Gear: PGear; Dir: LongInt): Word;
function  TestCollisionYKick(Gear: PGear; Dir: LongInt): Word;

function  TestCollisionX(Gear: PGear; Dir: LongInt): Word;
function  TestCollisionY(Gear: PGear; Dir: LongInt): Word;

function  TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): Word; inline;
function  TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word;
function  TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): Word; inline;
function  TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word;

function  TestRectangleForObstacle(x1, y1, x2, y2: LongInt; landOnly: boolean): boolean;

function  CheckCoordInWater(X, Y: LongInt): boolean; inline;

// returns: negative sign if going downhill to left, value is steepness (noslope/error = _0, 45 = _0_5)
function  CalcSlopeBelowGear(Gear: PGear): hwFloat;
function  CalcSlopeNearGear(Gear: PGear; dirX, dirY: LongInt): hwFloat;
function  CalcSlopeTangent(Gear: PGear; collisionX, collisionY: LongInt; var outDeltaX, outDeltaY: LongInt; TestWord: LongWord): boolean;

implementation
uses uConsts, uLandGraphics, uVariables;

type TCollisionEntry = record
    X, Y, Radius: LongInt;
    cGear: PGear;
    end;

const MAXRECTSINDEX = 1023;
var Count: Longword;
    cinfos: array[0..MAXRECTSINDEX] of TCollisionEntry;
    ga: TGearArray;

procedure AddCI(Gear: PGear);
begin
if (Gear^.CollisionIndex >= 0) or (Count > MAXRECTSINDEX) or
    ((Count > MAXRECTSINDEX-200) and ((Gear^.Kind = gtMine) or (Gear^.Kind = gtSMine) or (Gear^.Kind = gtKnife))) then
    exit;

with cinfos[Count] do
    begin
    X:= hwRound(Gear^.X);
    Y:= hwRound(Gear^.Y);
    Radius:= Gear^.Radius;
    ChangeRoundInLand(X, Y, Radius - 1, true,  ((CurrentHedgehog <> nil) and (Gear = CurrentHedgehog^.Gear)) or ((Gear^.Kind = gtCase) and (Gear^.State and gstFrozen = 0)), Gear^.Kind = gtHedgehog);
    cGear:= Gear
    end;
Gear^.CollisionIndex:= Count;
inc(Count);
end;

procedure DeleteCI(Gear: PGear);
begin
if Gear^.CollisionIndex >= 0 then
    begin
    with cinfos[Gear^.CollisionIndex] do
        ChangeRoundInLand(X, Y, Radius - 1, false, ((CurrentHedgehog <> nil) and (Gear = CurrentHedgehog^.Gear)) or ((Gear^.Kind = gtCase) and (Gear^.State and gstFrozen = 0)), Gear^.Kind = gtHedgehog);
    cinfos[Gear^.CollisionIndex]:= cinfos[Pred(Count)];
    cinfos[Gear^.CollisionIndex].cGear^.CollisionIndex:= Gear^.CollisionIndex;
    Gear^.CollisionIndex:= -1;
    dec(Count)
    end;
end;

function CheckCoordInWater(X, Y: LongInt): boolean; inline;
begin
    CheckCoordInWater:= (Y > cWaterLine)
        or ((WorldEdge = weSea) and ((X < LongInt(leftX)) or (X > LongInt(rightX))));
end;

function CheckGearsCollision(Gear: PGear): PGearArray;
var mx, my, tr: LongInt;
    i: Longword;
begin
CheckGearsCollision:= @ga;
ga.Count:= 0;
if Count = 0 then
    exit;
mx:= hwRound(Gear^.X);
my:= hwRound(Gear^.Y);

tr:= Gear^.Radius + 2;

for i:= 0 to Pred(Count) do
    with cinfos[i] do
        if (Gear <> cGear) and
            (sqr(mx - x) + sqr(my - y) <= sqr(Radius + tr)) then
                begin
                ga.ar[ga.Count]:= cinfos[i].cGear;
                inc(ga.Count)
                end
end;

function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): Word;
var x, y, i: LongInt;
begin
// Special case to emulate the old intersect gear clearing, but with a bit of slop for pixel overlap
if (Gear^.CollisionMask = lfNotCurrentMask) and (Gear^.Kind <> gtHedgehog) and (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.Gear <> nil) and
    ((hwRound(Gear^.Hedgehog^.Gear^.X) + Gear^.Hedgehog^.Gear^.Radius + 16 < hwRound(Gear^.X) - Gear^.Radius) or
     (hwRound(Gear^.Hedgehog^.Gear^.X) - Gear^.Hedgehog^.Gear^.Radius - 16 > hwRound(Gear^.X) + Gear^.Radius)) then
    Gear^.CollisionMask:= $FFFF;

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] and Gear^.CollisionMask <> 0 then
                exit(Land[y, x] and Gear^.CollisionMask);
        inc(y)
    until (y > i);
    end;
TestCollisionXwithGear:= 0
end;

function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word;
var x, y, i: LongInt;
begin
// Special case to emulate the old intersect gear clearing, but with a bit of slop for pixel overlap
if (Gear^.CollisionMask = lfNotCurrentMask) and (Gear^.Kind <> gtHedgehog) and (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.Gear <> nil) and
    ((hwRound(Gear^.Hedgehog^.Gear^.Y) + Gear^.Hedgehog^.Gear^.Radius + 16 < hwRound(Gear^.Y) - Gear^.Radius) or
     (hwRound(Gear^.Hedgehog^.Gear^.Y) - Gear^.Hedgehog^.Gear^.Radius - 16 > hwRound(Gear^.Y) + Gear^.Radius)) then
    Gear^.CollisionMask:= $FFFF;

y:= hwRound(Gear^.Y);
if Dir < 0 then
    y:= y - Gear^.Radius
else
    y:= y + Gear^.Radius;

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] and Gear^.CollisionMask <> 0 then
                begin
                exit(Land[y, x] and Gear^.CollisionMask)
                end;
        inc(x)
    until (x > i);
    end;
TestCollisionYwithGear:= 0
end;

function TestCollisionXKick(Gear: PGear; Dir: LongInt): Word;
var x, y, mx, my, i: LongInt;
    pixel: Word;
begin
pixel:= 0;
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
            begin
            if Land[y, x] and Gear^.CollisionMask <> 0 then
                begin
                if Land[y, x] and Gear^.CollisionMask > 255 then
                    exit(Land[y, x] and Gear^.CollisionMask)
                else
                    pixel:= Land[y, x] and Gear^.CollisionMask;
                end;
            end;
    inc(y)
    until (y > i);
    end;
TestCollisionXKick:= pixel;

if pixel <> 0 then
    begin
    if hwAbs(Gear^.dX) < cHHKick then
        exit;
    if (Gear^.State and gstHHJumping <> 0)
    and (hwAbs(Gear^.dX) < _0_4) then
        exit;

    mx:= hwRound(Gear^.X);
    my:= hwRound(Gear^.Y);

    for i:= 0 to Pred(Count) do
        with cinfos[i] do
            if  (Gear <> cGear) and
                ((mx > x) xor (Dir > 0)) and
                (
                  ((cGear^.Kind in [gtHedgehog, gtMine, gtKnife]) and ((Gear^.State and gstNotKickable) = 0)) or
                // only apply X kick if the barrel is knocked over
                  ((cGear^.Kind = gtExplosives) and ((cGear^.State and gsttmpflag) <> 0))
                ) and
                (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius + 2)) then
                    begin
                    with cGear^ do
                        begin
                        dX:= Gear^.dX;
                        dY:= Gear^.dY * _0_5;
                        State:= State or gstMoving;
                        if Kind = gtKnife then State:= State and (not gstCollision);
                        Active:= true
                        end;
                    DeleteCI(cGear);
                    exit(0);
                    end
    end
end;

function TestCollisionYKick(Gear: PGear; Dir: LongInt): Word;
var x, y, mx, my,  myr, i: LongInt;
    pixel: Word;
begin
pixel:= 0;
y:= hwRound(Gear^.Y);
if Dir < 0 then
    y:= y - Gear^.Radius
else
    y:= y + Gear^.Radius;

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] > 0 then
            begin
            if Land[y, x] and Gear^.CollisionMask > 255 then
                exit(Land[y, x] and Gear^.CollisionMask)
            else // if Land[y, x] <> 0 then
                pixel:= Land[y, x] and Gear^.CollisionMask;
            end;
    inc(x)
    until (x > i);
    end;
TestCollisionYKick:= pixel;

if pixel <> 0 then
    begin
    if hwAbs(Gear^.dY) < cHHKick then
        exit;
    if (Gear^.State and gstHHJumping <> 0) and (not Gear^.dY.isNegative) and (Gear^.dY < _0_4) then
        exit;

    mx:= hwRound(Gear^.X);
    my:= hwRound(Gear^.Y);
    myr:= my+Gear^.Radius;

    for i:= 0 to Pred(Count) do
        with cinfos[i] do
            if (Gear <> cGear) and
               ((myr > y) xor (Dir > 0)) and
               (Gear^.State and gstNotKickable = 0) and
               (cGear^.Kind in [gtHedgehog, gtMine, gtKnife, gtExplosives]) and
               (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius + 2)) then
                    begin
                    with cGear^ do
                        begin
                        if (Kind <> gtExplosives) or ((State and gsttmpflag) <> 0) then
                            dX:= Gear^.dX * _0_5;
                        dY:= Gear^.dY;
                        State:= State or gstMoving;
                        if Kind = gtKnife then State:= State and (not gstCollision);
                        Active:= true
                        end;
                    DeleteCI(cGear);
                    exit(0)
                    end
    end
end;

function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): Word; inline;
begin
    TestCollisionXwithXYShift:= TestCollisionXwithXYShift(Gear, ShiftX, ShiftY, Dir, true);
end;

function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word;
begin
Gear^.X:= Gear^.X + ShiftX;
Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);
if withGear then
    TestCollisionXwithXYShift:= TestCollisionXwithGear(Gear, Dir)
else TestCollisionXwithXYShift:= TestCollisionX(Gear, Dir);
Gear^.X:= Gear^.X - ShiftX;
Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
end;

function TestCollisionX(Gear: PGear; Dir: LongInt): Word;
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] and Gear^.CollisionMask > 255 then
                exit(Land[y, x] and Gear^.CollisionMask);
    inc(y)
    until (y > i);
    end;
TestCollisionX:= 0
end;

function TestCollisionY(Gear: PGear; Dir: LongInt): Word;
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 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] and Gear^.CollisionMask > 255 then
                exit(Land[y, x] and Gear^.CollisionMask);
    inc(x)
    until (x > i);
    end;
TestCollisionY:= 0
end;

function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): Word; inline;
begin
    TestCollisionYwithXYShift:= TestCollisionYwithXYShift(Gear, ShiftX, ShiftY, Dir, true);
end;

function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word;
begin
Gear^.X:= Gear^.X + int2hwFloat(ShiftX);
Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);

if withGear then
  TestCollisionYwithXYShift:= TestCollisionYwithGear(Gear, Dir)
else
  TestCollisionYwithXYShift:= TestCollisionY(Gear, Dir);

Gear^.X:= Gear^.X - int2hwFloat(ShiftX);
Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
end;

function TestRectangleForObstacle(x1, y1, x2, y2: LongInt; landOnly: boolean): boolean;
var x, y: LongInt;
    TestWord: LongWord;
begin
TestRectangleForObstacle:= true;

if landOnly then
    TestWord:= 255
else
    TestWord:= 0;

if x1 > x2 then
begin
    x  := x1;
    x1 := x2;
    x2 := x;
end;

if y1 > y2 then
begin
    y  := y1;
    y1 := y2;
    y2 := y;
end;

if (hasBorder and ((y1 < 0) or (x1 < 0) or (x2 > LAND_WIDTH))) then
    exit;

for y := y1 to y2 do
    for x := x1 to x2 do
        if ((y and LAND_HEIGHT_MASK) = 0) and ((x and LAND_WIDTH_MASK) = 0) and (Land[y, x] > TestWord) then
            exit;

TestRectangleForObstacle:= false
end;

function CalcSlopeTangent(Gear: PGear; collisionX, collisionY: LongInt; var outDeltaX, outDeltaY: LongInt; TestWord: LongWord): boolean;
var ldx, ldy, rdx, rdy: LongInt;
    i, j, k, mx, my, li, ri, jfr, jto, tmpo : ShortInt;
    tmpx, tmpy: LongWord;
    dx, dy, s: hwFloat;
    offset: array[0..7,0..1] of ShortInt;
    isColl: Boolean;

begin
    CalcSlopeTangent:= false;

    dx:= Gear^.dX;
    dy:= Gear^.dY;

    // we start searching from the direction the gear came from
    if (dx.QWordValue > _0_995.QWordValue )
    or (dy.QWordValue > _0_995.QWordValue ) then
        begin // scale
        s := _0_995 / Distance(dx,dy);
        dx := s * dx;
        dy := s * dy;
        end;

    mx:= hwRound(Gear^.X-dx) - hwRound(Gear^.X);
    my:= hwRound(Gear^.Y-dy) - hwRound(Gear^.Y);

    li:= -1;
    ri:= -1;

    // go around collision pixel, checking for first/last collisions
    // this will determinate what angles will be tried to crawl along
    for i:= 0 to 7 do
        begin
        offset[i,0]:= mx;
        offset[i,1]:= my;

        // multiplicator k tries to skip small pixels/gaps when possible
        for k:= 4 downto 1 do
            begin
            tmpx:= collisionX + k * mx;
            tmpy:= collisionY + k * my;

            if (((tmpy) and LAND_HEIGHT_MASK) = 0) and (((tmpx) and LAND_WIDTH_MASK) = 0) then
                if (Land[tmpy,tmpx] > TestWord) then
                    begin
                    // remember the index belonging to the first and last collision (if in 1st half)
                    if (i <> 0) then
                        begin
                        if (ri = -1) then
                            ri:= i
                        else
                            li:= i;
                        end;
                    end;
            end;

        if i = 7 then
            break;

        // prepare offset for next check (clockwise)
        if (mx = -1) and (my <> -1) then
            my:= my - 1
        else if (my = -1) and (mx <> 1) then
            mx:= mx + 1
        else if (mx = 1) and (my <> 1) then
            my:= my + 1
        else
            mx:= mx - 1;

        end;

    ldx:= collisionX;
    ldy:= collisionY;
    rdx:= collisionX;
    rdy:= collisionY;

    // edge-crawl
    for i:= 0 to 8 do
        begin
        // using mx,my as temporary value buffer here

        jfr:= 8+li+1;
        jto:= 8+li-1;

        isColl:= false;
        for j:= jfr downto jto do
            begin
            tmpo:= j mod 8;
            // multiplicator k tries to skip small pixels/gaps when possible
            for k:= 3 downto 1 do
                begin
                tmpx:= ldx + k * offset[tmpo,0];
                tmpy:= ldy + k * offset[tmpo,1];
                if (((tmpy) and LAND_HEIGHT_MASK) = 0) and (((tmpx) and LAND_WIDTH_MASK)  = 0)
                and (Land[tmpy,tmpx] > TestWord) then
                    begin
                    ldx:= tmpx;
                    ldy:= tmpy;
                    isColl:= true;
                    break;
                    end;
                end;
            if isColl then
                break;
            end;

        jfr:= 8+ri-1;
        jto:= 8+ri+1;

        isColl:= false;
        for j:= jfr to jto do
            begin
            tmpo:= j mod 8;
            for k:= 3 downto 1 do
                begin
                tmpx:= rdx + k * offset[tmpo,0];
                tmpy:= rdy + k * offset[tmpo,1];
                if (((tmpy) and LAND_HEIGHT_MASK) = 0) and (((tmpx) and LAND_WIDTH_MASK)  = 0)
                and (Land[tmpy,tmpx] > TestWord) then
                    begin
                    rdx:= tmpx;
                    rdy:= tmpy;
                    isColl:= true;
                    break;
                    end;
                end;
            if isColl then
                break;
            end;
        end;

    ldx:= rdx - ldx;
    ldy:= rdy - ldy;

    if ((ldx = 0) and (ldy = 0)) then
        exit;

outDeltaX:= ldx;
outDeltaY:= ldy;
CalcSlopeTangent:= true;
end;

function CalcSlopeNearGear(Gear: PGear; dirX, dirY: LongInt): hwFloat;
var dx, dy: hwFloat;
    collX, collY, i, y, x, gx, gy, sdx, sdy: LongInt;
    isColl, bSucc: Boolean;
begin

if dirY <> 0 then
    begin
    y:= hwRound(Gear^.Y) + Gear^.Radius * dirY;
    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] <> 0 then
                if (not isColl) or (abs(x-gx) < abs(collX-gx)) then
                    begin
                    isColl:= true;
                    collX := x;
                    end;
        inc(x)
        until (x > i);
        end;
    end
else
    begin
    x:= hwRound(Gear^.X) + Gear^.Radius * dirX;
    gy:= hwRound(Gear^.Y);
    collY := gy;
    isColl:= false;

    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] <> 0 then
                if (not isColl) or (abs(y-gy) < abs(collY-gy)) then
                    begin
                    isColl:= true;
                    collY := y;
                    end;
        inc(y)
        until (y > i);
        end;
    end;

if isColl then
    begin
    // save original dx/dy
    dx := Gear^.dX;
    dy := Gear^.dY;

    if dirY <> 0 then
        begin
        Gear^.dX.QWordValue:= 0;
        Gear^.dX.isNegative:= (collX >= gx);
        Gear^.dY:= _1*dirY
        end
    else
        begin
        Gear^.dY.QWordValue:= 0;
        Gear^.dY.isNegative:= (collY >= gy);
        Gear^.dX:= _1*dirX
        end;

    sdx:= 0;
    sdy:= 0;
    if dirY <> 0 then
         bSucc := CalcSlopeTangent(Gear, collX, y, sdx, sdy, 0)
    else bSucc := CalcSlopeTangent(Gear, x, collY, sdx, sdy, 0);

    // restore original dx/dy
    Gear^.dX := dx;
    Gear^.dY := dy;

    if bSucc and ((sdx <> 0) or (sdy <> 0)) then
        begin
        dx := int2hwFloat(sdy) / (abs(sdx) + abs(sdy));
        dx.isNegative := (sdx * sdy) < 0;
        exit (dx);
        end
    end;

CalcSlopeNearGear := _0;
end;

function CalcSlopeBelowGear(Gear: PGear): hwFloat;
var dx, dy: hwFloat;
    collX, i, y, x, gx, sdx, sdy: LongInt;
    isColl, bSucc: Boolean;
begin


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
    begin
    // save original dx/dy
    dx := Gear^.dX;
    dy := Gear^.dY;

    Gear^.dX.QWordValue:= 0;
    Gear^.dX.isNegative:= (collX >= gx);
    Gear^.dY:= _1;

    sdx:= 0;
    sdy:= 0;
    bSucc := CalcSlopeTangent(Gear, collX, y, sdx, sdy, 255);

    // restore original dx/dy
    Gear^.dX := dx;
    Gear^.dY := dy;

    if bSucc and (sdx <> 0) and (sdy <> 0) then
    begin
        dx := int2hwFloat(sdy) / (abs(sdx) + abs(sdy));
        dx.isNegative := (sdx * sdy) < 0;
        exit (dx);
    end;
    end;

CalcSlopeBelowGear := _0;
end;

procedure initModule;
begin
    Count:= 0;
end;

procedure freeModule;
begin

end;

end.