hedgewars/uCollisions.pas
author unc0rr
Wed, 01 Nov 2006 15:19:12 +0000
changeset 226 be2e08b0109f
parent 183 57c2ef19f719
child 351 29bc9c36ad5f
permissions -rw-r--r--
fix finding of delphi compiler
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
64
9df467527ae5 - Start AI rewrite
unc0rr
parents: 62
diff changeset
     3
 * Copyright (c) 2005, 2006 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
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    21
uses uGears;
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;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    34
function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    35
function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean;
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
    36
function TestCollisionY(Gear: PGear; Dir: integer): boolean;
107
b08ce0293a51 - Many type fixes
unc0rr
parents: 74
diff changeset
    37
function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: Double; Dir: integer): boolean;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    38
function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean;
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
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    44
                       X, Y, Radius: integer;
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;
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
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
54
839fd258ae6f - Fixed game loading
unc0rr
parents: 53
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
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    59
     X:= round(Gear.X);
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    60
     Y:= round(Gear.Y);
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    61
     Radius:= Gear.Radius;
62
c3eda0c68cd6 No more hedgehogs hung in air
unc0rr
parents: 57
diff changeset
    62
     FillRoundInLand(X, Y, Radius-1, $FF);
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;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    65
Gear.CollIndex:= Count;
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
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    71
if Gear.CollIndex < Count then
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    72
   begin
62
c3eda0c68cd6 No more hedgehogs hung in air
unc0rr
parents: 57
diff changeset
    73
   with cinfos[Gear.CollIndex] do FillRoundInLand(X, Y, Radius-1, 0);
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    74
   cinfos[Gear.CollIndex]:= cinfos[Pred(Count)];
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    75
   cinfos[Gear.CollIndex].cGear.CollIndex:= Gear.CollIndex;
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    76
   Gear.CollIndex:= High(Longword);
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    77
   dec(Count)
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    78
   end;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    79
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    80
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    81
function CheckGearsCollision(Gear: PGear): PGearArray;
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    82
var mx, my: integer;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    83
    i: Longword;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    84
begin
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    85
Result:= @ga;
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    86
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
    87
if Count = 0 then exit;
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    88
mx:= round(Gear.X);
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    89
my:= round(Gear.Y);
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    90
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    91
for i:= 0 to Pred(Count) do
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    92
   with cinfos[i] do
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    93
      if (Gear <> cGear) and
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    94
         (sqrt(sqr(mx - x) + sqr(my - y)) <= Radius + Gear.Radius) then
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    95
             begin
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    96
             ga.ar[ga.Count]:= cinfos[i].cGear;
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
    97
             inc(ga.Count)
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    98
             end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    99
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   100
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   101
function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   102
var x, y, i: integer;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   103
begin
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   104
Result:= false;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   105
x:= round(Gear.X);
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   106
if Dir < 0 then x:= x - Gear.Radius
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   107
           else x:= x + Gear.Radius;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   108
if (x and $FFFFF800) = 0 then
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   109
   begin
64
9df467527ae5 - Start AI rewrite
unc0rr
parents: 62
diff changeset
   110
   y:= round(Gear.Y) - Gear.Radius + 1;
9df467527ae5 - Start AI rewrite
unc0rr
parents: 62
diff changeset
   111
   i:= y + Gear.Radius * 2 - 2;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   112
   repeat
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   113
     if (y and $FFFFFC00) = 0 then Result:= Land[y, x]<>0;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   114
     inc(y)
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   115
   until (y > i) or Result;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   116
   end
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   117
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   118
107
b08ce0293a51 - Many type fixes
unc0rr
parents: 74
diff changeset
   119
function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: Double; Dir: integer): boolean;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   120
begin
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   121
Gear.X:= Gear.X + ShiftX;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   122
Gear.Y:= Gear.Y + ShiftY;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   123
Result:= TestCollisionXwithGear(Gear, Dir);
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   124
Gear.X:= Gear.X - ShiftX;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   125
Gear.Y:= Gear.Y - ShiftY
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   126
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   127
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   128
function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   129
var x, y, i: integer;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   130
begin
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   131
Result:= false;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   132
y:= round(Gear.Y);
53
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
   133
if Dir < 0 then y:= y - Gear.Radius
0e27949850e3 - Fixed bubble theme object
unc0rr
parents: 38
diff changeset
   134
           else y:= y + Gear.Radius;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   135
if (y and $FFFFFC00) = 0 then
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   136
   begin
64
9df467527ae5 - Start AI rewrite
unc0rr
parents: 62
diff changeset
   137
   x:= round(Gear.X) - Gear.Radius + 1;
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   138
   i:= x + Gear.Radius * 2 - 2;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   139
   repeat
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   140
     if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   141
     inc(x)
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   142
   until (x > i) or Result;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   143
   end
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   144
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   145
68
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   146
function TestCollisionY(Gear: PGear; Dir: integer): boolean;
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   147
var x, y, i: integer;
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   148
begin
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   149
Result:= false;
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   150
y:= round(Gear.Y);
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   151
if Dir < 0 then y:= y - Gear.Radius
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   152
           else y:= y + Gear.Radius;
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   153
if (y and $FFFFFC00) = 0 then
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   154
   begin
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   155
   x:= round(Gear.X) - Gear.Radius + 1;
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   156
   i:= x + Gear.Radius * 2 - 2;
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   157
   repeat
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   158
     if (x and $FFFFF800) = 0 then Result:= Land[y, x] = COLOR_LAND;
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   159
     inc(x)
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   160
   until (x > i) or Result;
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   161
   end
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   162
end;
cbb93eb90304 Collision-related stuff
unc0rr
parents: 64
diff changeset
   163
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   164
function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   165
begin
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   166
Gear.X:= Gear.X + ShiftX;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   167
Gear.Y:= Gear.Y + ShiftY;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   168
Result:= TestCollisionYwithGear(Gear, Dir);
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   169
Gear.X:= Gear.X - ShiftX;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   170
Gear.Y:= Gear.Y - ShiftY
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   171
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   172
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   173
end.