hedgewars/uCollisions.pas
author nemo
Tue, 04 May 2010 02:34:23 +0000
changeset 3415 1ca22b3493e9
parent 3414 b2f3bb44777e
child 3473 f80431269806
permissions -rw-r--r--
TEMPORARY
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
3236
4ab3917d7d44 Update (c) lines to 2010 as unc0rr requested - they all had varying values so I just took the first year mentioned, then tacked on -2010
nemo
parents: 3038
diff changeset
     3
 * Copyright (c) 2005-2010 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
2630
079ef82eac75 revamped file access and debug display
koda
parents: 2599
diff changeset
    19
{$INCLUDE "options.inc"}
079ef82eac75 revamped file access and debug display
koda
parents: 2599
diff changeset
    20
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    21
unit uCollisions;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    22
interface
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    23
uses uGears, uFloat;
2630
079ef82eac75 revamped file access and debug display
koda
parents: 2599
diff changeset
    24
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    25
const cMaxGearArrayInd = 255;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    26
70
82d93eeecebe - Many AI improvements
unc0rr
parents: 68
diff changeset
    27
type PGearArray = ^TGearArray;
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    28
    TGearArray = record
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    29
            ar: array[0..cMaxGearArrayInd] of PGear;
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    30
            Count: Longword
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    31
            end;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    32
3038
4e48c276a468 In pascal unit is a namespace
unc0rr
parents: 2948
diff changeset
    33
procedure initModule;
4e48c276a468 In pascal unit is a namespace
unc0rr
parents: 2948
diff changeset
    34
procedure freeModule;
2716
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2630
diff changeset
    35
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    36
procedure AddGearCI(Gear: PGear);
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    37
procedure DeleteCI(Gear: PGear);
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
    38
2716
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2630
diff changeset
    39
function  CheckGearsCollision(Gear: PGear): PGearArray;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
    40
2716
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2630
diff changeset
    41
function  TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2630
diff changeset
    42
function  TestCollisionYwithGear(Gear: PGear; Dir: LongInt): boolean;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
    43
2716
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2630
diff changeset
    44
function  TestCollisionXKick(Gear: PGear; Dir: LongInt): boolean;
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2630
diff changeset
    45
function  TestCollisionYKick(Gear: PGear; Dir: LongInt): boolean;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
    46
2716
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2630
diff changeset
    47
function  TestCollisionY(Gear: PGear; Dir: LongInt): boolean;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
    48
2716
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2630
diff changeset
    49
function  TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean;
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2630
diff changeset
    50
function  TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): boolean;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    51
3414
b2f3bb44777e some portal changes, warning: no loop prevention yet, note: entry angle not preserved yet
sheepluva
parents: 3411
diff changeset
    52
function  calcSlopeTangent(Gear: PGear; collisionX, collisionY: LongInt; var outDeltaX, outDeltaY: LongInt; TestWord: LongWord): Boolean;
3401
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
    53
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    54
implementation
3407
dcc129c4352e Engine:
smxx
parents: 3401
diff changeset
    55
uses uMisc, uConsts, uLand, uLandGraphics;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    56
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    57
type TCollisionEntry = record
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    58
            X, Y, Radius: LongInt;
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    59
            cGear: PGear;
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    60
            end;
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
    61
906
1cc10dde304c Double increase collision array size
unc0rr
parents: 883
diff changeset
    62
const MAXRECTSINDEX = 511;
2716
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2630
diff changeset
    63
var Count: Longword;
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2630
diff changeset
    64
    cinfos: array[0..MAXRECTSINDEX] of TCollisionEntry;
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2630
diff changeset
    65
    ga: TGearArray;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    66
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    67
procedure AddGearCI(Gear: PGear);
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    68
begin
511
2b5b9e00419d - Further work on new collisions implementation
unc0rr
parents: 505
diff changeset
    69
