hedgewars/uCollisions.pas
author unc0rr
Fri, 18 Apr 2008 18:06:17 +0000
changeset 849 82ac0596aa3c
parent 839 1493f697d1bb
child 855 8842c71d16bf
permissions -rw-r--r--
Start work on standalone server in Haskell
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
     1
(*
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
     2
 * Hedgewars, a worms-like game
393
db01cc79f278 Update copyright information
unc0rr
parents: 371
diff changeset
     3
 * Copyright (c) 2005-2007 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
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    55
const MAXRECTSINDEX = 255;
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;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   197
   mx:= hwRound(Gear^.X);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   198
   my:= hwRound(Gear^.Y);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   199
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   200
   for i:= 0 to Pred(Count) do
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   201
    with cinfos[i] do
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   202
      if (Gear <> cGear) and
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   203
         (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius)) and
517
ba560c17c24c - Don't kick cases by moving hedgehog
unc0rr
parents: 514
diff changeset
   204
         ((mx > x) xor (Dir > 0)) then
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   205
         if (cGear^.Kind in [gtHedgehog, gtMine]) then
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   206
             begin
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   207
             with cGear^ do
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   208
                  begin
536
33538aadb4e7 - Fix some stupid bugs in collisions detecting code
unc0rr
parents: 521
diff changeset
   209
                  dX:= Gear^.dX;
542
ec26095f1bed - Get rid of ammoProp_AttackInFall and gstFalling
unc0rr
parents: 538
diff changeset
   210
                  dY:= Gear^.dY * _0_5;
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   211
                  State:= State or gstMoving;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   212
                  Active:= true
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   213
                  end;
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   214
             DeleteCI(cGear);
538
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   215
             exit(false)
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   216
             end
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   217
   end
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   218
end;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   219
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   220
function TestCollisionYKick(Gear: PGear; Dir: LongInt): boolean;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   221
var x, y, mx, my, i: LongInt;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   222
    flag: boolean;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   223
begin
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   224
flag:= false;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   225
y:= hwRound(Gear^.Y);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   226
if Dir < 0 then y:= y - Gear^.Radius
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   227
           else y:= y + Gear^.Radius;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   228
if (y and $FFFFFC00) = 0 then
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   229
   begin
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   230
   x:= hwRound(Gear^.X) - Gear^.Radius + 1;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   231
   i:= x + Gear^.Radius * 2 - 2;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   232
   repeat
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   233
     if (x and $FFFFF800) = 0 then
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   234
        if Land[y, x] > 0 then
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   235
           if Land[y, x] = COLOR_LAND then exit(true)
536
33538aadb4e7 - Fix some stupid bugs in collisions detecting code
unc0rr
parents: 521
diff changeset
   236
           else if Land[y, x] <> 0 then flag:= true;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   237
     inc(x)
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   238
   until (x > i);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   239
   end;
538
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   240
TestCollisionYKick:= flag;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   241
536
33538aadb4e7 - Fix some stupid bugs in collisions detecting code
unc0rr
parents: 521
diff changeset
   242
if flag then
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   243
   begin
839
1493f697d1bb Fix broken logic for the new parachute feature
unc0rr
parents: 838
diff changeset
   244
   if hwAbs(Gear^.dY) < cHHKick then exit(true);
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   245
   mx:= hwRound(Gear^.X);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   246
   my:= hwRound(Gear^.Y);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   247
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   248
   for i:= 0 to Pred(Count) do
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   249
    with cinfos[i] do
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   250
      if (Gear <> cGear) and
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   251
         (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius)) and
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   252
         ((my > y) xor (Dir > 0)) then
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   253
         if (cGear^.Kind in [gtHedgehog, gtMine]) then
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   254
             begin
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   255
             with cGear^ do
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   256
                  begin
542
ec26095f1bed - Get rid of ammoProp_AttackInFall and gstFalling
unc0rr
parents: 538
diff changeset
   257
                  dX:= Gear^.dX * _0_5;
ec26095f1bed - Get rid of ammoProp_AttackInFall and gstFalling
unc0rr
parents: 538
diff changeset
   258
                  dY:= Gear^.dY;
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   259
                  State:= State or gstMoving;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   260
                  Active:= true
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   261
                  end;
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   262
             DeleteCI(cGear);
538
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   263
             exit(false)
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   264
             end
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   265
   end
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   266
end;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   267
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   268
function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   269
begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   270
Gear^.X:= Gear^.X + ShiftX;
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   271
Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   272
TestCollisionXwithXYShift:= TestCollisionXwithGear(Gear, Dir);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   273
Gear^.X:= Gear^.X - ShiftX;
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   274
Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   275
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   276
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   277
function TestCollisionY(Gear: PGear; Dir: LongInt): boolean;
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   278
var x, y, i: LongInt;
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   279
begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   280
y:= hwRound(Gear^.Y);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   281
if Dir < 0 then y:= y - Gear^.Radius
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   282
           else y:= y + Gear^.Radius;
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   283
if (y and $FFFFFC00) = 0 then
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   284
   begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   285
   x:= hwRound(Gear^.X) - Gear^.Radius + 1;
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   286
   i:= x + Gear^.Radius * 2 - 2;
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   287
   repeat
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   288
     if (x and $FFFFF800) = 0 then
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   289
        if Land[y, x] = COLOR_LAND then exit(true);
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   290
     inc(x)
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   291
   until (x > i);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   292
   end;
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   293
TestCollisionY:= false
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   294
end;
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   295
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   296
function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): boolean;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   297
begin
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   298
Gear^.X:= Gear^.X + int2hwFloat(ShiftX);
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   299
Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   300
TestCollisionYwithXYShift:= TestCollisionYwithGear(Gear, Dir);
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   301
Gear^.X:= Gear^.X - int2hwFloat(ShiftX);
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   302
Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   303
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   304
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   305
end.