hedgewars/uCollisions.pas
changeset 6124 bee90df26109
parent 6123 0cb751caf0ac
child 6279 7f724835ea57
equal deleted inserted replaced
6123:0cb751caf0ac 6124:bee90df26109
    49 
    49 
    50 function  TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt; withGear: boolean = true): boolean;
    50 function  TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt; withGear: boolean = true): boolean;
    51 function  TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt; withGear: boolean = true): boolean;
    51 function  TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt; withGear: boolean = true): boolean;
    52 
    52 
    53 function  TestRectancleForObstacle(x1, y1, x2, y2: LongInt; landOnly: boolean): boolean;
    53 function  TestRectancleForObstacle(x1, y1, x2, y2: LongInt; landOnly: boolean): boolean;
       
    54 
       
    55 function  CalcSlopeTangentBelowGear(Gear: PGear; var outDeltaX, outDeltaY: LongInt): boolean;
    54 function  CalcSlopeTangent(Gear: PGear; collisionX, collisionY: LongInt; var outDeltaX, outDeltaY: LongInt; TestWord: LongWord): Boolean;
    56 function  CalcSlopeTangent(Gear: PGear; collisionX, collisionY: LongInt; var outDeltaX, outDeltaY: LongInt; TestWord: LongWord): Boolean;
    55 
    57 
    56 implementation
    58 implementation
    57 uses uConsts, uLandGraphics, uVariables, uDebug, uGears;
    59 uses uConsts, uLandGraphics, uVariables, uDebug, uGears;
    58 
    60 
   515 outDeltaX:= ldx;
   517 outDeltaX:= ldx;
   516 outDeltaY:= ldy;
   518 outDeltaY:= ldy;
   517 exit(true);
   519 exit(true);
   518 end;
   520 end;
   519 
   521 
       
   522 function CalcSlopeTangentBelowGear(Gear: PGear; var outDeltaX, outDeltaY: LongInt): boolean;
       
   523 var dx, dy: hwFloat;
       
   524     collX, i, y, x, gx: LongInt;
       
   525     isColl, succ: Boolean;
       
   526 begin
       
   527 // save original dx/dy
       
   528 dx:= Gear^.dX;
       
   529 dy:= Gear^.dY;
       
   530 
       
   531 Gear^.dX.QWordValue:= 0;
       
   532 Gear^.dY:= _1;
       
   533 
       
   534 y:= hwRound(Gear^.Y) + Gear^.Radius;
       
   535 gx:= hwRound(Gear^.X);
       
   536 collX := gx;
       
   537 isColl:= false;
       
   538 
       
   539 if (y and LAND_HEIGHT_MASK) = 0 then
       
   540    begin
       
   541    x:= hwRound(Gear^.X) - Gear^.Radius + 1;
       
   542    i:= x + Gear^.Radius * 2 - 2;
       
   543    repeat
       
   544      if (x and LAND_WIDTH_MASK) = 0 then
       
   545         if Land[y, x] > 255 then
       
   546             if not isColl or (abs(x-gx) < abs(collX-gx)) then
       
   547                 begin
       
   548                 isColl:= true;
       
   549                 collX := x;
       
   550                 end;
       
   551      inc(x)
       
   552    until (x > i);
       
   553    end;
       
   554 
       
   555 if isColl then
       
   556     succ := CalcSlopeTangent(Gear, collX, y, outDeltaX, outDeltaY, 255)
       
   557 else
       
   558     succ := false;
       
   559 
       
   560 // restore original dx/dy
       
   561 Gear^.dX:= dx;
       
   562 Gear^.dY:= dy;
       
   563 
       
   564 CalcSlopeTangentBelowGear := succ;
       
   565 end;
       
   566 
   520 procedure initModule;
   567 procedure initModule;
   521 begin
   568 begin
   522     Count:= 0;
   569     Count:= 0;
   523 end;
   570 end;
   524 
   571