hedgewars/uCollisions.pas
author unc0rr
Thu, 04 Dec 2008 21:59:25 +0000
changeset 1528 3fee15104c1d
parent 1506 a4ab75470ce1
child 1753 2ccba26f1aa4
permissions -rw-r--r--
More stable blowtorch: - Isn't affected by flying around hedgehogs - Doesn't turn off when hedgehog falls a bit
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;
1506
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    26
	TGearArray = record
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    27
			ar: array[0..cMaxGearArrayInd] of PGear;
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    28
			Count: Longword
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
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
1506
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    51
			X, Y, Radius: LongInt;
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    52
			cGear: PGear;
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
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;
1506
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    57
	cinfos: array[0..MAXRECTSINDEX] of TCollisionEntry;
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
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
1506
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    65
	begin
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    66
	X:= hwRound(Gear^.X);
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    67
	Y:= hwRound(Gear^.Y);
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    68
	Radius:= Gear^.Radius;
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    69
	ChangeRoundInLand(X, Y, Radius - 1, true);
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    70
	cGear:= Gear
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
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
1506
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    79
	begin
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    80
	with cinfos[Gear^.CollisionIndex] do
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    81
		ChangeRoundInLand(X, Y, Radius - 1, false);
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    82
	cinfos[Gear^.CollisionIndex]:= cinfos[Pred(Count)];
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    83
	cinfos[Gear^.CollisionIndex].cGear^.CollisionIndex:= Gear^.CollisionIndex;
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    84
	Gear^.CollisionIndex:= -1;
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    85
	dec(Count)
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
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;
1506
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    91
	i: Longword;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    92
begin
1506
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
    93
CheckGearsCollision:= @ga;
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    94
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
    95
if Count = 0 then exit;
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    96
mx:= hwRound(Gear^.X);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    97
my:= hwRound(Gear^.Y);
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    98
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    99
for i:= 0 to Pred(Count) do
1506
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
   100
	with cinfos[i] do
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
   101
		if (Gear <> cGear) and
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
   102
			(sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius)) then
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
   103
				begin
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
   104
				ga.ar[ga.Count]:= cinfos[i].cGear;
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
   105
				inc(ga.Count)
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
   106
				end
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   107
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   108
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   109
function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   110
var x, y, i: LongInt;
1506
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
   111
	TestWord: LongWord;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   112
