hedgewars/uCollisions.pas
author unc0rr
Sun, 26 Oct 2008 14:49:47 +0000
changeset 1419 8650a8f55006
parent 1066 1f1b3686a2b0
child 1506 a4ab75470ce1
permissions -rw-r--r--
Set custom palette to scrollbars
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
     1
(*
1066
1f1b3686a2b0 Update copyright headers a bit
unc0rr
parents: 967
diff changeset
     2
 * Hedgewars, a free turn based strategy game
883
07a568ba44e0 Update copyright info in source files headers
unc0rr
parents: 855
diff changeset
     3
 * Copyright (c) 2005-2008 Andrey Korotaev <unC0Rr@gmail.com>
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
     4
 *
183
57c2ef19f719 Relicense to GPL
unc0rr
parents: 107
diff changeset
     5
 * This program is free software; you can redistribute it and/or modify
57c2ef19f719 Relicense to GPL
unc0rr
parents: 107
diff changeset
     6
 * it under the terms of the GNU General Public License as published by
57c2ef19f719 Relicense to GPL
unc0rr
parents: 107
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
     8
 *
183
57c2ef19f719 Relicense to GPL
unc0rr
parents: 107
diff changeset
     9
 * This program is distributed in the hope that it will be useful,
57c2ef19f719 Relicense to GPL
unc0rr
parents: 107
diff changeset
    10
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
57c2ef19f719 Relicense to GPL
unc0rr
parents: 107
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
57c2ef19f719 Relicense to GPL
unc0rr
parents: 107
diff changeset
    12
 * GNU General Public License for more details.
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    13
 *
183
57c2ef19f719 Relicense to GPL
unc0rr
parents: 107
diff changeset
    14
 * You should have received a copy of the GNU General Public License
57c2ef19f719 Relicense to GPL
unc0rr
parents: 107
diff changeset
    15
 * along with this program; if not, write to the Free Software
57c2ef19f719 Relicense to GPL
unc0rr
parents: 107
diff changeset
    16
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    17
 *)
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    18
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    19
unit uCollisions;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    20
interface
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    21
uses uGears, uFloat;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    22
{$INCLUDE options.inc}
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    23
const cMaxGearArrayInd = 255;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    24
70
82d93eeecebe - Many AI improvements
unc0rr
parents: 68
diff changeset
    25
type PGearArray = ^TGearArray;
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    26
     TGearArray = record
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    27
                  ar: array[0..cMaxGearArrayInd] of PGear;
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    28
                  Count: Longword
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    29
                  end;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    30
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    31
procedure AddGearCI(Gear: PGear);
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    32
procedure DeleteCI(Gear: PGear);
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
    33
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    34
function CheckGearsCollision(Gear: PGear): PGearArray;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
    35
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
    36
function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
    37
function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): boolean;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
    38
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
    39
function TestCollisionXKick(Gear: PGear; Dir: LongInt): boolean;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
    40
function TestCollisionYKick(Gear: PGear; Dir: LongInt): boolean;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
    41
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
    42
function TestCollisionY(Gear: PGear; Dir: LongInt): boolean;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
    43
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
    44
function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean;
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
    45
function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): boolean;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    46
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    47
implementation
511
2b5b9e00419d - Further work on new collisions implementation
unc0rr
parents: 505
diff changeset
    48
uses uMisc, uConsts, uLand, uLandGraphics, uConsole;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    49
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    50
type TCollisionEntry = record
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
    51
                       X, Y, Radius: LongInt;
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    52
                       cGear: PGear;
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    53
                       end;
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    54
906
1cc10dde304c Double increase collision array size
unc0rr
parents: 883
diff changeset
    55
const MAXRECTSINDEX = 511;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    56
var Count: Longword = 0;
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    57
    cinfos: array[0..MAXRECTSINDEX] of TCollisionEntry;
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    58
    ga: TGearArray;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    59
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    60
procedure AddGearCI(Gear: PGear);
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    61
begin
511
2b5b9e00419d - Further work on new collisions implementation
unc0rr
parents: 505
diff changeset
    62
if Gear^.CollisionIndex >= 0 then exit;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    63
TryDo(Count <= MAXRECTSINDEX, 'Collision rects array overflow', true);
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    64
with cinfos[Count] do
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    65
     begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    66
     X:= hwRound(Gear^.X);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    67
     Y:= hwRound(Gear^.Y);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    68
     Radius:= Gear^.Radius;
