author | unc0rr |
Thu, 19 Jan 2006 21:12:20 +0000 | |
changeset 53 | 0e27949850e3 |
parent 38 | c1ec4b15d70e |
child 54 | 839fd258ae6f |
permissions | -rw-r--r-- |
4 | 1 |
(* |
2 |
* Hedgewars, a worms-like game |
|
3 |
* Copyright (c) 2005 Andrey Korotaev <unC0Rr@gmail.com> |
|
4 |
* |
|
5 |
* Distributed under the terms of the BSD-modified licence: |
|
6 |
* |
|
7 |
* Permission is hereby granted, free of charge, to any person obtaining a copy |
|
8 |
* of this software and associated documentation files (the "Software"), to deal |
|
9 |
* with the Software without restriction, including without limitation the |
|
10 |
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or |
|
11 |
* sell copies of the Software, and to permit persons to whom the Software is |
|
12 |
* furnished to do so, subject to the following conditions: |
|
13 |
* |
|
14 |
* 1. Redistributions of source code must retain the above copyright notice, |
|
15 |
* this list of conditions and the following disclaimer. |
|
16 |
* 2. Redistributions in binary form must reproduce the above copyright notice, |
|
17 |
* this list of conditions and the following disclaimer in the documentation |
|
18 |
* and/or other materials provided with the distribution. |
|
19 |
* 3. The name of the author may not be used to endorse or promote products |
|
20 |
* derived from this software without specific prior written permission. |
|
21 |
* |
|
22 |
* THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED |
|
23 |
* WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF |
|
24 |
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO |
|
25 |
* EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, |
|
26 |
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, |
|
27 |
* PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; |
|
28 |
* OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, |
|
29 |
* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR |
|
30 |
* OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF |
|
31 |
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
|
32 |
*) |
|
33 |
||
34 |
unit uCollisions; |
|
35 |
interface |
|
36 |
uses uGears; |
|
37 |
{$INCLUDE options.inc} |
|
53 | 38 |
const cMaxGearArrayInd = 255; |
4 | 39 |
|
53 | 40 |
type TDirection = record |
41 |
dX, dY: integer |
|
42 |
end; |
|
43 |
PGearArray = ^TGearArray; |
|
44 |
TGearArray = record |
|
45 |
ar: array[0..cMaxGearArrayInd] of PGear; |
|
46 |
Count: Longword |
|
47 |
end; |
|
4 | 48 |
|
53 | 49 |
procedure FillRoundInLand(X, Y, Radius: integer; Value: Longword); |
50 |
procedure AddGearCI(Gear: PGear); |
|
51 |
procedure DeleteCI(Gear: PGear); |
|
52 |
function CheckGearsCollision(Gear: PGear): PGearArray; |
|
4 | 53 |
function HHTestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; |
54 |
function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean; |
|
55 |
function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; |
|
56 |
function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean; |
|
57 |
function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean; |
|
58 |
||
59 |
implementation |
|
60 |
uses uMisc, uConsts, uLand; |
|
61 |
||
53 | 62 |
type TCollisionEntry = record |
63 |
X, Y, Radius: integer; |
|
64 |
cGear: PGear; |
|
65 |
end; |
|
66 |
||
4 | 67 |
const MAXRECTSINDEX = 255; |
68 |
var Count: Longword = 0; |
|
53 | 69 |
cinfos: array[0..MAXRECTSINDEX] of TCollisionEntry; |
70 |
ga: TGearArray; |
|
4 | 71 |
|
53 | 72 |
procedure FillRoundInLand(X, Y, Radius: integer; Value: Longword); |
73 |
var ty, tx: integer; |
|
4 | 74 |
begin |
53 | 75 |
for ty:= max(-Radius, -y) to min(radius, 1023 - y) do |
76 |
for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047,round(x+radius*sqrt(1-sqr(ty/radius)))) do |
|
77 |
Land[ty + y, tx]:= Value; |
|
78 |
end; |
|
79 |
||
80 |
procedure AddGearCI(Gear: PGear); |
|
81 |
begin |
|
82 |
if Gear.CollIndex < High(Longword) then exit; |
|
4 | 83 |
TryDo(Count <= MAXRECTSINDEX, 'Collision rects array overflow', true); |
53 | 84 |
with cinfos[Count] do |
4 | 85 |
begin |
86 |
X:= round(Gear.X); |
|
87 |
Y:= round(Gear.Y); |
|
53 | 88 |
Radius:= Gear.Radius; |
89 |
FillRoundInLand(X, Y, Radius, $FF); |
|
4 | 90 |
cGear:= Gear |
91 |
end; |
|
92 |
Gear.CollIndex:= Count; |
|
93 |
inc(Count) |
|
94 |
end; |
|
95 |
||
53 | 96 |
procedure DeleteCI(Gear: PGear); |
4 | 97 |
begin |
53 | 98 |
if Gear.CollIndex < Count then |
99 |
begin |
|
100 |
with cinfos[Gear.CollIndex] do FillRoundInLand(X, Y, Radius, 0); |
|
101 |
cinfos[Gear.CollIndex]:= cinfos[Pred(Count)]; |
|
102 |
cinfos[Gear.CollIndex].cGear.CollIndex:= Gear.CollIndex; |
|
103 |
Gear.CollIndex:= High(Longword); |
|
104 |
dec(Count) |
|
105 |
end; |
|
4 | 106 |
end; |
107 |
||
53 | 108 |
function CheckGearsCollision(Gear: PGear): PGearArray; |
109 |
var mx, my: integer; |
|
4 | 110 |
i: Longword; |
111 |
begin |
|
53 | 112 |
Result:= @ga; |
113 |
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
|
114 |
if Count = 0 then exit; |
53 | 115 |
mx:= round(Gear.X); |
116 |
my:= round(Gear.Y); |
|
4 | 117 |
|
118 |
for i:= 0 to Pred(Count) do |
|
53 | 119 |
with cinfos[i] do |
120 |
if (Gear <> cGear) and |
|
121 |
(sqrt(sqr(mx - x) + sqr(my - y)) <= Radius + Gear.Radius) then |
|
4 | 122 |
begin |
53 | 123 |
ga.ar[ga.Count]:= cinfos[i].cGear; |
124 |
inc(ga.Count) |
|
4 | 125 |
end; |
126 |
end; |
|
127 |
||
128 |
function HHTestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; |
|
129 |
var x, y, i: integer; |
|
130 |
begin |
|
131 |
Result:= false; |
|
132 |
y:= round(Gear.Y); |
|
53 | 133 |
if Dir < 0 then y:= y - Gear.Radius |
134 |
else y:= y + Gear.Radius; |
|
4 | 135 |
|
136 |
if ((y - Dir) and $FFFFFC00) = 0 then |
|
137 |
begin |
|
138 |
x:= round(Gear.X); |
|
53 | 139 |
if (((x - Gear.Radius) and $FFFFF800) = 0)and(Land[y - Dir, x - Gear.Radius] <> 0) |
140 |
or(((x + Gear.Radius) and $FFFFF800) = 0)and(Land[y - Dir, x + Gear.Radius] <> 0) then |
|
4 | 141 |
begin |
142 |
Result:= true; |
|
143 |
exit |
|
144 |
end |
|
145 |
end; |
|
146 |
||
147 |
if (y and $FFFFFC00) = 0 then |
|
148 |
begin |
|
53 | 149 |
x:= round(Gear.X) - Gear.Radius + 1; |
150 |
i:= x + Gear.Radius * 2 - 2; |
|
4 | 151 |
repeat |
152 |
if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0; |
|
153 |
inc(x) |
|
53 | 154 |
until (x > i) or Result |
4 | 155 |
end |
156 |
end; |
|
157 |
||
158 |
function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean; |
|
159 |
var x, y, i: integer; |
|
160 |
begin |
|
161 |
Result:= false; |
|
162 |
x:= round(Gear.X); |
|
53 | 163 |
if Dir < 0 then x:= x - Gear.Radius |
164 |
else x:= x + Gear.Radius; |
|
4 | 165 |
if (x and $FFFFF800) = 0 then |
166 |
begin |
|
53 | 167 |
y:= round(Gear.Y) - Gear.Radius + 1; {*} |
168 |
i:= y + Gear.Radius * 2 - 2; {*} |
|
4 | 169 |
repeat |
170 |
if (y and $FFFFFC00) = 0 then Result:= Land[y, x]<>0; |
|
171 |
inc(y) |
|
172 |
until (y > i) or Result; |
|
173 |
end |
|
174 |
end; |
|
175 |
||
176 |
function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean; |
|
177 |
begin |
|
178 |
Gear.X:= Gear.X + ShiftX; |
|
179 |
Gear.Y:= Gear.Y + ShiftY; |
|
180 |
Result:= TestCollisionXwithGear(Gear, Dir); |
|
181 |
Gear.X:= Gear.X - ShiftX; |
|
182 |
Gear.Y:= Gear.Y - ShiftY |
|
183 |
end; |
|
184 |
||
185 |
function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; |
|
186 |
var x, y, i: integer; |
|
187 |
begin |
|
188 |
Result:= false; |
|
189 |
y:= round(Gear.Y); |
|
53 | 190 |
if Dir < 0 then y:= y - Gear.Radius |
191 |
else y:= y + Gear.Radius; |
|
4 | 192 |
if (y and $FFFFFC00) = 0 then |
193 |
begin |
|
53 | 194 |
x:= round(Gear.X) - Gear.Radius + 1; {*} |
195 |
i:= x + Gear.Radius * 2 - 2; {*} |
|
4 | 196 |
repeat |
197 |
if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0; |
|
198 |
inc(x) |
|
199 |
until (x > i) or Result; |
|
200 |
end |
|
201 |
end; |
|
202 |
||
203 |
function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean; |
|
204 |
begin |
|
205 |
Gear.X:= Gear.X + ShiftX; |
|
206 |
Gear.Y:= Gear.Y + ShiftY; |
|
207 |
Result:= TestCollisionYwithGear(Gear, Dir); |
|
208 |
Gear.X:= Gear.X - ShiftX; |
|
209 |
Gear.Y:= Gear.Y - ShiftY |
|
210 |
end; |
|
211 |
||
212 |
end. |