if Gear^.CollisionIndex >= 0 then exit;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    70
TryDo(Count <= MAXRECTSINDEX, 'Collision rects array overflow', true);
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    71
with cinfos[Count] do
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    72
    begin
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    73
    X:= hwRound(Gear^.X);
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    74
    Y:= hwRound(Gear^.Y);
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    75
    Radius:= Gear^.Radius;
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    76
    ChangeRoundInLand(X, Y, Radius - 1, true);
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    77
    cGear:= Gear
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    78
    end;
511
2b5b9e00419d - Further work on new collisions implementation
unc0rr
parents: 505
diff changeset
    79
Gear^.CollisionIndex:= Count;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    80
inc(Count)
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    81
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    82
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    83
procedure DeleteCI(Gear: PGear);
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    84
begin
511
2b5b9e00419d - Further work on new collisions implementation
unc0rr
parents: 505
diff changeset
    85
if Gear^.CollisionIndex >= 0 then
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    86
    begin
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    87
    with cinfos[Gear^.CollisionIndex] do
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    88
        ChangeRoundInLand(X, Y, Radius - 1, false);
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    89
    cinfos[Gear^.CollisionIndex]:= cinfos[Pred(Count)];
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    90
    cinfos[Gear^.CollisionIndex].cGear^.CollisionIndex:= Gear^.CollisionIndex;
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    91
    Gear^.CollisionIndex:= -1;
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    92
    dec(Count)
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    93
    end;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    94
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    95
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    96
function CheckGearsCollision(Gear: PGear): PGearArray;
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
    97
var mx, my: LongInt;
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
    98
    i: Longword;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    99
begin
1506
a4ab75470ce1 - Some reformatting
unc0rr
parents: 1066
diff changeset
   100
CheckGearsCollision:= @ga;
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
   101
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
   102
if Count = 0 then exit;
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   103
mx:= hwRound(Gear^.X);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   104
my:= hwRound(Gear^.Y);
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   105
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   106
for i:= 0 to Pred(Count) do
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
   107
    with cinfos[i] do
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
   108
        if (Gear <> cGear) and
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
   109
            (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius)) then
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
   110
                begin
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
   111
                ga.ar[ga.Count]:= cinfos[i].cGear;
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
   112
                inc(ga.Count)
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
   113
                end
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   114
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   115
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   116
function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   117
var x, y, i: LongInt;
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
   118
    TestWord: LongWord;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   119