511
2b5b9e00419d - Further work on new collisions implementation
unc0rr
parents: 505
diff changeset
    69
     ChangeRoundInLand(X, Y, Radius - 1, true);
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    70
     cGear:= Gear
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    71
     end;
511
2b5b9e00419d - Further work on new collisions implementation
unc0rr
parents: 505
diff changeset
    72
Gear^.CollisionIndex:= Count;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    73
inc(Count)
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    74
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    75
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    76
procedure DeleteCI(Gear: PGear);
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    77
begin
511
2b5b9e00419d - Further work on new collisions implementation
unc0rr
parents: 505
diff changeset
    78
if Gear^.CollisionIndex >= 0 then
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    79
   begin
511
2b5b9e00419d - Further work on new collisions implementation
unc0rr
parents: 505
diff changeset
    80
   with cinfos[Gear^.CollisionIndex] do
2b5b9e00419d - Further work on new collisions implementation
unc0rr
parents: 505
diff changeset
    81
        ChangeRoundInLand(X, Y, Radius - 1, false);
2b5b9e00419d - Further work on new collisions implementation
unc0rr
parents: 505
diff changeset
    82
   cinfos[Gear^.CollisionIndex]:= cinfos[Pred(Count)];
2b5b9e00419d - Further work on new collisions implementation
unc0rr
parents: 505
diff changeset
    83
   cinfos[Gear^.CollisionIndex].cGear^.CollisionIndex:= Gear^.CollisionIndex;
2b5b9e00419d - Further work on new collisions implementation
unc0rr
parents: 505
diff changeset
    84
   Gear^.CollisionIndex:= -1;
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    85
   dec(Count)
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    86
   end;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    87
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    88
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    89
function CheckGearsCollision(Gear: PGear): PGearArray;
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
    90
var mx, my: LongInt;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    91
    i: Longword;
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    92
    Result: PGearArray;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    93
begin
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    94
Result:= @ga;
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    95
ga.Count:= 0;
12
366adfa1a727 Fix reading out of bounds of the collisions array. This fixes flying hedgehogs and not moving after explosion
unc0rr
parents: 4
diff changeset
    96
if Count = 0 then exit;
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    97
mx:= hwRound(Gear^.X);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    98
my:= hwRound(Gear^.Y);
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    99
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   100
for i:= 0 to Pred(Count) do
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
   101
   with cinfos[i] do
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
   102
      if (Gear <> cGear) and
511
2b5b9e00419d - Further work on new collisions implementation
unc0rr
parents: 505
diff changeset
   103
         (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius)) then
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   104
             begin
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
   105
             ga.ar[ga.Count]:= cinfos[i].cGear;
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
   106
             inc(ga.Count)
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   107
             end;
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   108
CheckGearsCollision:= Result
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   109
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   110
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   111
function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   112
var x, y, i: LongInt;
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   113
    TestWord: LongWord;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   114
begin
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   115
if Gear^.IntersectGear <> nil then
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   116
   with Gear^ do
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   117
        if (hwRound(IntersectGear^.X) + IntersectGear^.Radius < hwRound(X) - Radius) or
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   118
           (hwRound(IntersectGear^.X) - IntersectGear^.Radius > hwRound(X) + Radius) then
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   119
           begin
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   120
           IntersectGear:= nil;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   121
           TestWord:= 0
838
1faae19f2116 Remove tailing spaces in some places
unc0rr
parents: 542
diff changeset
   122
           end else
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   123
           TestWord:= COLOR_LAND - 1
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   124
   else TestWord:= 0;
838
1faae19f2116 Remove tailing spaces in some places
unc0rr
parents: 542
diff changeset
   125
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   126
x:= hwRound(Gear^.X);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   127
if Dir < 0 then x:= x - Gear^.Radius
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   128
           else x:= x + Gear^.Radius;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   129
if (x and $FFFFF800) = 0 then
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   130
   begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   131
   y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   132
   i:= y + Gear^.Radius * 2 - 2;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   133
   repeat
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   134
     if (y and $FFFFFC00) = 0 then
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   135
        if Land[y, x] > TestWord then exit(true);
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   136
     inc(y)
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   137
   until (y > i);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   138
   end;
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   139
TestCollisionXwithGear:= false
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   140
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   141
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   142
function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): boolean;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   143
var x, y, i: LongInt;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   144
    TestWord: LongWord;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   145