begin
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   113
if Gear^.IntersectGear <> nil then
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   114
   with Gear^ do
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   115
        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
   116
           (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
   117
           begin
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   118
           IntersectGear:= nil;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   119
           TestWord:= 0
838
1faae19f2116 Remove tailing spaces in some places
unc0rr
parents: 542
diff changeset
   120
           end else
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   121
           TestWord:= COLOR_LAND - 1
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   122
   else TestWord:= 0;
838
1faae19f2116 Remove tailing spaces in some places
unc0rr
parents: 542
diff changeset
   123
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   124
x:= hwRound(Gear^.X);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   125
if Dir < 0 then x:= x - Gear^.Radius
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   126
           else x:= x + Gear^.Radius;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   127
if (x and $FFFFF800) = 0 then
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   128
   begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   129
   y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   130
   i:= y + Gear^.Radius * 2 - 2;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   131
   repeat
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   132
     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
   133
        if Land[y, x] > TestWord then exit(true);
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   134
     inc(y)
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   135
   until (y > i);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   136
   end;
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   137
TestCollisionXwithGear:= false
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   138
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   139
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   140
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
   141
var x, y, i: LongInt;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   142
    TestWord: LongWord;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   143
begin
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   144
if Gear^.IntersectGear <> nil then
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   145
   with Gear^ do
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   146
        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
   147
           (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
   148
           begin
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   149
           IntersectGear:= nil;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   150
           TestWord:= 0
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   151
           end else
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   152
           TestWord:= COLOR_LAND - 1
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   153
   else TestWord:= 0;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   154
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   155
y:= hwRound(Gear^.Y);
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   156
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
   157
           else y:= y + Gear^.Radius;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   158
if (y and $FFFFFC00) = 0 then
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   159
   begin
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   160
   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
   161
   i:= x + Gear^.Radius * 2 - 2;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   162
   repeat
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   163
     if (x and $FFFFF800) = 0 then
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   164
        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
   165
     inc(x)
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   166
   until (x > i);
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   167
   end;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   168
TestCollisionYwithGear:= false
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
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   171
function TestCollisionXKick(Gear: PGear; Dir: LongInt): boolean;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   172
var x, y, mx, my, i: LongInt;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   173
    flag: boolean;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   174
begin
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   175
flag:= false;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   176
x:= hwRound(Gear^.X);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   177
if Dir < 0 then x:= x - Gear^.Radius
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   178
           else x:= x + Gear^.Radius;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   179
if (x and $FFFFF800) = 0 then
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   180
   begin
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   181
   y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   182
   i:= y + Gear^.Radius * 2 - 2;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   183
   repeat
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   184
     if (y and $FFFFFC00) = 0 then
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   185
           if Land[y, x] = COLOR_LAND then exit(true)
536
33538aadb4e7 - Fix some stupid bugs in collisions detecting code
unc0rr
parents: 521
diff changeset
   186
           else if Land[y, x] <> 0 then flag:= true;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   187
     inc(y)
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   188
   until (y > i);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   189
   end;
538
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   190
TestCollisionXKick:= flag;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   191
536
33538aadb4e7 - Fix some stupid bugs in collisions detecting code
unc0rr
parents: 521
diff changeset
   192
if flag then
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   193
   begin
538
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   194
   if hwAbs(Gear^.dX) < cHHKick then exit;
967
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   195
   if (Gear^.State and gstHHJumping <> 0)
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   196
   and (hwAbs(Gear^.dX) < _0_4) then exit;
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   197
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   198
   mx:= hwRound(Gear^.X);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   199
   my:= hwRound(Gear^.Y);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   200
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   201
   for i:= 0 to Pred(Count) do
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   202
    with cinfos[i] do
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   203
      if (Gear <> cGear) and
855
8842c71d16bf - Fix too long delay between shotgun and deagle shots
unc0rr
parents: 839
diff changeset
   204
         (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
   205
         ((mx > x) xor (Dir > 0)) then
1528
3fee15104c1d More stable blowtorch:
unc0rr
parents: 1506
diff changeset
   206
         if (cGear^.Kind in [gtHedgehog, gtMine]) and ((Gear^.State and gstNotKickable) = 0) then
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   207
             begin
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   208
             with cGear^ do
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   209
                  begin
536
33538aadb4e7 - Fix some stupid bugs in collisions detecting code
unc0rr
parents: 521
diff changeset
   210
                  dX:= Gear^.dX;
542
ec26095f1bed - Get rid of ammoProp_AttackInFall and gstFalling
unc0rr
parents: 538
diff changeset
   211
                  dY:= Gear^.dY * _0_5;
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   212
                  State:= State or gstMoving;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   213
                  Active:= true
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   214
                  end;
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   215
             DeleteCI(cGear);
538
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   216
             exit(false)
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   217
             end
513
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
end;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   220
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   221
function TestCollisionYKick(Gear: PGear; Dir: LongInt): boolean;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   222
var x, y, mx, my, i: LongInt;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   223
    flag: boolean;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   224
begin
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   225
flag:= false;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   226
y:= hwRound(Gear^.Y);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   227
if Dir < 0 then y:= y - Gear^.Radius
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   228
           else y:= y + Gear^.Radius;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   229
if (y and $FFFFFC00) = 0 then
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   230
   begin
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   231
   x:= hwRound(Gear^.X) - Gear^.Radius + 1;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   232
   i:= x + Gear^.Radius * 2 - 2;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   233
   repeat
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   234
     if (x and $FFFFF800) = 0 then
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   235
        if Land[y, x] > 0 then
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   236
           if Land[y, x] = COLOR_LAND then exit(true)
536
33538aadb4e7 - Fix some stupid bugs in collisions detecting code
unc0rr
parents: 521
diff changeset
   237
           else if Land[y, x] <> 0 then flag:= true;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   238
     inc(x)
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   239
   until (x > i);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   240
   end;
538
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   241
TestCollisionYKick:= flag;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   242
536
33538aadb4e7 - Fix some stupid bugs in collisions detecting code
unc0rr
parents: 521
diff changeset
   243
if flag then
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   244
   begin
839
1493f697d1bb Fix broken logic for the new parachute feature
unc0rr
parents: 838
diff changeset
   245
   if hwAbs(Gear^.dY) < cHHKick then exit(true);
967
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   246
   if (Gear^.State and gstHHJumping <> 0)
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   247
   and (not Gear^.dY.isNegative)
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   248
   and (Gear^.dY < _0_4) then exit;
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   249
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   250
   mx:= hwRound(Gear^.X);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   251
   my:= hwRound(Gear^.Y);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   252
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   253
   for i:= 0 to Pred(Count) do
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   254
    with cinfos[i] do
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   255
      if (Gear <> cGear) and
855
8842c71d16bf - Fix too long delay between shotgun and deagle shots
unc0rr
parents: 839
diff changeset
   256
         (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
   257
         ((my > y) xor (Dir > 0)) then
1528
3fee15104c1d More stable blowtorch:
unc0rr
parents: 1506
diff changeset
   258
         if (cGear^.Kind in [gtHedgehog, gtMine]) and ((Gear^.State and gstNotKickable) = 0) then
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   259
             begin
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   260
             with cGear^ do
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   261
                  begin
542
ec26095f1bed - Get rid of ammoProp_AttackInFall and gstFalling
unc0rr
parents: 538
diff changeset
   262
                  dX:= Gear^.dX * _0_5;
ec26095f1bed - Get rid of ammoProp_AttackInFall and gstFalling
unc0rr
parents: 538
diff changeset
   263
                  dY:= Gear^.dY;
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   264
                  State:= State or gstMoving;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   265
                  Active:= true
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   266
                  end;
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   267
             DeleteCI(cGear);
538
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   268
             exit(false)
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   269
             end
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   270
   end
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   271
end;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   272
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   273
function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   274
begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   275
Gear^.X:= Gear^.X + ShiftX;
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   276
Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   277
TestCollisionXwithXYShift:= TestCollisionXwithGear(Gear, Dir);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   278
Gear^.X:= Gear^.X - ShiftX;
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   279
Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   280
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   281
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   282
function TestCollisionY(Gear: PGear; Dir: LongInt): boolean;
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   283
var x, y, i: LongInt;
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   284
begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   285
y:= hwRound(Gear^.Y);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   286
if Dir < 0 then y:= y - Gear^.Radius
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   287
           else y:= y + Gear^.Radius;
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   288
if (y and $FFFFFC00) = 0 then
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   289
   begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   290
   x:= hwRound(Gear^.X) - Gear^.Radius + 1;
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   291
   i:= x + Gear^.Radius * 2 - 2;
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   292
   repeat
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   293
     if (x and $FFFFF800) = 0 then
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   294
        if Land[y, x] = COLOR_LAND then exit(true);
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   295
     inc(x)
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   296
   until (x > i);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   297
   end;
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   298
TestCollisionY:= false
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   299
end;
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   300
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   301
function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): boolean;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   302
begin
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   303
Gear^.X:= Gear^.X + int2hwFloat(ShiftX);
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   304
Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   305
TestCollisionYwithXYShift:= TestCollisionYwithGear(Gear, Dir);
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   306
Gear^.X:= Gear^.X - int2hwFloat(ShiftX);
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   307
Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   308
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   309
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   310
end.