hedgewars/uCollisions.pas
changeset 15668 c2a1a34d1841
parent 15653 b2ed495a7fb1
child 15677 116307c752f6
equal deleted inserted replaced
15667:fb1f47e382d0 15668:c2a1a34d1841
    50 type TLineCollision = record
    50 type TLineCollision = record
    51         hasCollision: Boolean;
    51         hasCollision: Boolean;
    52         cX, cY: LongInt; //for visual effects only
    52         cX, cY: LongInt; //for visual effects only
    53         end;
    53         end;
    54 
    54 
       
    55 type TKickTest = record
       
    56         kick: Boolean;
       
    57         collisionMask: Word;
       
    58     end;
       
    59 
    55 procedure initModule;
    60 procedure initModule;
    56 procedure freeModule;
    61 procedure freeModule;
    57 
    62 
    58 procedure AddCI(Gear: PGear);
    63 procedure AddCI(Gear: PGear);
    59 procedure DeleteCI(Gear: PGear);
    64 procedure DeleteCI(Gear: PGear);
    71 
    76 
    72 procedure RefillProximityCache(SourceGear: PGear; radius: LongInt);
    77 procedure RefillProximityCache(SourceGear: PGear; radius: LongInt);
    73 procedure RemoveFromProximityCache(Gear: PGear);
    78 procedure RemoveFromProximityCache(Gear: PGear);
    74 procedure ClearProximityCache();
    79 procedure ClearProximityCache();
    75 
    80 
    76 function  TestCollisionXwithGear(Gear: PGear; Dir: LongInt): Word;
    81 function  TestCollisionXImpl(centerX, centerY, radius, direction: LongInt; collisionMask: Word): Word;
    77 function  TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word;
    82 function  TestCollisionYImpl(centerX, centerY, radius, direction: LongInt; collisionMask: Word): Word;
       
    83 
       
    84 function  TestCollisionXwithGear(Gear: PGear; Dir: LongInt): Word; inline;
       
    85 function  TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word; inline;
       
    86 
       
    87 function  TestCollisionX(Gear: PGear; Dir: LongInt): Word; inline;
       
    88 function  TestCollisionY(Gear: PGear; Dir: LongInt): Word; inline;
       
    89 
       
    90 function  TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): Word; inline;
       
    91 function  TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word; inline;
       
    92 function  TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): Word; inline;
       
    93 function  TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word; inline;
       
    94 
       
    95 function  TestCollisionXKickImpl(centerX, centerY, radius, direction: LongInt; collisionMask, kickMask: Word): TKickTest;
       
    96 function  TestCollisionYKickImpl(centerX, centerY, radius, direction: LongInt; collisionMask, kickMask: Word): TKickTest;
    78 
    97 
    79 function  TestCollisionXKick(Gear: PGear; Dir: LongInt): Word;
    98 function  TestCollisionXKick(Gear: PGear; Dir: LongInt): Word;
    80 function  TestCollisionYKick(Gear: PGear; Dir: LongInt): Word;
    99 function  TestCollisionYKick(Gear: PGear; Dir: LongInt): Word;
    81 
       
    82 function  TestCollisionX(Gear: PGear; Dir: LongInt): Word;
       
    83 function  TestCollisionY(Gear: PGear; Dir: LongInt): Word;
       
    84 
       
    85 function  TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): Word; inline;
       
    86 function  TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word;
       
    87 function  TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): Word; inline;
       
    88 function  TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word;
       
    89 
   100 
    90 function  TestRectangleForObstacle(x1, y1, x2, y2: LongInt; landOnly: boolean): boolean;
   101 function  TestRectangleForObstacle(x1, y1, x2, y2: LongInt; landOnly: boolean): boolean;
    91 
   102 
    92 function  CheckCoordInWater(X, Y: LongInt): boolean; inline;
   103 function  CheckCoordInWater(X, Y: LongInt): boolean; inline;
    93 
   104 
   421 procedure ClearProximityCache();
   432 procedure ClearProximityCache();
   422 begin
   433 begin
   423     proximitya.Count:= 0;
   434     proximitya.Count:= 0;
   424 end;
   435 end;
   425 
   436 
   426 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): Word;
   437 function TestCollisionXImpl(centerX, centerY, radius, direction: LongInt; collisionMask: Word): Word;
   427 var x, y, i: LongInt;
   438 var x, y, minY, maxY: LongInt;
       
   439 begin
       
   440     if direction < 0 then
       
   441         x := centerX - radius
       
   442     else
       
   443         x := centerX + radius;
       
   444 
       
   445     if (x and LAND_WIDTH_MASK) = 0 then
       
   446     begin
       
   447         minY := max(centerY - radius + 1, 0);
       
   448         maxY := min(centerY + radius - 1, LAND_HEIGHT - 1);
       
   449         for y := minY to maxY do
       
   450             if Land[y, x] and collisionMask <> 0 then
       
   451                 exit(Land[y, x] and collisionMask);
       
   452     end;
       
   453     TestCollisionXImpl := 0;
       
   454 end;
       
   455 
       
   456 function TestCollisionYImpl(centerX, centerY, radius, direction: LongInt; collisionMask: Word): Word;
       
   457 var x, y, minX, maxX: LongInt;
       
   458 begin
       
   459     if direction < 0 then
       
   460         y := centerY - radius
       
   461     else
       
   462         y := centerY + radius;
       
   463 
       
   464     if (y and LAND_HEIGHT_MASK) = 0 then
       
   465     begin
       
   466         minX := max(centerX - radius + 1, 0);
       
   467         maxX := min(centerX + radius - 1, LAND_WIDTH - 1);
       
   468         for x := minX to maxX do
       
   469             if Land[y, x] and collisionMask <> 0 then
       
   470                 exit(Land[y, x] and collisionMask);
       
   471     end;
       
   472     TestCollisionYImpl := 0;
       
   473 end;
       
   474 
       
   475 function TestCollisionX(Gear: PGear; Dir: LongInt): Word; inline;
       
   476 begin
       
   477     TestCollisionX := TestCollisionXImpl(hwRound(Gear^.X), hwRound(Gear^.Y), Gear^.Radius, Dir, Gear^.CollisionMask and lfLandMask);
       
   478 end;
       
   479 
       
   480 function TestCollisionY(Gear: PGear; Dir: LongInt): Word; inline;
       
   481 begin
       
   482     TestCollisionY := TestCollisionYImpl(hwRound(Gear^.X), hwRound(Gear^.Y), Gear^.Radius, Dir, Gear^.CollisionMask and lfLandMask);
       
   483 end;
       
   484 
       
   485 procedure LegacyFixupX(Gear: PGear);
   428 begin
   486 begin
   429 // Special case to emulate the old intersect gear clearing, but with a bit of slop for pixel overlap
   487 // Special case to emulate the old intersect gear clearing, but with a bit of slop for pixel overlap
   430 if (Gear^.CollisionMask = lfNotCurHogCrate) and (Gear^.Kind <> gtHedgehog) and (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.Gear <> nil) and
   488     if (Gear^.CollisionMask = lfNotCurHogCrate) and (Gear^.Kind <> gtHedgehog) and (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.Gear <> nil) and
   431     ((hwRound(Gear^.Hedgehog^.Gear^.X) + Gear^.Hedgehog^.Gear^.Radius + 16 < hwRound(Gear^.X) - Gear^.Radius) or
   489     ((hwRound(Gear^.Hedgehog^.Gear^.X) + Gear^.Hedgehog^.Gear^.Radius + 16 < hwRound(Gear^.X) - Gear^.Radius) or
   432      (hwRound(Gear^.Hedgehog^.Gear^.X) - Gear^.Hedgehog^.Gear^.Radius - 16 > hwRound(Gear^.X) + Gear^.Radius)) then
   490     (hwRound(Gear^.Hedgehog^.Gear^.X) - Gear^.Hedgehog^.Gear^.Radius - 16 > hwRound(Gear^.X) + Gear^.Radius)) then
   433     Gear^.CollisionMask:= lfAll;
   491         Gear^.CollisionMask:= lfAll;
   434 
   492 end;
   435 x:= hwRound(Gear^.X);
   493 
   436 if Dir < 0 then
   494 procedure LegacyFixupY(Gear: PGear);
   437     x:= x - Gear^.Radius
       
   438 else
       
   439     x:= x + Gear^.Radius;
       
   440 
       
   441 if (x and LAND_WIDTH_MASK) = 0 then
       
   442     begin
       
   443     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
       
   444     i:= y + Gear^.Radius * 2 - 2;
       
   445     repeat
       
   446         if (y and LAND_HEIGHT_MASK) = 0 then
       
   447             if Land[y, x] and Gear^.CollisionMask <> 0 then
       
   448                 exit(Land[y, x] and Gear^.CollisionMask);
       
   449         inc(y)
       
   450     until (y > i);
       
   451     end;
       
   452 TestCollisionXwithGear:= 0
       
   453 end;
       
   454 
       
   455 function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word;
       
   456 var x, y, i: LongInt;
       
   457 begin
   495 begin
   458 // Special case to emulate the old intersect gear clearing, but with a bit of slop for pixel overlap
   496 // Special case to emulate the old intersect gear clearing, but with a bit of slop for pixel overlap
   459 if (Gear^.CollisionMask = lfNotCurHogCrate) and (Gear^.Kind <> gtHedgehog) and (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.Gear <> nil) and
   497     if (Gear^.CollisionMask = lfNotCurHogCrate) and (Gear^.Kind <> gtHedgehog) and (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.Gear <> nil) and
   460     ((hwRound(Gear^.Hedgehog^.Gear^.Y) + Gear^.Hedgehog^.Gear^.Radius + 16 < hwRound(Gear^.Y) - Gear^.Radius) or
   498     ((hwRound(Gear^.Hedgehog^.Gear^.Y) + Gear^.Hedgehog^.Gear^.Radius + 16 < hwRound(Gear^.Y) - Gear^.Radius) or
   461      (hwRound(Gear^.Hedgehog^.Gear^.Y) - Gear^.Hedgehog^.Gear^.Radius - 16 > hwRound(Gear^.Y) + Gear^.Radius)) then
   499     (hwRound(Gear^.Hedgehog^.Gear^.Y) - Gear^.Hedgehog^.Gear^.Radius - 16 > hwRound(Gear^.Y) + Gear^.Radius)) then
   462     Gear^.CollisionMask:= lfAll;
   500         Gear^.CollisionMask:= lfAll;
   463 
   501 end;
   464 y:= hwRound(Gear^.Y);
   502 
   465 if Dir < 0 then
   503 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): Word; inline;
   466     y:= y - Gear^.Radius
   504 begin
   467 else
   505     LegacyFixupX(Gear);
   468     y:= y + Gear^.Radius;
   506     TestCollisionXwithGear:= TestCollisionXImpl(hwRound(Gear^.X), hwRound(Gear^.Y), Gear^.Radius, Dir, Gear^.CollisionMask);
   469 
   507 end;
   470 if (y and LAND_HEIGHT_MASK) = 0 then
   508 
   471     begin
   509 function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word; inline;
   472     x:= hwRound(Gear^.X) - Gear^.Radius + 1;
   510 begin
   473     i:= x + Gear^.Radius * 2 - 2;
   511     LegacyFixupY(Gear);
   474     repeat
   512     TestCollisionYwithGear:= TestCollisionYImpl(hwRound(Gear^.X), hwRound(Gear^.Y), Gear^.Radius, Dir, Gear^.CollisionMask);
   475         if (x and LAND_WIDTH_MASK) = 0 then
   513 end;
   476             if Land[y, x] and Gear^.CollisionMask <> 0 then
   514 
       
   515 function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word; inline;
       
   516 var collisionMask: Word;
       
   517 begin
       
   518     if withGear then
       
   519     begin
       
   520         LegacyFixupX(Gear);
       
   521         collisionMask:= Gear^.CollisionMask;
       
   522     end
       
   523     else
       
   524         collisionMask:= Gear^.CollisionMask and lfLandMask;
       
   525 
       
   526     TestCollisionXwithXYShift := TestCollisionXImpl(hwRound(Gear^.X + ShiftX), hwRound(Gear^.Y) + ShiftY, Gear^.Radius, Dir, collisionMask)
       
   527 end;
       
   528 
       
   529 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word; inline;
       
   530 var collisionMask: Word;
       
   531 begin
       
   532     if withGear then
       
   533     begin
       
   534         LegacyFixupY(Gear);
       
   535         collisionMask:= Gear^.CollisionMask;
       
   536     end
       
   537     else
       
   538         collisionMask:= Gear^.CollisionMask and lfLandMask;
       
   539 
       
   540     TestCollisionYwithXYShift := TestCollisionYImpl(hwRound(Gear^.X) + ShiftX, hwRound(Gear^.Y) + ShiftY, Gear^.Radius, Dir, collisionMask)
       
   541 end;
       
   542 
       
   543 function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): Word; inline;
       
   544 begin
       
   545     TestCollisionXwithXYShift:= TestCollisionXwithXYShift(Gear, ShiftX, ShiftY, Dir, true);
       
   546 end;
       
   547 
       
   548 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): Word; inline;
       
   549 begin
       
   550     TestCollisionYwithXYShift:= TestCollisionYwithXYShift(Gear, ShiftX, ShiftY, Dir, true);
       
   551 end;
       
   552 
       
   553 function TestCollisionXKickImpl(centerX, centerY, radius, direction: LongInt; collisionMask, kickMask: Word): TKickTest;
       
   554 var x, y, minY, maxY: LongInt;
       
   555 begin
       
   556     TestCollisionXKickImpl.kick := false;
       
   557     TestCollisionXKickImpl.collisionMask := 0;
       
   558 
       
   559     if direction < 0 then
       
   560         x := centerX - radius
       
   561     else
       
   562         x := centerX + radius;
       
   563 
       
   564     if (x and LAND_WIDTH_MASK) = 0 then
       
   565     begin
       
   566         minY := max(centerY - radius + 1, 0);
       
   567         maxY := min(centerY + radius - 1, LAND_HEIGHT - 1);
       
   568         for y := minY to maxY do
       
   569             if Land[y, x] and collisionMask <> 0 then
       
   570             begin
       
   571                 TestCollisionXKickImpl.kick := false;
       
   572                 TestCollisionXKickImpl.collisionMask := Land[y, x] and collisionMask;
       
   573                 exit
       
   574             end
       
   575             else if Land[y, x] and kickMask <> 0 then
       
   576             begin
       
   577                 TestCollisionXKickImpl.kick := true;
       
   578                 TestCollisionXKickImpl.collisionMask := Land[y, x] and kickMask;
       
   579             end;
       
   580     end;
       
   581 end;
       
   582 
       
   583 function TestCollisionYKickImpl(centerX, centerY, radius, direction: LongInt; collisionMask, kickMask: Word): TKickTest;
       
   584 var x, y, minX, maxX: LongInt;
       
   585 begin
       
   586     TestCollisionYKickImpl.kick := false;
       
   587     TestCollisionYKickImpl.collisionMask := 0;
       
   588 
       
   589     if direction < 0 then
       
   590         y := centerY - radius
       
   591     else
       
   592         y := centerY + radius;
       
   593 
       
   594     if (y and LAND_HEIGHT_MASK) = 0 then
       
   595     begin
       
   596         minX := max(centerX - radius + 1, 0);
       
   597         maxX := min(centerX + radius - 1, LAND_WIDTH - 1);
       
   598         for x := minX to maxX do
       
   599             if Land[y, x] and collisionMask <> 0 then
       
   600             begin
       
   601                 TestCollisionYKickImpl.kick := false;
       
   602                 TestCollisionYKickImpl.collisionMask := Land[y, x] and collisionMask;
       
   603                 exit
       
   604             end
       
   605             else if Land[y, x] and kickMask <> 0 then
       
   606             begin
       
   607                 TestCollisionYKickImpl.kick := true;
       
   608                 TestCollisionYKickImpl.collisionMask := Land[y, x] and kickMask;
       
   609             end;
       
   610     end;
       
   611 end;
       
   612 
       
   613 function TestCollisionXKick(Gear: PGear; Dir: LongInt): Word;
       
   614 var centerX, centerY, i: LongInt;
       
   615     test: TKickTest;
       
   616     info: TCollisionEntry;
       
   617 begin
       
   618     test := TestCollisionXKickImpl(
       
   619         hwRound(Gear^.X), hwRound(Gear^.Y),
       
   620         Gear^.Radius, Dir,
       
   621         Gear^.CollisionMask and lfLandMask, Gear^.CollisionMask);
       
   622 
       
   623     TestCollisionXKick := test.collisionMask;
       
   624 
       
   625     if test.kick then
       
   626     begin
       
   627         if hwAbs(Gear^.dX) < cHHKick then
       
   628             exit;
       
   629         if ((Gear^.State and gstHHJumping) <> 0) and (hwAbs(Gear^.dX) < _0_4) then
       
   630             exit;
       
   631 
       
   632         centerX := hwRound(Gear^.X);
       
   633         centerY := hwRound(Gear^.Y);
       
   634 
       
   635         for i:= 0 to Pred(Count) do
       
   636         begin
       
   637             info:= cinfos[i];
       
   638             if (Gear <> info.cGear)
       
   639                 and ((centerX > info.X) xor (Dir > 0))
       
   640                 and ((info.cGear^.State and gstNotKickable) = 0)
       
   641                 and ((info.cGear^.Kind in [gtHedgehog, gtMine, gtKnife])
       
   642                     or (info.cGear^.Kind = gtExplosives) and ((info.cGear^.State and gsttmpflag) <> 0)) // only apply X kick if the barrel is knocked over
       
   643                 and (sqr(centerX - info.X) + sqr(centerY - info.Y) <= sqr(info.Radius + Gear^.Radius + 2)) then
       
   644             begin
       
   645                 with info.cGear^ do
   477                 begin
   646                 begin
   478                 exit(Land[y, x] and Gear^.CollisionMask)
   647                     dX := Gear^.dX;
       
   648                     dY := Gear^.dY * _0_5;
       
   649                     State := State or gstMoving;
       
   650                     if Kind = gtKnife then State := State and (not gstCollision);
       
   651                     Active:= true
   479                 end;
   652                 end;
   480         inc(x)
   653                 DeleteCI(info.cGear);
   481     until (x > i);
   654                 exit(0)
   482     end;
   655             end
   483 TestCollisionYwithGear:= 0
   656         end
   484 end;
   657     end
   485 
   658 end;
   486 function TestCollisionXKick(Gear: PGear; Dir: LongInt): Word;
   659 
   487 var x, y, mx, my, i: LongInt;
   660 function TestCollisionYKick(Gear: PGear; Dir: LongInt): Word;
   488     pixel: Word;
   661 var centerX, centerY, i: LongInt;
   489 begin
   662     test: TKickTest;
   490 pixel:= 0;
   663     info: TCollisionEntry;
   491 x:= hwRound(Gear^.X);
   664 begin
   492 if Dir < 0 then
   665     test := TestCollisionYKickImpl(
   493     x:= x - Gear^.Radius
   666         hwRound(Gear^.X), hwRound(Gear^.Y),
   494 else
   667         Gear^.Radius, Dir,
   495     x:= x + Gear^.Radius;
   668         Gear^.CollisionMask and lfLandMask, Gear^.CollisionMask);
   496 
   669 
   497 if (x and LAND_WIDTH_MASK) = 0 then
   670     TestCollisionYKick := test.collisionMask;
   498     begin
   671 
   499     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
   672     if test.kick then
   500     i:= y + Gear^.Radius * 2 - 2;
   673     begin
   501     repeat
   674         if hwAbs(Gear^.dY) < cHHKick then
   502         if (y and LAND_HEIGHT_MASK) = 0 then
   675             exit;
   503             begin
   676         if ((Gear^.State and gstHHJumping) <> 0) and (not Gear^.dY.isNegative) and (Gear^.dY < _0_4) then
   504             if Land[y, x] and Gear^.CollisionMask <> 0 then
   677             exit;
       
   678 
       
   679         centerX := hwRound(Gear^.X);
       
   680         centerY := hwRound(Gear^.Y);
       
   681 
       
   682         for i := 0 to Pred(Count) do
       
   683         begin
       
   684             info := cinfos[i];
       
   685             if (Gear <> info.cGear)
       
   686                 and ((centerY + Gear^.Radius > info.Y) xor (Dir > 0))
       
   687                 and (info.cGear^.State and gstNotKickable = 0)
       
   688                 and (info.cGear^.Kind in [gtHedgehog, gtMine, gtKnife, gtExplosives])
       
   689                 and (sqr(centerX - info.X) + sqr(centerY - info.Y) <= sqr(info.Radius + Gear^.Radius + 2)) then
       
   690             begin
       
   691                 with info.cGear^ do
   505                 begin
   692                 begin
   506                 if ((Land[y, x] and Gear^.CollisionMask) and lfLandMask) <> 0 then
   693                     if (Kind <> gtExplosives) or ((State and gsttmpflag) <> 0) then
   507                     exit(Land[y, x] and Gear^.CollisionMask)
   694                         dX := Gear^.dX * _0_5;
   508                 else
   695                     dY := Gear^.dY;
   509                     pixel:= Land[y, x] and Gear^.CollisionMask;
   696                     State := State or gstMoving;
       
   697                     if Kind = gtKnife then State:= State and (not gstCollision);
       
   698                     Active := true
   510                 end;
   699                 end;
   511             end;
   700                 DeleteCI(info.cGear);
   512     inc(y)
   701                 exit(0)
   513     until (y > i);
   702             end
   514     end;
   703         end
   515 TestCollisionXKick:= pixel;
       
   516 
       
   517 if pixel <> 0 then
       
   518     begin
       
   519     if hwAbs(Gear^.dX) < cHHKick then
       
   520         exit;
       
   521     if (Gear^.State and gstHHJumping <> 0)
       
   522     and (hwAbs(Gear^.dX) < _0_4) then
       
   523         exit;
       
   524 
       
   525     mx:= hwRound(Gear^.X);
       
   526     my:= hwRound(Gear^.Y);
       
   527 
       
   528     for i:= 0 to Pred(Count) do
       
   529         with cinfos[i] do
       
   530             if  (Gear <> cGear) and
       
   531                 ((mx > x) xor (Dir > 0)) and
       
   532                 (
       
   533                   ((cGear^.Kind in [gtHedgehog, gtMine, gtKnife]) and ((cGear^.State and gstNotKickable) = 0)) or
       
   534                 // only apply X kick if the barrel is knocked over
       
   535                   ((cGear^.Kind = gtExplosives) and ((cGear^.State and gsttmpflag) <> 0))
       
   536                 ) and
       
   537                 (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius + 2)) then
       
   538                     begin
       
   539                     with cGear^ do
       
   540                         begin
       
   541                         dX:= Gear^.dX;
       
   542                         dY:= Gear^.dY * _0_5;
       
   543                         State:= State or gstMoving;
       
   544                         if Kind = gtKnife then State:= State and (not gstCollision);
       
   545                         Active:= true
       
   546                         end;
       
   547                     DeleteCI(cGear);
       
   548                     exit(0);
       
   549                     end
       
   550     end
   704     end
   551 end;
       
   552 
       
   553 function TestCollisionYKick(Gear: PGear; Dir: LongInt): Word;
       
   554 var x, y, mx, my,  myr, i: LongInt;
       
   555     pixel: Word;
       
   556 begin
       
   557 pixel:= 0;
       
   558 y:= hwRound(Gear^.Y);
       
   559 if Dir < 0 then
       
   560     y:= y - Gear^.Radius
       
   561 else
       
   562     y:= y + Gear^.Radius;
       
   563 
       
   564 if (y and LAND_HEIGHT_MASK) = 0 then
       
   565     begin
       
   566     x:= hwRound(Gear^.X) - Gear^.Radius + 1;
       
   567     i:= x + Gear^.Radius * 2 - 2;
       
   568     repeat
       
   569     if (x and LAND_WIDTH_MASK) = 0 then
       
   570         if Land[y, x] > 0 then
       
   571             begin
       
   572             if ((Land[y, x] and Gear^.CollisionMask) and lfLandMask) <> 0 then
       
   573                 exit(Land[y, x] and Gear^.CollisionMask)
       
   574             else // if Land[y, x] <> 0 then
       
   575                 pixel:= Land[y, x] and Gear^.CollisionMask;
       
   576             end;
       
   577     inc(x)
       
   578     until (x > i);
       
   579     end;
       
   580 TestCollisionYKick:= pixel;
       
   581 
       
   582 if pixel <> 0 then
       
   583     begin
       
   584     if hwAbs(Gear^.dY) < cHHKick then
       
   585         exit;
       
   586     if (Gear^.State and gstHHJumping <> 0) and (not Gear^.dY.isNegative) and (Gear^.dY < _0_4) then
       
   587         exit;
       
   588 
       
   589     mx:= hwRound(Gear^.X);
       
   590     my:= hwRound(Gear^.Y);
       
   591     myr:= my+Gear^.Radius;
       
   592 
       
   593     for i:= 0 to Pred(Count) do
       
   594         with cinfos[i] do
       
   595             if (Gear <> cGear) and
       
   596                ((myr > y) xor (Dir > 0)) and
       
   597                (cGear^.State and gstNotKickable = 0) and
       
   598                (cGear^.Kind in [gtHedgehog, gtMine, gtKnife, gtExplosives]) and
       
   599                (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius + 2)) then
       
   600                     begin
       
   601                     with cGear^ do
       
   602                         begin
       
   603                         if (Kind <> gtExplosives) or ((State and gsttmpflag) <> 0) then
       
   604                             dX:= Gear^.dX * _0_5;
       
   605                         dY:= Gear^.dY;
       
   606                         State:= State or gstMoving;
       
   607                         if Kind = gtKnife then State:= State and (not gstCollision);
       
   608                         Active:= true
       
   609                         end;
       
   610                     DeleteCI(cGear);
       
   611                     exit(0)
       
   612                     end
       
   613     end
       
   614 end;
       
   615 
       
   616 function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): Word; inline;
       
   617 begin
       
   618     TestCollisionXwithXYShift:= TestCollisionXwithXYShift(Gear, ShiftX, ShiftY, Dir, true);
       
   619 end;
       
   620 
       
   621 function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word;
       
   622 begin
       
   623 Gear^.X:= Gear^.X + ShiftX;
       
   624 Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);
       
   625 if withGear then
       
   626     TestCollisionXwithXYShift:= TestCollisionXwithGear(Gear, Dir)
       
   627 else TestCollisionXwithXYShift:= TestCollisionX(Gear, Dir);
       
   628 Gear^.X:= Gear^.X - ShiftX;
       
   629 Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
       
   630 end;
       
   631 
       
   632 function TestCollisionX(Gear: PGear; Dir: LongInt): Word;
       
   633 var x, y, i: LongInt;
       
   634 begin
       
   635 x:= hwRound(Gear^.X);
       
   636 if Dir < 0 then
       
   637     x:= x - Gear^.Radius
       
   638 else
       
   639     x:= x + Gear^.Radius;
       
   640 
       
   641 if (x and LAND_WIDTH_MASK) = 0 then
       
   642     begin
       
   643     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
       
   644     i:= y + Gear^.Radius * 2 - 2;
       
   645     repeat
       
   646         if (y and LAND_HEIGHT_MASK) = 0 then
       
   647             if ((Land[y, x] and Gear^.CollisionMask) and lfLandMask) <> 0 then
       
   648                 exit(Land[y, x] and Gear^.CollisionMask);
       
   649     inc(y)
       
   650     until (y > i);
       
   651     end;
       
   652 TestCollisionX:= 0
       
   653 end;
       
   654 
       
   655 function TestCollisionY(Gear: PGear; Dir: LongInt): Word;
       
   656 var x, y, i: LongInt;
       
   657 begin
       
   658 y:= hwRound(Gear^.Y);
       
   659 if Dir < 0 then
       
   660     y:= y - Gear^.Radius
       
   661 else
       
   662     y:= y + Gear^.Radius;
       
   663 
       
   664 if (y and LAND_HEIGHT_MASK) = 0 then
       
   665     begin
       
   666     x:= hwRound(Gear^.X) - Gear^.Radius + 1;
       
   667     i:= x + Gear^.Radius * 2 - 2;
       
   668     repeat
       
   669         if (x and LAND_WIDTH_MASK) = 0 then
       
   670             if ((Land[y, x] and Gear^.CollisionMask) and lfLandMask) <> 0 then
       
   671                 exit(Land[y, x] and Gear^.CollisionMask);
       
   672     inc(x)
       
   673     until (x > i);
       
   674     end;
       
   675 TestCollisionY:= 0
       
   676 end;
       
   677 
       
   678 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): Word; inline;
       
   679 begin
       
   680     TestCollisionYwithXYShift:= TestCollisionYwithXYShift(Gear, ShiftX, ShiftY, Dir, true);
       
   681 end;
       
   682 
       
   683 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word;
       
   684 begin
       
   685 Gear^.X:= Gear^.X + int2hwFloat(ShiftX);
       
   686 Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);
       
   687 
       
   688 if withGear then
       
   689   TestCollisionYwithXYShift:= TestCollisionYwithGear(Gear, Dir)
       
   690 else
       
   691   TestCollisionYwithXYShift:= TestCollisionY(Gear, Dir);
       
   692 
       
   693 Gear^.X:= Gear^.X - int2hwFloat(ShiftX);
       
   694 Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
       
   695 end;
   705 end;
   696 
   706 
   697 function TestRectangleForObstacle(x1, y1, x2, y2: LongInt; landOnly: boolean): boolean;
   707 function TestRectangleForObstacle(x1, y1, x2, y2: LongInt; landOnly: boolean): boolean;
   698 var x, y: LongInt;
   708 var x, y: LongInt;
   699     TestWord: LongWord;
   709     TestWord: LongWord;