begin
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   146
if Gear^.IntersectGear <> nil then
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   147
   with Gear^ do
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   148
        if (hwRound(IntersectGear^.Y) + IntersectGear^.Radius < hwRound(Y) - Radius) or
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   149
           (hwRound(IntersectGear^.Y) - IntersectGear^.Radius > hwRound(Y) + Radius) then
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   150
           begin
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   151
           IntersectGear:= nil;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   152
           TestWord:= 0
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   153
           end else
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   154
           TestWord:= COLOR_LAND - 1
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   155
   else TestWord:= 0;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   156
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   157
y:= hwRound(Gear^.Y);
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   158
if Dir < 0 then y:= y - Gear^.Radius
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   159
           else y:= y + Gear^.Radius;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   160
if (y and $FFFFFC00) = 0 then
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   161
   begin
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   162
   x:= hwRound(Gear^.X) - Gear^.Radius + 1;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   163
   i:= x + Gear^.Radius * 2 - 2;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   164
   repeat
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   165
     if (x and $FFFFF800) = 0 then
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   166
        if Land[y, x] > TestWord then exit(true);
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   167
     inc(x)
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   168
   until (x > i);
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   169
   end;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   170
TestCollisionYwithGear:= false
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   171
end;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   172
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   173
function TestCollisionXKick(Gear: PGear; Dir: LongInt): boolean;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   174
var x, y, mx, my, i: LongInt;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   175
    flag: boolean;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   176
begin
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   177
flag:= false;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   178
x:= hwRound(Gear^.X);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   179
if Dir < 0 then x:= x - Gear^.Radius
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   180
           else x:= x + Gear^.Radius;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   181
if (x and $FFFFF800) = 0 then
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   182
   begin
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   183
   y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   184
   i:= y + Gear^.Radius * 2 - 2;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   185
   repeat
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   186
     if (y and $FFFFFC00) = 0 then
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   187
           if Land[y, x] = COLOR_LAND then exit(true)
536
33538aadb4e7 - Fix some stupid bugs in collisions detecting code
unc0rr
parents: 521
diff changeset
   188
           else if Land[y, x] <> 0 then flag:= true;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   189
     inc(y)
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   190
   until (y > i);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   191
   end;
538
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   192
TestCollisionXKick:= flag;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   193
536
33538aadb4e7 - Fix some stupid bugs in collisions detecting code
unc0rr
parents: 521
diff changeset
   194
if flag then
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   195
   begin
538
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   196
   if hwAbs(Gear^.dX) < cHHKick then exit;
967
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   197
   if (Gear^.State and gstHHJumping <> 0)
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   198
   and (hwAbs(Gear^.dX) < _0_4) then exit;
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   199
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   200
   mx:= hwRound(Gear^.X);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   201
   my:= hwRound(Gear^.Y);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   202
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   203
   for i:= 0 to Pred(Count) do
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   204
    with cinfos[i] do
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   205
      if (Gear <> cGear) and
855
8842c71d16bf - Fix too long delay between shotgun and deagle shots
unc0rr
parents: 839
diff changeset
   206
         (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius + 2)) and
517
ba560c17c24c - Don't kick cases by moving hedgehog
unc0rr
parents: 514
diff changeset
   207
         ((mx > x) xor (Dir > 0)) then
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   208
         if (cGear^.Kind in [gtHedgehog, gtMine]) then
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   209
             begin
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   210
             with cGear^ do
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   211
                  begin
536
33538aadb4e7 - Fix some stupid bugs in collisions detecting code
unc0rr
parents: 521
diff changeset
   212
                  dX:= Gear^.dX;
542
ec26095f1bed - Get rid of ammoProp_AttackInFall and gstFalling
unc0rr
parents: 538
diff changeset
   213
                  dY:= Gear^.dY * _0_5;
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   214
                  State:= State or gstMoving;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   215
                  Active:= true
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   216
                  end;
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   217
             DeleteCI(cGear);
538
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   218
             exit(false)
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   219
             end
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   220
   end
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   221
end;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   222
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   223
function TestCollisionYKick(Gear: PGear; Dir: LongInt): boolean;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   224
var x, y, mx, my, i: LongInt;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   225
    flag: boolean;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   226
