hedgewars/uCollisions.pas
changeset 7754 e81dc9bef8b8
parent 7489 43a998fbacfe
child 7756 b89bd0ffb8aa
equal deleted inserted replaced
7753:dda33caa609d 7754:e81dc9bef8b8
    54 
    54 
    55 function  TestRectancleForObstacle(x1, y1, x2, y2: LongInt; landOnly: boolean): boolean;
    55 function  TestRectancleForObstacle(x1, y1, x2, y2: LongInt; landOnly: boolean): boolean;
    56 
    56 
    57 // returns: negative sign if going downhill to left, value is steepness (noslope/error = _0, 45° = _0_5)
    57 // returns: negative sign if going downhill to left, value is steepness (noslope/error = _0, 45° = _0_5)
    58 function  CalcSlopeBelowGear(Gear: PGear): hwFloat;
    58 function  CalcSlopeBelowGear(Gear: PGear): hwFloat;
       
    59 function  CalcSlopeNearGear(Gear: PGear; dirX, dirY: LongInt): hwFloat;
    59 function  CalcSlopeTangent(Gear: PGear; collisionX, collisionY: LongInt; var outDeltaX, outDeltaY: LongInt; TestWord: LongWord): Boolean;
    60 function  CalcSlopeTangent(Gear: PGear; collisionX, collisionY: LongInt; var outDeltaX, outDeltaY: LongInt; TestWord: LongWord): Boolean;
    60 
    61 
    61 implementation
    62 implementation
    62 uses uConsts, uLandGraphics, uVariables, uDebug, uGearsList;
    63 uses uConsts, uLandGraphics, uVariables, uDebug, uGearsList;
    63 
    64 
   137 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
   138 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
   138 var x, y, i: LongInt;
   139 var x, y, i: LongInt;
   139 begin
   140 begin
   140 // Special case to emulate the old intersect gear clearing, but with a bit of slop for pixel overlap
   141 // Special case to emulate the old intersect gear clearing, but with a bit of slop for pixel overlap
   141 if (Gear^.CollisionMask = $FF7F) and (Gear^.Kind <> gtHedgehog) and (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.Gear <> nil) and
   142 if (Gear^.CollisionMask = $FF7F) and (Gear^.Kind <> gtHedgehog) and (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.Gear <> nil) and
   142     ((hwRound(Gear^.Hedgehog^.Gear^.X) + Gear^.Hedgehog^.Gear^.Radius + 4 < hwRound(Gear^.X) - Gear^.Radius) or
   143     ((hwRound(Gear^.Hedgehog^.Gear^.X) + Gear^.Hedgehog^.Gear^.Radius + 16 < hwRound(Gear^.X) - Gear^.Radius) or
   143      (hwRound(Gear^.Hedgehog^.Gear^.X) - Gear^.Hedgehog^.Gear^.Radius - 4 > hwRound(Gear^.X) + Gear^.Radius)) then
   144      (hwRound(Gear^.Hedgehog^.Gear^.X) - Gear^.Hedgehog^.Gear^.Radius - 16 > hwRound(Gear^.X) + Gear^.Radius)) then
   144     Gear^.CollisionMask:= $FFFF;
   145     Gear^.CollisionMask:= $FFFF;
   145 
   146 
   146 x:= hwRound(Gear^.X);
   147 x:= hwRound(Gear^.X);
   147 if Dir < 0 then
   148 if Dir < 0 then
   148     x:= x - Gear^.Radius
   149     x:= x - Gear^.Radius
   167 function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word;
   168 function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word;
   168 var x, y, i: LongInt;
   169 var x, y, i: LongInt;
   169 begin
   170 begin
   170 // Special case to emulate the old intersect gear clearing, but with a bit of slop for pixel overlap
   171 // Special case to emulate the old intersect gear clearing, but with a bit of slop for pixel overlap
   171 if (Gear^.CollisionMask = $FF7F) and (Gear^.Kind <> gtHedgehog) and (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.Gear <> nil) and
   172 if (Gear^.CollisionMask = $FF7F) and (Gear^.Kind <> gtHedgehog) and (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.Gear <> nil) and
   172     ((hwRound(Gear^.Hedgehog^.Gear^.Y) + Gear^.Hedgehog^.Gear^.Radius + 4 < hwRound(Gear^.Y) - Gear^.Radius) or
   173     ((hwRound(Gear^.Hedgehog^.Gear^.Y) + Gear^.Hedgehog^.Gear^.Radius + 16 < hwRound(Gear^.Y) - Gear^.Radius) or
   173      (hwRound(Gear^.Hedgehog^.Gear^.Y) - Gear^.Hedgehog^.Gear^.Radius - 4 > hwRound(Gear^.Y) + Gear^.Radius)) then
   174      (hwRound(Gear^.Hedgehog^.Gear^.Y) - Gear^.Hedgehog^.Gear^.Radius - 16 > hwRound(Gear^.Y) + Gear^.Radius)) then
   174     Gear^.CollisionMask:= $FFFF;
   175     Gear^.CollisionMask:= $FFFF;
   175 
   176 
   176 y:= hwRound(Gear^.Y);
   177 y:= hwRound(Gear^.Y);
   177 if Dir < 0 then
   178 if Dir < 0 then
   178     y:= y - Gear^.Radius
   179     y:= y - Gear^.Radius
   236 
   237 
   237     for i:= 0 to Pred(Count) do
   238     for i:= 0 to Pred(Count) do
   238         with cinfos[i] do
   239         with cinfos[i] do
   239             if (Gear <> cGear) and (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius + 2))
   240             if (Gear <> cGear) and (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius + 2))
   240             and ((mx > x) xor (Dir > 0)) then
   241             and ((mx > x) xor (Dir > 0)) then
   241                 if ((cGear^.Kind in [gtHedgehog, gtMine]) and ((Gear^.State and gstNotKickable) = 0)) or
   242                 if ((cGear^.Kind in [gtHedgehog, gtMine, gtKnife]) and ((Gear^.State and gstNotKickable) = 0)) or
   242                 // only apply X kick if the barrel is knocked over
   243                 // only apply X kick if the barrel is knocked over
   243                 ((cGear^.Kind = gtExplosives) and ((cGear^.State and gsttmpflag) <> 0)) then
   244                 ((cGear^.Kind = gtExplosives) and ((cGear^.State and gsttmpflag) <> 0)) then
   244                     begin
   245                     begin
   245                     with cGear^ do
   246                     with cGear^ do
   246                         begin
   247                         begin
   247                         dX:= Gear^.dX;
   248                         dX:= Gear^.dX;
   248                         dY:= Gear^.dY * _0_5;
   249                         dY:= Gear^.dY * _0_5;
   249                         State:= State or gstMoving;
   250                         State:= State or gstMoving;
       
   251                         if Kind = gtKnife then State:= State and not gstCollision;
   250                         Active:= true
   252                         Active:= true
   251                         end;
   253                         end;
   252                     DeleteCI(cGear);
   254                     DeleteCI(cGear);
   253                     TestCollisionXKick:= false;
   255                     TestCollisionXKick:= false;
   254                     exit;
   256                     exit;
   296 
   298 
   297     for i:= 0 to Pred(Count) do
   299     for i:= 0 to Pred(Count) do
   298         with cinfos[i] do
   300         with cinfos[i] do
   299             if (Gear <> cGear) and (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius + 2))
   301             if (Gear <> cGear) and (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius + 2))
   300             and ((my > y) xor (Dir > 0)) then
   302             and ((my > y) xor (Dir > 0)) then
   301                 if (cGear^.Kind in [gtHedgehog, gtMine, gtExplosives]) and ((Gear^.State and gstNotKickable) = 0) then
   303                 if (cGear^.Kind in [gtHedgehog, gtMine, gtKnife, gtExplosives]) and ((Gear^.State and gstNotKickable) = 0) then
   302                     begin
   304                     begin
   303                     with cGear^ do
   305                     with cGear^ do
   304                         begin
   306                         begin
   305                         if (Kind <> gtExplosives) or ((State and gsttmpflag) <> 0) then
   307                         if (Kind <> gtExplosives) or ((State and gsttmpflag) <> 0) then
   306                             dX:= Gear^.dX * _0_5;
   308                             dX:= Gear^.dX * _0_5;
   307                         dY:= Gear^.dY;
   309                         dY:= Gear^.dY;
   308                         State:= State or gstMoving;
   310                         State:= State or gstMoving;
       
   311                         if Kind = gtKnife then State:= State and not gstCollision;
   309                         Active:= true
   312                         Active:= true
   310                         end;
   313                         end;
   311                     DeleteCI(cGear);
   314                     DeleteCI(cGear);
   312                     TestCollisionYKick:= false;
   315                     TestCollisionYKick:= false;
   313                     exit
   316                     exit
   574 outDeltaX:= ldx;
   577 outDeltaX:= ldx;
   575 outDeltaY:= ldy;
   578 outDeltaY:= ldy;
   576 CalcSlopeTangent:= true;
   579 CalcSlopeTangent:= true;
   577 end;
   580 end;
   578 
   581 
       
   582 function CalcSlopeNearGear(Gear: PGear; dirX, dirY: LongInt): hwFloat;
       
   583 var dx, dy: hwFloat;
       
   584     collX, collY, i, y, x, gx, gy, sdx, sdy: LongInt;
       
   585     isColl, bSucc: Boolean;
       
   586 begin
       
   587 
       
   588 if dirY <> 0 then 
       
   589     begin
       
   590     y:= hwRound(Gear^.Y) + Gear^.Radius * dirY;
       
   591     gx:= hwRound(Gear^.X);
       
   592     collX := gx;
       
   593     isColl:= false;
       
   594 
       
   595     if (y and LAND_HEIGHT_MASK) = 0 then
       
   596         begin
       
   597         x:= hwRound(Gear^.X) - Gear^.Radius + 1;
       
   598         i:= x + Gear^.Radius * 2 - 2;
       
   599         repeat
       
   600         if (x and LAND_WIDTH_MASK) = 0 then
       
   601             if Land[y, x] <> 0 then
       
   602                 if not isColl or (abs(x-gx) < abs(collX-gx)) then
       
   603                     begin
       
   604                     isColl:= true;
       
   605                     collX := x;
       
   606                     end;
       
   607         inc(x)
       
   608         until (x > i);
       
   609         end;
       
   610     end
       
   611 else
       
   612     begin
       
   613     x:= hwRound(Gear^.X) + Gear^.Radius * dirX;
       
   614     gy:= hwRound(Gear^.Y);
       
   615     collY := gy;
       
   616     isColl:= false;
       
   617 
       
   618     if (x and LAND_WIDTH_MASK) = 0 then
       
   619         begin
       
   620         y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
       
   621         i:= y + Gear^.Radius * 2 - 2;
       
   622         repeat
       
   623         if (y and LAND_HEIGHT_MASK) = 0 then
       
   624             if Land[y, x] <> 0 then
       
   625                 if not isColl or (abs(y-gy) < abs(collY-gy)) then
       
   626                     begin
       
   627                     isColl:= true;
       
   628                     collY := y;
       
   629                     end;
       
   630         inc(y)
       
   631         until (y > i);
       
   632         end;
       
   633     end;
       
   634 
       
   635 if isColl then
       
   636     begin
       
   637     // save original dx/dy
       
   638     dx := Gear^.dX;
       
   639     dy := Gear^.dY;
       
   640 
       
   641     if dirY <> 0 then
       
   642         begin
       
   643         Gear^.dX.QWordValue:= 0;
       
   644         Gear^.dX.isNegative:= (collX >= gx);
       
   645         Gear^.dY:= _1*dirY
       
   646         end
       
   647     else
       
   648         begin
       
   649         Gear^.dY.QWordValue:= 0;
       
   650         Gear^.dY.isNegative:= (collY >= gy);
       
   651         Gear^.dX:= _1*dirX
       
   652         end;
       
   653 
       
   654     sdx:= 0;
       
   655     sdy:= 0;
       
   656     if dirY <> 0 then
       
   657          bSucc := CalcSlopeTangent(Gear, collX, y, sdx, sdy, 0)
       
   658     else bSucc := CalcSlopeTangent(Gear, x, collY, sdx, sdy, 0);
       
   659 
       
   660     // restore original dx/dy
       
   661     Gear^.dX := dx;
       
   662     Gear^.dY := dy;
       
   663 
       
   664     if bSucc and ((sdx <> 0) or (sdy <> 0)) then
       
   665         begin
       
   666         dx := int2hwFloat(sdy) / (abs(sdx) + abs(sdy));
       
   667         dx.isNegative := (sdx * sdy) < 0;
       
   668         exit (dx);
       
   669         end
       
   670     end;
       
   671 
       
   672 CalcSlopeNearGear := _0;
       
   673 end;
       
   674 
   579 function CalcSlopeBelowGear(Gear: PGear): hwFloat;
   675 function CalcSlopeBelowGear(Gear: PGear): hwFloat;
   580 var dx, dy: hwFloat;
   676 var dx, dy: hwFloat;
   581     collX, i, y, x, gx, sdx, sdy: LongInt;
   677     collX, i, y, x, gx, sdx, sdy: LongInt;
   582     isColl, bSucc: Boolean;
   678     isColl, bSucc: Boolean;
   583 begin
   679 begin