begin
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   120
if Gear^.IntersectGear <> nil then
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   121
   with Gear^ do
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   122
        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
   123
           (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
   124
           begin
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   125
           IntersectGear:= nil;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   126
           TestWord:= 0
838
1faae19f2116 Remove tailing spaces in some places
unc0rr
parents: 542
diff changeset
   127
           end else
1966
31e449e1d9dd nemo's patch + ropes ammo scheme hack
unc0rr
parents: 1753
diff changeset
   128
           TestWord:= 255
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   129
   else TestWord:= 0;
838
1faae19f2116 Remove tailing spaces in some places
unc0rr
parents: 542
diff changeset
   130
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   131
x:= hwRound(Gear^.X);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   132
if Dir < 0 then x:= x - Gear^.Radius
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   133
           else x:= x + Gear^.Radius;
1753
2ccba26f1aa4 Apply nemo's world resize patch
unc0rr
parents: 1528
diff changeset
   134
if (x and LAND_WIDTH_MASK) = 0 then
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   135
   begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   136
   y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   137
   i:= y + Gear^.Radius * 2 - 2;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   138
   repeat
1753
2ccba26f1aa4 Apply nemo's world resize patch
unc0rr
parents: 1528
diff changeset
   139
     if (y and LAND_HEIGHT_MASK) = 0 then
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   140
        if Land[y, x] > TestWord then exit(true);
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   141
     inc(y)
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   142
   until (y > i);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   143
   end;
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   144
TestCollisionXwithGear:= false
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   145
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   146
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   147
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
   148
var x, y, i: LongInt;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   149
    TestWord: LongWord;
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
if Gear^.IntersectGear <> nil then
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   152
   with Gear^ do
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   153
        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
   154
           (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
   155
           begin
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   156
           IntersectGear:= nil;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   157
           TestWord:= 0
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   158
           end else
1966
31e449e1d9dd nemo's patch + ropes ammo scheme hack
unc0rr
parents: 1753
diff changeset
   159
           TestWord:= 255
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   160
   else TestWord:= 0;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   161
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   162
y:= hwRound(Gear^.Y);
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   163
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
   164
           else y:= y + Gear^.Radius;
1753
2ccba26f1aa4 Apply nemo's world resize patch
unc0rr
parents: 1528
diff changeset
   165
if (y and LAND_HEIGHT_MASK) = 0 then
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   166
   begin
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   167
   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
   168
   i:= x + Gear^.Radius * 2 - 2;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   169
   repeat
1753
2ccba26f1aa4 Apply nemo's world resize patch
unc0rr
parents: 1528
diff changeset
   170
     if (x and LAND_WIDTH_MASK) = 0 then
505
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   171
        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
   172
     inc(x)
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   173
   until (x > i);
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   174
   end;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   175
TestCollisionYwithGear:= false
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   176
end;
fcba7d7aea0d Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents: 504
diff changeset
   177
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   178
function TestCollisionXKick(Gear: PGear; Dir: LongInt): boolean;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   179
var x, y, mx, my, i: LongInt;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   180
    flag: boolean;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   181
begin
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   182
flag:= false;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   183
x:= hwRound(Gear^.X);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   184
if Dir < 0 then x:= x - Gear^.Radius
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   185
           else x:= x + Gear^.Radius;
1753
2ccba26f1aa4 Apply nemo's world resize patch
unc0rr
parents: 1528
diff changeset
   186
if (x and LAND_WIDTH_MASK) = 0 then
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   187
   begin
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   188
   y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   189
   i:= y + Gear^.Radius * 2 - 2;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   190
   repeat
1753
2ccba26f1aa4 Apply nemo's world resize patch
unc0rr
parents: 1528
diff changeset
   191
     if (y and LAND_HEIGHT_MASK) = 0 then
1966
31e449e1d9dd nemo's patch + ropes ammo scheme hack
unc0rr
parents: 1753
diff changeset
   192
           if Land[y, x] > 255 then exit(true)
536
33538aadb4e7 - Fix some stupid bugs in collisions detecting code
unc0rr
parents: 521
diff changeset
   193
           else if Land[y, x] <> 0 then flag:= true;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   194
     inc(y)
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   195
   until (y > i);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   196
   end;
538
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   197
TestCollisionXKick:= flag;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   198
536
33538aadb4e7 - Fix some stupid bugs in collisions detecting code
unc0rr
parents: 521
diff changeset
   199
if flag then
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   200
   begin
538
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   201
   if hwAbs(Gear^.dX) < cHHKick then exit;
967
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   202
   if (Gear^.State and gstHHJumping <> 0)
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   203
   and (hwAbs(Gear^.dX) < _0_4) then exit;
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   204
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   205
   mx:= hwRound(Gear^.X);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   206
   my:= hwRound(Gear^.Y);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   207
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   208
   for i:= 0 to Pred(Count) do
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   209
    with cinfos[i] do
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   210
      if (Gear <> cGear) and
855
8842c71d16bf - Fix too long delay between shotgun and deagle shots
unc0rr
parents: 839
diff changeset
   211
         (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
   212
         ((mx > x) xor (Dir > 0)) then
3411
30d0d780d605 allow kicking of barrels
sheepluva
parents: 3408
diff changeset
   213
         if (cGear^.Kind in [gtHedgehog, gtMine, gtExplosives]) and ((Gear^.State and gstNotKickable) = 0) then
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   214
             begin
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   215
             with cGear^ do
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   216
                  begin
536
33538aadb4e7 - Fix some stupid bugs in collisions detecting code
unc0rr
parents: 521
diff changeset
   217
                  dX:= Gear^.dX;
542
ec26095f1bed - Get rid of ammoProp_AttackInFall and gstFalling
unc0rr
parents: 538
diff changeset
   218
                  dY:= Gear^.dY * _0_5;
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   219
                  State:= State or gstMoving;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   220
                  Active:= true
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   221
                  end;
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   222
             DeleteCI(cGear);
538
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   223
             exit(false)
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   224
             end
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   225
   end
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   226
end;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   227
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   228
function TestCollisionYKick(Gear: PGear; Dir: LongInt): boolean;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   229
var x, y, mx, my, i: LongInt;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   230
    flag: boolean;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   231
begin
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   232
flag:= false;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   233
y:= hwRound(Gear^.Y);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   234
if Dir < 0 then y:= y - Gear^.Radius
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   235
           else y:= y + Gear^.Radius;
1753
2ccba26f1aa4 Apply nemo's world resize patch
unc0rr
parents: 1528
diff changeset
   236
if (y and LAND_HEIGHT_MASK) = 0 then
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   237
   begin
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   238
   x:= hwRound(Gear^.X) - Gear^.Radius + 1;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   239
   i:= x + Gear^.Radius * 2 - 2;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   240
   repeat
1753
2ccba26f1aa4 Apply nemo's world resize patch
unc0rr
parents: 1528
diff changeset
   241
     if (x and LAND_WIDTH_MASK) = 0 then
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   242
        if Land[y, x] > 0 then
1966
31e449e1d9dd nemo's patch + ropes ammo scheme hack
unc0rr
parents: 1753
diff changeset
   243
           if Land[y, x] > 255 then exit(true)
536
33538aadb4e7 - Fix some stupid bugs in collisions detecting code
unc0rr
parents: 521
diff changeset
   244
           else if Land[y, x] <> 0 then flag:= true;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   245
     inc(x)
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   246
   until (x > i);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   247
   end;
538
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   248
TestCollisionYKick:= flag;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   249
536
33538aadb4e7 - Fix some stupid bugs in collisions detecting code
unc0rr
parents: 521
diff changeset
   250
if flag then
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   251
   begin
839
1493f697d1bb Fix broken logic for the new parachute feature
unc0rr
parents: 838
diff changeset
   252
   if hwAbs(Gear^.dY) < cHHKick then exit(true);
967
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   253
   if (Gear^.State and gstHHJumping <> 0)
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   254
   and (not Gear^.dY.isNegative)
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   255
   and (Gear^.dY < _0_4) then exit;
8be3938d73c2 Don't let jumping hedgehog to move others
unc0rr
parents: 906
diff changeset
   256
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   257
   mx:= hwRound(Gear^.X);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   258
   my:= hwRound(Gear^.Y);
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   259
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   260
   for i:= 0 to Pred(Count) do
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   261
    with cinfos[i] do
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   262
      if (Gear <> cGear) and
855
8842c71d16bf - Fix too long delay between shotgun and deagle shots
unc0rr
parents: 839
diff changeset
   263
         (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
   264
         ((my > y) xor (Dir > 0)) then
3411
30d0d780d605 allow kicking of barrels
sheepluva
parents: 3408
diff changeset
   265
         if (cGear^.Kind in [gtHedgehog, gtMine, gtExplosives]) and ((Gear^.State and gstNotKickable) = 0) then
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   266
             begin
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   267
             with cGear^ do
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   268
                  begin
542
ec26095f1bed - Get rid of ammoProp_AttackInFall and gstFalling
unc0rr
parents: 538
diff changeset
   269
                  dX:= Gear^.dX * _0_5;
ec26095f1bed - Get rid of ammoProp_AttackInFall and gstFalling
unc0rr
parents: 538
diff changeset
   270
                  dY:= Gear^.dY;
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   271
                  State:= State or gstMoving;
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   272
                  Active:= true
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   273
                  end;
521
bc8fd78d7598 - Fix some collision bugs
unc0rr
parents: 517
diff changeset
   274
             DeleteCI(cGear);
538
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   275
             exit(false)
74219eadab5e - Various small fixes
unc0rr
parents: 536
diff changeset
   276
             end
513
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   277
   end
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   278
end;
69e06d710d46 Moving hedgehog could get another hedgehog moving forward
unc0rr
parents: 511
diff changeset
   279
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   280
function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   281
begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   282
Gear^.X:= Gear^.X + ShiftX;
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   283
Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   284
TestCollisionXwithXYShift:= TestCollisionXwithGear(Gear, Dir);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   285
Gear^.X:= Gear^.X - ShiftX;
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   286
Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   287
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   288
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   289
function TestCollisionY(Gear: PGear; Dir: LongInt): boolean;
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   290
var x, y, i: LongInt;
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   291
begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   292
y:= hwRound(Gear^.Y);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   293
if Dir < 0 then y:= y - Gear^.Radius
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   294
           else y:= y + Gear^.Radius;
1753
2ccba26f1aa4 Apply nemo's world resize patch
unc0rr
parents: 1528
diff changeset
   295
if (y and LAND_HEIGHT_MASK) = 0 then
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   296
   begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   297
   x:= hwRound(Gear^.X) - Gear^.Radius + 1;
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   298
   i:= x + Gear^.Radius * 2 - 2;
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   299
   repeat
1753
2ccba26f1aa4 Apply nemo's world resize patch
unc0rr
parents: 1528
diff changeset
   300
     if (x and LAND_WIDTH_MASK) = 0 then
1966
31e449e1d9dd nemo's patch + ropes ammo scheme hack
unc0rr
parents: 1753
diff changeset
   301
        if Land[y, x] > 255 then exit(true);
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   302
     inc(x)
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   303
   until (x > i);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   304
   end;
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   305
TestCollisionY:= false
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   306
end;
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   307
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
   308
function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): boolean;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   309
begin
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   310
Gear^.X:= Gear^.X + int2hwFloat(ShiftX);
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   311
Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 183
diff changeset
   312
TestCollisionYwithXYShift:= TestCollisionYwithGear(Gear, Dir);
498
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   313
Gear^.X:= Gear^.X - int2hwFloat(ShiftX);
9c8b385dc9a1 - Get rid of operator := to have GPC support
unc0rr
parents: 393
diff changeset
   314
Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   315
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   316
3401
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   317
3414
b2f3bb44777e some portal changes, warning: no loop prevention yet, note: entry angle not preserved yet
sheepluva
parents: 3411
diff changeset
   318
function calcSlopeTangent(Gear: PGear; collisionX, collisionY: LongInt; var outDeltaX, outDeltaY: LongInt; TestWord: LongWord): boolean;
3408
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   319
var ldx, ldy, rdx, rdy: LongInt;
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   320
    i, j, mx, my, li, ri, jfr, jto, tmpo : ShortInt;
3401
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   321
    tmpx, tmpy: LongWord;
3408
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   322
    dx, dy: hwFloat;
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   323
    offset: Array[0..7,0..1] of ShortInt;
3401
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   324
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   325
begin
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   326
    dx:= Gear^.dX;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   327
    dy:= Gear^.dY;
3408
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   328
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   329
    // we start searching from the direction the gear center is at
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   330
    mx:= hwRound(Gear^.X-dx) - hwRound(Gear^.X);
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   331
    my:= hwRound(Gear^.Y-dy) - hwRound(Gear^.Y);
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   332
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   333
    li:= -1;
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   334
    ri:= -1;
3401
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   335
    
3408
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   336
    // go around collision pixel, checking for first/last collisions
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   337
    // this will determinate what angles will be tried to crawl along
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   338
    for i:= 0 to 7 do
3401
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   339
        begin
3408
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   340
        offset[i,0]:= mx;
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   341
        offset[i,1]:= my;
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   342
        
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   343
        tmpx:= collisionX + mx;
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   344
        tmpy:= collisionY + my;
3401
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   345
3408
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   346
        if (((tmpy) and LAND_HEIGHT_MASK) = 0) and (((tmpx) and LAND_WIDTH_MASK)  = 0) then
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   347
            if (Land[tmpy,tmpx] > TestWord) then
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   348
                begin
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   349
                // remember the index belonging to the first and last collision (if in 1st half)
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   350
                if (i <> 0) then
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   351
                    begin
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   352
                    if (ri = -1) then
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   353
                        ri:= i
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   354
                    else
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   355
                        li:= i;
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   356
                    end;
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   357
                end;
3401
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   358
3408
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   359
        if i = 7 then break;
3401
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   360
3408
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   361
        // prepare offset for next check (clockwise)
3401
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   362
        if (mx = -1) and (my <> -1) then my:= my - 1
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   363
        else if (my = -1) and (mx <> 1) then mx:= mx + 1
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   364
        else if (mx = 1) and (my <> 1) then my:= my + 1
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   365
        else mx:= mx - 1;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   366
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   367
        end;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   368
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   369
    ldx:= collisionX;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   370
    ldy:= collisionY;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   371
    rdx:= collisionX;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   372
    rdy:= collisionY;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   373
3408
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   374
    // edge-crawl
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   375
    for i:= 0 to 8 do
3401
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   376
        begin
3408
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   377
        // using mx,my as temporary value buffer here
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   378
        
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   379
        jfr:= 8+li+1;
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   380
        jto:= 8+li-1;
3401
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   381
3408
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   382
        for j:= jfr downto jto do
3401
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   383
            begin
3408
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   384
            tmpo:= j mod 8;
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   385
            tmpx:= ldx + offset[tmpo,0];
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   386
            tmpy:= ldy + offset[tmpo,1];
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   387
            if (((tmpy) and LAND_HEIGHT_MASK) = 0) and (((tmpx) and LAND_WIDTH_MASK)  = 0)
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   388
                and (Land[tmpy,tmpx] > TestWord) then
3401
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   389
                    begin
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   390
                    ldx:= tmpx;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   391
                    ldy:= tmpy;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   392
                    break;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   393
                    end;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   394
            end;
3408
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   395
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   396
        jfr:= 8+ri-1;
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   397
        jto:= 8+ri+1;
3401
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   398
3408
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   399
        for j:= jfr to jto do
3401
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   400
            begin
3408
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   401
            tmpo:= j mod 8;
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   402
            tmpx:= rdx + offset[tmpo,0];
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   403
            tmpy:= rdy + offset[tmpo,1];
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   404
            if (((tmpy) and LAND_HEIGHT_MASK) = 0) and (((tmpx) and LAND_WIDTH_MASK)  = 0)
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   405
                and (Land[tmpy,tmpx] > TestWord) then
3401
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   406
                    begin
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   407
                    rdx:= tmpx;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   408
                    rdy:= tmpy;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   409
                    break;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   410
                    end;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   411
            end;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   412
        end;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   413
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   414
    ldx:= rdx - ldx;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   415
    ldy:= rdy - ldy;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   416
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   417
    if ((ldx = 0) and (ldy = 0)) then EXIT(false);
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   418
3414
b2f3bb44777e some portal changes, warning: no loop prevention yet, note: entry angle not preserved yet
sheepluva
parents: 3411
diff changeset
   419
outDeltaX:= ldx;
b2f3bb44777e some portal changes, warning: no loop prevention yet, note: entry angle not preserved yet
sheepluva
parents: 3411
diff changeset
   420
outDeltaY:= ldy;
3408
56e636b83cb4 tweak land angle detection/portal a bit
sheepluva
parents: 3407
diff changeset
   421
exit(true);
3401
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   422
end;
d5d31d16eccc add a part of my landslide vector collision and use if for the portal gun DirAngle, not flawless yet
sheepluva
parents: 3236
diff changeset
   423
3038
4e48c276a468 In pascal unit is a namespace
unc0rr
parents: 2948
diff changeset
   424
procedure initModule;
2716
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2630
diff changeset
   425
begin
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
   426
    Count:= 0;
2716
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2630
diff changeset
   427
end;
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2630
diff changeset
   428
3038
4e48c276a468 In pascal unit is a namespace
unc0rr
parents: 2948
diff changeset
   429
procedure freeModule;
2716
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2630
diff changeset
   430
begin
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2630
diff changeset
   431
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2630
diff changeset
   432
end;
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2630
diff changeset
   433
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   434
end.