begin
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   227
flag:= false;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   228
y:= hwRound(Gear^.Y);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   229
if Dir < 0 then y:= y - Gear^.Radius
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   230
           else y:= y + Gear^.Radius;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   231
if (y and $FFFFFC00) = 0 then
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   232
   begin
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   233
   x:= hwRound(Gear^.X) - Gear^.Radius + 1;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   234
   i:= x + Gear^.Radius * 2 - 2;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   235
   repeat
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   236
     if (x and $FFFFF800) = 0 then
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   237
        if Land[y, x] > 0 then
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   238
           if Land[y, x] = COLOR_LAND then exit(true)
536
33538aadb4e7 - Fix some stupid bugs in collisions detecting code
unc0rr
parents: 521
diff changeset
   239
           else if Land[y, x] <> 0 then flag:= true;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   240
     inc(x)
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   241
   until (x > i);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   242
   end;
538
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   243
TestCollisionYKick:= flag;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   244
536
33538aadb4e7 - Fix some stupid bugs in collisions detecting code
unc0rr
parents: 521
diff changeset
   245
if flag then
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   246
   begin
839
1493f697d1bb Fix broken logic for the new parachute feature
unc0rr
parents: 838
diff changeset
   247
   if hwAbs(Gear^.dY) < cHHKick then exit(true);
967
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   248
   if (Gear^.State and gstHHJumping <> 0)
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   249
   and (not Gear^.dY.isNegative)
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   250
   and (Gear^.dY < _0_4) then exit;
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   251
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   252
   mx:= hwRound(Gear^.X);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   253
   my:= hwRound(Gear^.Y);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   254
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   255
   for i:= 0 to Pred(Count) do
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   256
    with cinfos[i] do
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   257
      if (Gear <> cGear) and
855
8842c71d16bf - Fix too long delay between shotgun and deagle shots
unc0rr
parents: 839
diff changeset
   258
         (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius + 2)) and
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   259
         ((my > y) xor (Dir > 0)) then
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   260
         if (cGear^.Kind in [gtHedgehog, gtMine]) then
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   261
             begin
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   262
             with cGear^ do
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   263
                  begin
542
ec26095f1bed - Get rid of ammoProp_AttackInFall and gstFalling
unc0rr
parents: 538
diff changeset
   264
                  dX:= Gear^.dX * _0_5;
ec26095f1bed - Get rid of ammoProp_AttackInFall and gstFalling
unc0rr
parents: 538
diff changeset
   265
                  dY:= Gear^.dY;
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   266
                  State:= State or gstMoving;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   267
                  Active:= true
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   268
                  end;
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   269
             DeleteCI(cGear);
538
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   270
             exit(false)
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   271
             end
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   272
   end
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   273
end;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   274
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   275
function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   276
begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   277
Gear^.X:= Gear^.X + ShiftX;
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   278
Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   279
TestCollisionXwithXYShift:= TestCollisionXwithGear(Gear, Dir);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   280
Gear^.X:= Gear^.X - ShiftX;
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   281
Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   282
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   283
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   284
function TestCollisionY(Gear: PGear; Dir: LongInt): boolean;
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   285
var x, y, i: LongInt;
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   286
begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   287
y:= hwRound(Gear^.Y);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   288
if Dir < 0 then y:= y - Gear^.Radius
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   289
           else y:= y + Gear^.Radius;
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   290
if (y and $FFFFFC00) = 0 then
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   291
   begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   292
   x:= hwRound(Gear^.X) - Gear^.Radius + 1;
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   293
   i:= x + Gear^.Radius * 2 - 2;
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   294
   repeat
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   295
     if (x and $FFFFF800) = 0 then
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   296
        if Land[y, x] = COLOR_LAND then exit(true);
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   297
     inc(x)
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   298
   until (x > i);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   299
   end;
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   300
TestCollisionY:= false
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   301
end;
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   302
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   303
function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): boolean;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   304
begin
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   305
Gear^.X:= Gear^.X + int2hwFloat(ShiftX);
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   306
Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   307
TestCollisionYwithXYShift:= TestCollisionYwithGear(Gear, Dir);
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   308
Gear^.X:= Gear^.X - int2hwFloat(ShiftX);
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   309
Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   310
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   311
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   312
end.