hedgewars/uCollisions.pas
author unc0rr
Fri, 04 May 2007 19:59:51 +0000
changeset 505 fcba7d7aea0d
parent 504 13b6ebc53627
child 511 2b5b9e00419d
permissions -rw-r--r--
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
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);
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    33
function CheckGearsCollision(Gear: PGear): PGearArray;
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
    34
function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
    35
function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): boolean;
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
    36
function TestCollisionY(Gear: PGear; Dir: LongInt): boolean;
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
    37
function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean;
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
    38
function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): boolean;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    39
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    40
implementation
57
e1a77ae57065 - Fixed compiling .)
unc0rr
parents: 54
diff changeset
    41
uses uMisc, uConsts, uLand, uLandGraphics;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    42
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    43
type TCollisionEntry = record
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
    44
                       X, Y, Radius: LongInt;
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    45
                       cGear: PGear;
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    46
                       end;
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    47
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    48
const MAXRECTSINDEX = 255;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    49
var Count: Longword = 0;
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    50
    cinfos: array[0..MAXRECTSINDEX] of TCollisionEntry;
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    51
    ga: TGearArray;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    52
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    53
procedure AddGearCI(Gear: PGear);
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    54
begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    55
if Gear^.CollIndex < High(Longword) then exit;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    56
TryDo(Count <= MAXRECTSINDEX, 'Collision rects array overflow', true);
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    57
with cinfos[Count] do
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    58
     begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    59
     X:= hwRound(Gear^.X);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    60
     Y:= hwRound(Gear^.Y);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    61
     Radius:= Gear^.Radius;
504
13b6ebc53627 Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents: 498
diff changeset
    62
     ChangeRoundInLand(X, Y, Radius - 1, +1);
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    63
     cGear:= Gear
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    64
     end;
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    65
Gear^.CollIndex:= Count;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    66
inc(Count)
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    67
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    68
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    69
procedure DeleteCI(Gear: PGear);
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    70
begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    71
if Gear^.CollIndex < Count then
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    72
   begin
504
13b6ebc53627 Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents: 498
diff changeset
    73
   with cinfos[Gear^.CollIndex] do
13b6ebc53627 Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents: 498
diff changeset
    74
        ChangeRoundInLand(X, Y, Radius - 1, -1);
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    75
   cinfos[Gear^.CollIndex]:= cinfos[Pred(Count)];
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    76
   cinfos[Gear^.CollIndex].cGear^.CollIndex:= Gear^.CollIndex;
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    77
   Gear^.CollIndex:= High(Longword);
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    78
   dec(Count)
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    79
   end;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    80
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    81
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    82
function CheckGearsCollision(Gear: PGear): PGearArray;
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
    83
var mx, my: LongInt;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    84
    i: Longword;
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    85
    Result: PGearArray;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    86
begin
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    87
Result:= @ga;
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    88
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
    89
if Count = 0 then exit;
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    90
mx:= hwRound(Gear^.X);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    91
my:= hwRound(Gear^.Y);
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    92
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    93
for i:= 0 to Pred(Count) do
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    94
   with cinfos[i] do
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    95
      if (Gear <> cGear) and
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    96
         (sqrt(sqr(mx - x) + sqr(my - y)) <= Radius + Gear^.Radius) then
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    97
             begin
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    98
             ga.ar[ga.Count]:= cinfos[i].cGear;
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    99
             inc(ga.Count)
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   100
             end;
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   101
CheckGearsCollision:= Result
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   102
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   103
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   104
function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   105
var x, y, i: LongInt;
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   106
    TestWord: LongWord;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   107
begin
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   108
if Gear^.IntersectGear <> nil then
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   109
   with Gear^ do
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   110
        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
   111
           (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
   112
           begin
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   113
           IntersectGear:= nil;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   114
           TestWord:= 0
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   115
           end else    
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   116
           TestWord:= COLOR_LAND - 1
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   117
   else TestWord:= 0;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   118
   
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   119
x:= hwRound(Gear^.X);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   120
if Dir < 0 then x:= x - Gear^.Radius
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   121
           else x:= x + Gear^.Radius;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   122
if (x and $FFFFF800) = 0 then
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   123
   begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   124
   y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   125
   i:= y + Gear^.Radius * 2 - 2;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   126
   repeat
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   127
     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
   128
        if Land[y, x] > TestWord then exit(true);
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   129
     inc(y)
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   130
   until (y > i);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   131
   end;
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   132
TestCollisionXwithGear:= false
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   133
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   134
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   135
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
   136
var x, y, i: LongInt;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   137
    TestWord: LongWord;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   138
begin
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   139
if Gear^.IntersectGear <> nil then
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   140
   with Gear^ do
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   141
        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
   142
           (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
   143
           begin
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   144
           IntersectGear:= nil;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   145
           TestWord:= 0
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   146
           end else    
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   147
           TestWord:= COLOR_LAND - 1
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   148
   else TestWord:= 0;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   149
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   150
y:= hwRound(Gear^.Y);
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   151
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
   152
           else y:= y + Gear^.Radius;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   153
if (y and $FFFFFC00) = 0 then
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   154
   begin
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   155
   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
   156
   i:= x + Gear^.Radius * 2 - 2;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   157
   repeat
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   158
     if (x and $FFFFF800) = 0 then
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   159
        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
   160
     inc(x)
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   161
   until (x > i);
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   162
   end;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   163
TestCollisionYwithGear:= false
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   164
end;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   165
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   166
function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   167
begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   168
Gear^.X:= Gear^.X + ShiftX;
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   169
Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   170
TestCollisionXwithXYShift:= TestCollisionXwithGear(Gear, Dir);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   171
Gear^.X:= Gear^.X - ShiftX;
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   172
Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   173
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   174
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   175
function TestCollisionY(Gear: PGear; Dir: LongInt): boolean;
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   176
var x, y, i: LongInt;
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   177
begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   178
y:= hwRound(Gear^.Y);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   179
if Dir < 0 then y:= y - Gear^.Radius
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   180
           else y:= y + Gear^.Radius;
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   181
if (y and $FFFFFC00) = 0 then
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   182
   begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   183
   x:= hwRound(Gear^.X) - Gear^.Radius + 1;
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   184
   i:= x + Gear^.Radius * 2 - 2;
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   185
   repeat
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   186
     if (x and $FFFFF800) = 0 then
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   187
        if Land[y, x] = COLOR_LAND then exit(true);
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   188
     inc(x)
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   189
   until (x > i);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   190
   end;
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   191
TestCollisionY:= false
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   192
end;
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   193
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   194
function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): boolean;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   195
begin
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   196
Gear^.X:= Gear^.X + int2hwFloat(ShiftX);
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   197
Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   198
TestCollisionYwithXYShift:= TestCollisionYwithGear(Gear, Dir);
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   199
Gear^.X:= Gear^.X - int2hwFloat(ShiftX);
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   200
Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   201
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   202
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   203
end.