author  alfadur 
Tue, 30 Jun 2020 00:58:24 +0300  
changeset 15655  116307c752f6 
parent 15646  c2a1a34d1841 
child 15656  c34cad72cd85 
permissions  rwrr 
4  1 
(* 
1066  2 
* Hedgewars, a free turn based strategy game 
11046  3 
* Copyright (c) 20042015 Andrey Korotaev <unC0Rr@gmail.com> 
4  4 
* 
183  5 
* This program is free software; you can redistribute it and/or modify 
6 
* it under the terms of the GNU General Public License as published by 

7 
* the Free Software Foundation; version 2 of the License 

4  8 
* 
183  9 
* This program is distributed in the hope that it will be useful, 
10 
* but WITHOUT ANY WARRANTY; without even the implied warranty of 

11 
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 

12 
* GNU General Public License for more details. 

4  13 
* 
183  14 
* You should have received a copy of the GNU General Public License 
15 
* along with this program; if not, write to the Free Software 

10108
c68cf030eded
update FSF address. note: two sdl include files (by Sam Lantinga) still have the old FSF address in their copyright  but I ain't gonna touch their copyright headers
sheepluva
parents:
10015
diff
changeset

16 
* Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 021101301 USA 
4  17 
*) 
18 

2630  19 
{$INCLUDE "options.inc"} 
20 

4  21 
unit uCollisions; 
22 
interface 

12898  23 
uses uFloat, uTypes, uUtils; 
2630  24 

5290
eea7570d345f
This can afford to be a bit larger. Does not impact performance.
nemo
parents:
4976
diff
changeset

25 
const cMaxGearArrayInd = 1023; 
12898  26 
const cMaxGearHitOrderInd = 1023; 
14006
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

27 
const cMaxGearProximityCacheInd = 1023; 
4  28 

70  29 
type PGearArray = ^TGearArray; 
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2716
diff
changeset

30 
TGearArray = record 
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

31 
ar: array[0..cMaxGearArrayInd] of PGear; 
12898  32 
cX: array[0..cMaxGearArrayInd] of LongInt; 
33 
cY: array[0..cMaxGearArrayInd] of LongInt; 

6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

34 
Count: Longword 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

35 
end; 
4  36 

12898  37 
type PGearHitOrder = ^TGearHitOrder; 
38 
TGearHitOrder = record 

39 
ar: array[0..cMaxGearHitOrderInd] of PGear; 

40 
order: array[0..cMaxGearHitOrderInd] of LongInt; 

41 
Count: Longword 

42 
end; 

43 

14006
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

44 
type PGearProximityCache = ^TGearProximityCache; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

45 
TGearProximityCache = record 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

46 
ar: array[0..cMaxGearProximityCacheInd] of PGear; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

47 
Count: Longword 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

48 
end; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

49 

12898  50 
type TLineCollision = record 
51 
hasCollision: Boolean; 

52 
cX, cY: LongInt; //for visual effects only 

53 
end; 

54 

15646  55 
type TKickTest = record 
56 
kick: Boolean; 

57 
collisionMask: Word; 

58 
end; 

59 

3038  60 
procedure initModule; 
61 
procedure freeModule; 

2716
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2630
diff
changeset

62 

9291
15f7bb217b66
Make add/delete consistent (this has bugged me for so long)
nemo
parents:
9247
diff
changeset

63 
procedure AddCI(Gear: PGear); 
53  64 
procedure DeleteCI(Gear: PGear); 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

65 

2716
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2630
diff
changeset

66 
function CheckGearsCollision(Gear: PGear): PGearArray; 
12898  67 
function CheckAllGearsCollision(SourceGear: PGear): PGearArray; 
14006
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

68 
function CheckCacheCollision(SourceGear: PGear): PGearArray; 
12898  69 

70 
function CheckGearsLineCollision(Gear: PGear; oX, oY, tX, tY: hwFloat): PGearArray; 

71 
function CheckAllGearsLineCollision(SourceGear: PGear; oX, oY, tX, tY: hwFloat): PGearArray; 

72 

15655  73 
function UpdateHitOrder(Gear: PGear; Order: LongInt): boolean; inline; 
74 
function UpdateGlobalHitOrder(Gear: PGear; Order: LongInt): boolean; inline; 

75 
procedure ClearHitOrderLeq(MinOrder: LongInt); inline; 

76 
procedure ClearGlobalHitOrderLeq(MinOrder: LongInt); inline; 

12898  77 
procedure ClearHitOrder(); 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

78 

14006
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

79 
procedure RefillProximityCache(SourceGear: PGear; radius: LongInt); 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

80 
procedure RemoveFromProximityCache(Gear: PGear); 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

81 
procedure ClearProximityCache(); 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

82 

15646  83 
function TestCollisionXImpl(centerX, centerY, radius, direction: LongInt; collisionMask: Word): Word; 
84 
function TestCollisionYImpl(centerX, centerY, radius, direction: LongInt; collisionMask: Word): Word; 

85 

86 
function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): Word; inline; 

87 
function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word; inline; 

88 

89 
function TestCollisionX(Gear: PGear; Dir: LongInt): Word; inline; 

90 
function TestCollisionY(Gear: PGear; Dir: LongInt): Word; inline; 

91 

92 
function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): Word; inline; 

93 
function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word; inline; 

94 
function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): Word; inline; 

95 
function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word; inline; 

96 

97 
function TestCollisionXKickImpl(centerX, centerY, radius, direction: LongInt; collisionMask, kickMask: Word): TKickTest; 

98 
function TestCollisionYKickImpl(centerX, centerY, radius, direction: LongInt; collisionMask, kickMask: Word): TKickTest; 

513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

99 

9706
5178d2263521
return land word from uCollisions to make decisions based on it. Should be handy for trampoline.
nemo
parents:
9305
diff
changeset

100 
function TestCollisionXKick(Gear: PGear; Dir: LongInt): Word; 
5178d2263521
return land word from uCollisions to make decisions based on it. Should be handy for trampoline.
nemo
parents:
9305
diff
changeset

101 
function TestCollisionYKick(Gear: PGear; Dir: LongInt): Word; 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

102 

10818
f642a28cab0c
Add placement of airmines in engine outside of hog proximity. Has a bug, only protecting 1st team. Also fix a spelling error and rename gstHHChooseTarget to gstChooseTarget
nemo
parents:
10635
diff
changeset

103 
function TestRectangleForObstacle(x1, y1, x2, y2: LongInt; landOnly: boolean): boolean; 
6124  104 

10354  105 
function CheckCoordInWater(X, Y: LongInt): boolean; inline; 
106 

9248  107 
// returns: negative sign if going downhill to left, value is steepness (noslope/error = _0, 45 = _0_5) 
6279  108 
function CalcSlopeBelowGear(Gear: PGear): hwFloat; 
7754  109 
function CalcSlopeNearGear(Gear: PGear; dirX, dirY: LongInt): hwFloat; 
9706
5178d2263521
return land word from uCollisions to make decisions based on it. Should be handy for trampoline.
nemo
parents:
9305
diff
changeset

110 
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

111 

15301  112 
function CheckGearsUnderSprite(Sprite: TSprite; sprX, sprY, Frame: LongInt): boolean; 
113 

4  114 
implementation 
15301  115 
uses uConsts, uLandGraphics, uVariables, SDLh, uLandTexture, uDebug; 
4  116 

53  117 
type TCollisionEntry = record 
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

118 
X, Y, Radius: LongInt; 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

119 
cGear: PGear; 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

120 
end; 
351  121 

5568  122 
const MAXRECTSINDEX = 1023; 
2716
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2630
diff
changeset

123 
var Count: Longword; 
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2630
diff
changeset

124 
cinfos: array[0..MAXRECTSINDEX] of TCollisionEntry; 
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2630
diff
changeset

125 
ga: TGearArray; 
12898  126 
ordera: TGearHitOrder; 
15655  127 
globalordera: TGearHitOrder; 
14006
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

128 
proximitya: TGearProximityCache; 
4  129 

9291
15f7bb217b66
Make add/delete consistent (this has bugged me for so long)
nemo
parents:
9247
diff
changeset

130 
procedure AddCI(Gear: PGear); 
53  131 
begin 
11532  132 
if (Gear^.CollisionIndex >= 0) or (Count > MAXRECTSINDEX) or 
10551
4eefc711309e
Skip checkin on collision for frequently spammed gear types if collision gets huge instead of trying to delete mines.
nemo
parents:
10494
diff
changeset

133 
((Count > MAXRECTSINDEX200) and ((Gear^.Kind = gtMine) or (Gear^.Kind = gtSMine) or (Gear^.Kind = gtKnife))) then 
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

134 
exit; 
11532  135 

53  136 
with cinfos[Count] do 
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2716
diff
changeset

137 
begin 
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2716
diff
changeset

138 
X:= hwRound(Gear^.X); 
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2716
diff
changeset

139 
Y:= hwRound(Gear^.Y); 
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2716
diff
changeset

140 
Radius:= Gear^.Radius; 
11589
c453620cc6d6
Break up the hog/object collision. Currently is $7F, allowing 128 overlapping objects accurately. Breaking it up into 15 for hogs, 7 for other objects. I'm thinking the overall accuracy should be just fine as far as people noticing even with a ton of overlapping hogs, and this way we can tell the difference between a hog and "something else". For experiment and ropebreaking purposes, make rope pass through hogs.
nemo
parents:
11532
diff
changeset

141 
ChangeRoundInLand(X, Y, Radius  1, true, ((CurrentHedgehog <> nil) and (Gear = CurrentHedgehog^.Gear)) or ((Gear^.Kind = gtCase) and (Gear^.State and gstFrozen = 0)), Gear^.Kind = gtHedgehog); 
3608
c509bbc779e7
Revert prior attempted optimisation. Gridding the land pays in some situations, but not all. Restricting to an upper bound might help, but overall, seems too fuzzy to be worth it. On one side is increased cost of Add/Delete + extra test on collision check, on the other is skipping the list iteration. Perhaps for large lists.
nemo
parents:
3603
diff
changeset

142 
cGear:= Gear 
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2716
diff
changeset

143 
end; 
511  144 
Gear^.CollisionIndex:= Count; 
5569
8313952b2811
suggestion of mikade's  delete old mines if the collision array shows signs of filling up. This is kind of an edge case, esp now that array is up to 1024, but should prevent (easiest) way to crash by collision array overflow (endless mines/minestrikes).
nemo
parents:
5568
diff
changeset

145 
inc(Count); 
4  146 
end; 
147 

53  148 
procedure DeleteCI(Gear: PGear); 
4  149 
begin 
511  150 
if Gear^.CollisionIndex >= 0 then 
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2716
diff
changeset

151 
begin 
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2716
diff
changeset

152 
with cinfos[Gear^.CollisionIndex] do 
11589
c453620cc6d6
Break up the hog/object collision. Currently is $7F, allowing 128 overlapping objects accurately. Breaking it up into 15 for hogs, 7 for other objects. I'm thinking the overall accuracy should be just fine as far as people noticing even with a ton of overlapping hogs, and this way we can tell the difference between a hog and "something else". For experiment and ropebreaking purposes, make rope pass through hogs.
nemo
parents:
11532
diff
changeset

153 
ChangeRoundInLand(X, Y, Radius  1, false, ((CurrentHedgehog <> nil) and (Gear = CurrentHedgehog^.Gear)) or ((Gear^.Kind = gtCase) and (Gear^.State and gstFrozen = 0)), Gear^.Kind = gtHedgehog); 
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2716
diff
changeset

154 
cinfos[Gear^.CollisionIndex]:= cinfos[Pred(Count)]; 
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2716
diff
changeset

155 
cinfos[Gear^.CollisionIndex].cGear^.CollisionIndex:= Gear^.CollisionIndex; 
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2716
diff
changeset

156 
Gear^.CollisionIndex:= 1; 
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2716
diff
changeset

157 
dec(Count) 
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2716
diff
changeset

158 
end; 
4  159 
end; 
160 

10354  161 
function CheckCoordInWater(X, Y: LongInt): boolean; inline; 
162 
begin 

163 
CheckCoordInWater:= (Y > cWaterLine) 

14282
6015b74eea55
overall, using LongInt for leftX/rightX results in fewer casts, since most comparisons are against ints.
nemo
parents:
14006
diff
changeset

164 
or ((WorldEdge = weSea) and ((X < leftX) or (X > rightX))); 
10354  165 
end; 
166 

53  167 
function CheckGearsCollision(Gear: PGear): PGearArray; 
3609
bc63ed514b70
Minor fire tweak for readability and lethalness, remove exit condition that was hanging game (identified by jaylittle)
nemo
parents:
3608
diff
changeset

168 
var mx, my, tr: LongInt; 
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2716
diff
changeset

169 
i: Longword; 
4  170 
begin 
1506  171 
CheckGearsCollision:= @ga; 
53  172 
ga.Count:= 0; 
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

173 
if Count = 0 then 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

174 
exit; 
351  175 
mx:= hwRound(Gear^.X); 
176 
my:= hwRound(Gear^.Y); 

4  177 

4705
593ef1ad3cd3
ok. restore old [r + 1 + r] for gear width for a moment, and reset snowballs.
nemo
parents:
4684
diff
changeset

178 
tr:= Gear^.Radius + 2; 
3609
bc63ed514b70
Minor fire tweak for readability and lethalness, remove exit condition that was hanging game (identified by jaylittle)
nemo
parents:
3608
diff
changeset

179 

3608
c509bbc779e7
Revert prior attempted optimisation. Gridding the land pays in some situations, but not all. Restricting to an upper bound might help, but overall, seems too fuzzy to be worth it. On one side is increased cost of Add/Delete + extra test on collision check, on the other is skipping the list iteration. Perhaps for large lists.
nemo
parents:
3603
diff
changeset

180 
for i:= 0 to Pred(Count) do 
c509bbc779e7
Revert prior attempted optimisation. Gridding the land pays in some situations, but not all. Restricting to an upper bound might help, but overall, seems too fuzzy to be worth it. On one side is increased cost of Add/Delete + extra test on collision check, on the other is skipping the list iteration. Perhaps for large lists.
nemo
parents:
3603
diff
changeset

181 
with cinfos[i] do 
c509bbc779e7
Revert prior attempted optimisation. Gridding the land pays in some situations, but not all. Restricting to an upper bound might help, but overall, seems too fuzzy to be worth it. On one side is increased cost of Add/Delete + extra test on collision check, on the other is skipping the list iteration. Perhaps for large lists.
nemo
parents:
3603
diff
changeset

182 
if (Gear <> cGear) and 
3609
bc63ed514b70
Minor fire tweak for readability and lethalness, remove exit condition that was hanging game (identified by jaylittle)
nemo
parents:
3608
diff
changeset

183 
(sqr(mx  x) + sqr(my  y) <= sqr(Radius + tr)) then 
3608
c509bbc779e7
Revert prior attempted optimisation. Gridding the land pays in some situations, but not all. Restricting to an upper bound might help, but overall, seems too fuzzy to be worth it. On one side is increased cost of Add/Delete + extra test on collision check, on the other is skipping the list iteration. Perhaps for large lists.
nemo
parents:
3603
diff
changeset

184 
begin 
c509bbc779e7
Revert prior attempted optimisation. Gridding the land pays in some situations, but not all. Restricting to an upper bound might help, but overall, seems too fuzzy to be worth it. On one side is increased cost of Add/Delete + extra test on collision check, on the other is skipping the list iteration. Perhaps for large lists.
nemo
parents:
3603
diff
changeset

185 
ga.ar[ga.Count]:= cinfos[i].cGear; 
12898  186 
ga.cX[ga.Count]:= hwround(Gear^.X); 
187 
ga.cY[ga.Count]:= hwround(Gear^.Y); 

3608
c509bbc779e7
Revert prior attempted optimisation. Gridding the land pays in some situations, but not all. Restricting to an upper bound might help, but overall, seems too fuzzy to be worth it. On one side is increased cost of Add/Delete + extra test on collision check, on the other is skipping the list iteration. Perhaps for large lists.
nemo
parents:
3603
diff
changeset

188 
inc(ga.Count) 
c509bbc779e7
Revert prior attempted optimisation. Gridding the land pays in some situations, but not all. Restricting to an upper bound might help, but overall, seems too fuzzy to be worth it. On one side is increased cost of Add/Delete + extra test on collision check, on the other is skipping the list iteration. Perhaps for large lists.
nemo
parents:
3603
diff
changeset

189 
end 
4  190 
end; 
191 

12898  192 
function CheckAllGearsCollision(SourceGear: PGear): PGearArray; 
193 
var mx, my, tr: LongInt; 

194 
Gear: PGear; 

195 
begin 

196 
CheckAllGearsCollision:= @ga; 

197 
ga.Count:= 0; 

198 

199 
mx:= hwRound(SourceGear^.X); 

200 
my:= hwRound(SourceGear^.Y); 

201 

202 
tr:= SourceGear^.Radius + 2; 

203 

204 
Gear:= GearsList; 

205 

206 
while Gear <> nil do 

207 
begin 

208 
if (Gear <> SourceGear) and 

209 
(sqr(mx  hwRound(Gear^.x)) + sqr(my  hwRound(Gear^.y)) <= sqr(Gear^.Radius + tr))then 

210 
begin 

211 
ga.ar[ga.Count]:= Gear; 

14006
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

212 
ga.cX[ga.Count]:= mx; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

213 
ga.cY[ga.Count]:= my; 
12898  214 
inc(ga.Count) 
215 
end; 

216 

217 
Gear := Gear^.NextGear 

218 
end; 

219 
end; 

220 

221 
function LineCollisionTest(oX, oY, dirX, dirY, dirNormSqr, dirNormBound: hwFloat; 

222 
width: LongInt; Gear: PGear): 

223 
TLineCollision; inline; 

224 
var toCenterX, toCenterY, r, 

225 
b, bSqr, c, desc, t: hwFloat; 

226 
realT: extended; 

227 
begin 

228 
LineCollisionTest.hasCollision:= false; 

229 
toCenterX:= (oX  Gear^.X); 

230 
toCenterY:= (oY  Gear^.Y); 

231 
r:= int2hwFloat(Gear^.Radius + width + 2); 

232 
// Early cull to avoid multiplying large numbers 

233 
if hwAbs(toCenterX) + hwAbs(toCenterY) > dirNormBound + r then 

234 
exit; 

235 
b:= dirX * toCenterX + dirY * toCenterY; 

236 
c:= hwSqr(toCenterX) + hwSqr(toCenterY)  hwSqr(r); 

237 
if (b > _0) and (c > _0) then 

238 
exit; 

239 
bSqr:= hwSqr(b); 

240 
desc:= bSqr  dirNormSqr * c; 

241 
if desc.isNegative then exit; 

242 

243 
t:= b  hwSqrt(desc); 

244 
if t.isNegative then t:= _0; 

245 
if t < dirNormSqr then 

246 
with LineCollisionTest do 

247 
begin 

248 
hasCollision:= true; 

249 
realT := hwFloat2Float(t) / hwFloat2Float(dirNormSqr); 

250 
cX:= round(hwFloat2Float(oX) + realT * hwFloat2Float(dirX)); 

251 
cY:= round(hwFloat2Float(oY) + realT * hwFloat2Float(dirY)); 

252 
end; 

253 
end; 

254 

255 
function CheckGearsLineCollision(Gear: PGear; oX, oY, tX, tY: hwFloat): PGearArray; 

256 
var dirX, dirY, dirNormSqr, dirNormBound: hwFloat; 

257 
test: TLineCollision; 

258 
i: Longword; 

259 
begin 

260 
CheckGearsLineCollision:= @ga; 

261 
ga.Count:= 0; 

262 
if Count = 0 then 

263 
exit; 

264 
dirX:= (tX  oX); 

265 
dirY:= (tY  oY); 

266 
dirNormBound:= _1_5 * (hwAbs(dirX) + hwAbs(dirY)); 

267 
dirNormSqr:= hwSqr(dirX) + hwSqr(dirY); 

268 
if dirNormSqr.isNegative then 

269 
exit; 

270 

271 
for i:= 0 to Pred(Count) do 

272 
with cinfos[i] do if Gear <> cGear then 

273 
begin 

274 
test:= LineCollisionTest( 

275 
oX, oY, dirX, dirY, dirNormSqr, dirNormBound, Gear^.Radius, cGear); 

276 
if test.hasCollision then 

277 
begin 

278 
ga.ar[ga.Count] := cGear; 

279 
ga.cX[ga.Count] := test.cX; 

280 
ga.cY[ga.Count] := test.cY; 

281 
inc(ga.Count) 

282 
end 

283 
end 

284 
end; 

285 

286 
function CheckAllGearsLineCollision(SourceGear: PGear; oX, oY, tX, tY: hwFloat): PGearArray; 

287 
var dirX, dirY, dirNormSqr, dirNormBound: hwFloat; 

288 
test: TLineCollision; 

289 
Gear: PGear; 

290 
begin 

291 
CheckAllGearsLineCollision:= @ga; 

292 
ga.Count:= 0; 

293 
dirX:= (tX  oX); 

294 
dirY:= (tY  oY); 

295 
dirNormBound:= _1_5 * (hwAbs(dirX) + hwAbs(dirY)); 

296 
dirNormSqr:= hwSqr(dirX) + hwSqr(dirY); 

297 
if dirNormSqr.isNegative then 

298 
exit; 

299 

300 
Gear:= GearsList; 

301 
while Gear <> nil do 

302 
begin 

303 
if SourceGear <> Gear then 

304 
begin 

305 
test:= LineCollisionTest( 

306 
oX, oY, dirX, dirY, dirNormSqr, dirNormBound, SourceGear^.Radius, Gear); 

307 
if test.hasCollision then 

308 
begin 

309 
ga.ar[ga.Count] := Gear; 

310 
ga.cX[ga.Count] := test.cX; 

311 
ga.cY[ga.Count] := test.cY; 

312 
inc(ga.Count) 

313 
end 

314 
end; 

315 
Gear := Gear^.NextGear 

316 
end; 

317 
end; 

318 

14006
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

319 
function CheckCacheCollision(SourceGear: PGear): PGearArray; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

320 
var mx, my, tr, i: LongInt; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

321 
Gear: PGear; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

322 
begin 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

323 
CheckCacheCollision:= @ga; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

324 
ga.Count:= 0; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

325 

105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

326 
mx:= hwRound(SourceGear^.X); 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

327 
my:= hwRound(SourceGear^.Y); 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

328 

105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

329 
tr:= SourceGear^.Radius + 2; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

330 

105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

331 
for i:= 0 to proximitya.Count  1 do 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

332 
begin 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

333 
Gear:= proximitya.ar[i]; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

334 
// Assuming the cache has been filled correctly, it will not contain SourceGear 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

335 
// and other gears won't be far enough for sqr overflow 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

336 
if (sqr(mx  hwRound(Gear^.X)) + sqr(my  hwRound(Gear^.Y)) <= sqr(Gear^.Radius + tr)) then 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

337 
begin 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

338 
ga.ar[ga.Count]:= Gear; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

339 
ga.cX[ga.Count]:= mx; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

340 
ga.cY[ga.Count]:= my; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

341 
inc(ga.Count) 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

342 
end; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

343 
end; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

344 
end; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

345 

15655  346 
function UpdateHitOrderImpl(HitOrder: PGearHitOrder; Gear: PGear; Order: LongInt): boolean; 
12898  347 
var i: LongInt; 
348 
begin 

15655  349 
UpdateHitOrderImpl:= true; 
350 
for i := 0 to HitOrder^.Count  1 do 

351 
if HitOrder^.ar[i] = Gear then 

12898  352 
begin 
15655  353 
if Order <= HitOrder^.order[i] then 
354 
UpdateHitOrderImpl := false; 

355 
HitOrder^.order[i] := Max(HitOrder^.order[i], Order); 

356 
exit; 

12898  357 
end; 
358 

15655  359 
if HitOrder^.Count > cMaxGearHitOrderInd then 
360 
UpdateHitOrderImpl := false 

361 
else 

12898  362 
begin 
15655  363 
HitOrder^.ar[HitOrder^.Count] := Gear; 
364 
HitOrder^.order[HitOrder^.Count] := Order; 

365 
Inc(HitOrder^.Count); 

12898  366 
end 
367 
end; 

368 

15655  369 
function UpdateHitOrder(Gear: PGear; Order: LongInt): boolean; inline; 
370 
begin 

371 
UpdateHitOrder := UpdateHitOrderImpl(@ordera, Gear, Order); 

372 
end; 

373 

374 
function UpdateGlobalHitOrder(Gear: PGear; Order: LongInt): boolean; inline; 

375 
begin 

376 
UpdateGlobalHitOrder := UpdateHitOrderImpl(@globalordera, Gear, Order); 

377 
end; 

378 

379 
procedure ClearHitOrderLeqImpl(HitOrder: PGearHitOrder; MinOrder: LongInt); 

12898  380 
var i, freeIndex: LongInt; 
381 
begin; 

15655  382 
freeIndex:= 0; 
383 
i:= 0; 

12898  384 

15655  385 
while i < ordera.Count do 
12898  386 
begin 
15655  387 
if HitOrder^.order[i] <= MinOrder then 
388 
Dec(HitOrder^.Count) 

12898  389 
else 
15655  390 
begin 
391 
if freeIndex < i then 

12898  392 
begin 
15655  393 
HitOrder^.ar[freeIndex]:= HitOrder^.ar[i]; 
394 
HitOrder^.order[freeIndex]:= HitOrder^.order[i]; 

395 
end; 

12898  396 
Inc(freeIndex); 
15655  397 
end; 
12898  398 
Inc(i) 
399 
end 

400 
end; 

401 

15655  402 
procedure ClearHitOrderLeq(MinOrder: LongInt); inline; 
403 
begin 

404 
ClearHitOrderLeqImpl(@ordera, MinOrder); 

405 
end; 

406 

407 
procedure ClearGlobalHitOrderLeq(MinOrder: LongInt); inline; 

408 
begin 

409 
ClearHitOrderLeqImpl(@globalordera, MinOrder); 

410 
end; 

411 

12898  412 
procedure ClearHitOrder(); 
413 
begin 

414 
ordera.Count:= 0; 

415 
end; 

416 

14006
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

417 
procedure RefillProximityCache(SourceGear: PGear; radius: LongInt); 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

418 
var cx, cy, dx, dy, r: LongInt; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

419 
Gear: PGear; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

420 
begin 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

421 
proximitya.Count:= 0; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

422 
cx:= hwRound(SourceGear^.X); 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

423 
cy:= hwRound(SourceGear^.Y); 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

424 
Gear:= GearsList; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

425 

105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

426 
while (Gear <> nil) and (proximitya.Count <= cMaxGearProximityCacheInd) do 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

427 
begin 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

428 
dx:= abs(hwRound(Gear^.X)  cx); 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

429 
dy:= abs(hwRound(Gear^.Y)  cy); 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

430 
r:= radius + Gear^.radius + 2; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

431 
if (Gear <> SourceGear) and (max(dx, dy) <= r) and (sqr(dx) + sqr(dy) <= sqr(r)) then 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

432 
begin 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

433 
proximitya.ar[proximitya.Count]:= Gear; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

434 
inc(proximitya.Count) 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

435 
end; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

436 
Gear := Gear^.NextGear 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

437 
end; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

438 
end; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

439 

105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

440 
procedure RemoveFromProximityCache(Gear: PGear); 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

441 
var i: LongInt; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

442 
begin 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

443 
i := 0; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

444 
while i < proximitya.Count do 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

445 
begin 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

446 
if proximitya.ar[i] = Gear then 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

447 
begin 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

448 
proximitya.ar[i]:= proximitya.ar[proximitya.Count  1]; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

449 
dec(proximitya.Count); 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

450 
end 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

451 
else 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

452 
inc(i); 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

453 
end; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

454 
end; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

455 

105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

456 
procedure ClearProximityCache(); 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

457 
begin 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

458 
proximitya.Count:= 0; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

459 
end; 
105793e575d6
make firepunch hit moving gears (airmines are not amused)
alfadur
parents:
13464
diff
changeset

460 

15646  461 
function TestCollisionXImpl(centerX, centerY, radius, direction: LongInt; collisionMask: Word): Word; 
462 
var x, y, minY, maxY: LongInt; 

4  463 
begin 
15646  464 
if direction < 0 then 
465 
x := centerX  radius 

466 
else 

467 
x := centerX + radius; 

838  468 

15646  469 
if (x and LAND_WIDTH_MASK) = 0 then 
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

470 
begin 
15646  471 
minY := max(centerY  radius + 1, 0); 
472 
maxY := min(centerY + radius  1, LAND_HEIGHT  1); 

473 
for y := minY to maxY do 

474 
if Land[y, x] and collisionMask <> 0 then 

475 
exit(Land[y, x] and collisionMask); 

6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

476 
end; 
15646  477 
TestCollisionXImpl := 0; 
4  478 
end; 
479 

15646  480 
function TestCollisionYImpl(centerX, centerY, radius, direction: LongInt; collisionMask: Word): Word; 
481 
var x, y, minX, maxX: LongInt; 

505
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

482 
begin 
15646  483 
if direction < 0 then 
484 
y := centerY  radius 

485 
else 

486 
y := centerY + radius; 

7268  487 

15646  488 
if (y and LAND_HEIGHT_MASK) = 0 then 
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

489 
begin 
15646  490 
minX := max(centerX  radius + 1, 0); 
491 
maxX := min(centerX + radius  1, LAND_WIDTH  1); 

492 
for x := minX to maxX do 

493 
if Land[y, x] and collisionMask <> 0 then 

494 
exit(Land[y, x] and collisionMask); 

6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

495 
end; 
15646  496 
TestCollisionYImpl := 0; 
497 
end; 

498 

499 
function TestCollisionX(Gear: PGear; Dir: LongInt): Word; inline; 

500 
begin 

501 
TestCollisionX := TestCollisionXImpl(hwRound(Gear^.X), hwRound(Gear^.Y), Gear^.Radius, Dir, Gear^.CollisionMask and lfLandMask); 

502 
end; 

503 

504 
function TestCollisionY(Gear: PGear; Dir: LongInt): Word; inline; 

505 
begin 

506 
TestCollisionY := TestCollisionYImpl(hwRound(Gear^.X), hwRound(Gear^.Y), Gear^.Radius, Dir, Gear^.CollisionMask and lfLandMask); 

505
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

507 
end; 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

508 

15646  509 
procedure LegacyFixupX(Gear: PGear); 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

510 
begin 
15646  511 
// Special case to emulate the old intersect gear clearing, but with a bit of slop for pixel overlap 
512 
if (Gear^.CollisionMask = lfNotCurHogCrate) and (Gear^.Kind <> gtHedgehog) and (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.Gear <> nil) and 

513 
((hwRound(Gear^.Hedgehog^.Gear^.X) + Gear^.Hedgehog^.Gear^.Radius + 16 < hwRound(Gear^.X)  Gear^.Radius) or 

514 
(hwRound(Gear^.Hedgehog^.Gear^.X)  Gear^.Hedgehog^.Gear^.Radius  16 > hwRound(Gear^.X) + Gear^.Radius)) then 

515 
Gear^.CollisionMask:= lfAll; 

516 
end; 

513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

517 

15646  518 
procedure LegacyFixupY(Gear: PGear); 
519 
begin 

520 
// Special case to emulate the old intersect gear clearing, but with a bit of slop for pixel overlap 

521 
if (Gear^.CollisionMask = lfNotCurHogCrate) and (Gear^.Kind <> gtHedgehog) and (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.Gear <> nil) and 

522 
((hwRound(Gear^.Hedgehog^.Gear^.Y) + Gear^.Hedgehog^.Gear^.Radius + 16 < hwRound(Gear^.Y)  Gear^.Radius) or 

523 
(hwRound(Gear^.Hedgehog^.Gear^.Y)  Gear^.Hedgehog^.Gear^.Radius  16 > hwRound(Gear^.Y) + Gear^.Radius)) then 

524 
Gear^.CollisionMask:= lfAll; 

525 
end; 

513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

526 

15646  527 
function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): Word; inline; 
528 
begin 

529 
LegacyFixupX(Gear); 

530 
TestCollisionXwithGear:= TestCollisionXImpl(hwRound(Gear^.X), hwRound(Gear^.Y), Gear^.Radius, Dir, Gear^.CollisionMask); 

513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

531 
end; 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

532 

15646  533 
function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word; inline; 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

534 
begin 
15646  535 
LegacyFixupY(Gear); 
536 
TestCollisionYwithGear:= TestCollisionYImpl(hwRound(Gear^.X), hwRound(Gear^.Y), Gear^.Radius, Dir, Gear^.CollisionMask); 

537 
end; 

6990
40e5af28d026
change every return value into a more pascalish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6986
diff
changeset

538 

15646  539 
function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word; inline; 
540 
var collisionMask: Word; 

541 
begin 

542 
if withGear then 

6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

543 
begin 
15646  544 
LegacyFixupX(Gear); 
545 
collisionMask:= Gear^.CollisionMask; 

546 
end 

547 
else 

548 
collisionMask:= Gear^.CollisionMask and lfLandMask; 

967  549 

15646  550 
TestCollisionXwithXYShift := TestCollisionXImpl(hwRound(Gear^.X + ShiftX), hwRound(Gear^.Y) + ShiftY, Gear^.Radius, Dir, collisionMask) 
551 
end; 

513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

552 

15646  553 
function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word; inline; 
554 
var collisionMask: Word; 

555 
begin 

556 
if withGear then 

557 
begin 

558 
LegacyFixupY(Gear); 

559 
collisionMask:= Gear^.CollisionMask; 

6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

560 
end 
15646  561 
else 
562 
collisionMask:= Gear^.CollisionMask and lfLandMask; 

563 

564 
TestCollisionYwithXYShift := TestCollisionYImpl(hwRound(Gear^.X) + ShiftX, hwRound(Gear^.Y) + ShiftY, Gear^.Radius, Dir, collisionMask) 

513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

565 
end; 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

566 

9706
5178d2263521
return land word from uCollisions to make decisions based on it. Should be handy for trampoline.
nemo
parents:
9305
diff
changeset

567 
function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): Word; inline; 
6986
409dd3851309
add support for default pascal mode by removing default arguments value (maybe this also helps the parser)
koda
parents:
6700
diff
changeset

568 
begin 
409dd3851309
add support for default pascal mode by removing default arguments value (maybe this also helps the parser)
koda
parents:
6700
diff
changeset

569 
TestCollisionXwithXYShift:= TestCollisionXwithXYShift(Gear, ShiftX, ShiftY, Dir, true); 
409dd3851309
add support for default pascal mode by removing default arguments value (maybe this also helps the parser)
koda
parents:
6700
diff
changeset

570 
end; 
409dd3851309
add support for default pascal mode by removing default arguments value (maybe this also helps the parser)
koda
parents:
6700
diff
changeset

571 

9706
5178d2263521
return land word from uCollisions to make decisions based on it. Should be handy for trampoline.
nemo
parents:
9305
diff
changeset

572 
function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): Word; inline; 
6986
409dd3851309
add support for default pascal mode by removing default arguments value (maybe this also helps the parser)
koda
parents:
6700
diff
changeset

573 
begin 
409dd3851309
add support for default pascal mode by removing default arguments value (maybe this also helps the parser)
koda
parents:
6700
diff
changeset

574 
TestCollisionYwithXYShift:= TestCollisionYwithXYShift(Gear, ShiftX, ShiftY, Dir, true); 
409dd3851309
add support for default pascal mode by removing default arguments value (maybe this also helps the parser)
koda
parents:
6700
diff
changeset

575 
end; 
409dd3851309
add support for default pascal mode by removing default arguments value (maybe this also helps the parser)
koda
parents:
6700
diff
changeset

576 

15646  577 
function TestCollisionXKickImpl(centerX, centerY, radius, direction: LongInt; collisionMask, kickMask: Word): TKickTest; 
578 
var x, y, minY, maxY: LongInt; 

579 
begin 

580 
TestCollisionXKickImpl.kick := false; 

581 
TestCollisionXKickImpl.collisionMask := 0; 

582 

583 
if direction < 0 then 

584 
x := centerX  radius 

585 
else 

586 
x := centerX + radius; 

587 

588 
if (x and LAND_WIDTH_MASK) = 0 then 

589 
begin 

590 
minY := max(centerY  radius + 1, 0); 

591 
maxY := min(centerY + radius  1, LAND_HEIGHT  1); 

592 
for y := minY to maxY do 

593 
if Land[y, x] and collisionMask <> 0 then 

594 
begin 

595 
TestCollisionXKickImpl.kick := false; 

596 
TestCollisionXKickImpl.collisionMask := Land[y, x] and collisionMask; 

597 
exit 

598 
end 

599 
else if Land[y, x] and kickMask <> 0 then 

600 
begin 

601 
TestCollisionXKickImpl.kick := true; 

602 
TestCollisionXKickImpl.collisionMask := Land[y, x] and kickMask; 

603 
end; 

604 
end; 

605 
end; 

606 

607 
function TestCollisionYKickImpl(centerX, centerY, radius, direction: LongInt; collisionMask, kickMask: Word): TKickTest; 

608 
var x, y, minX, maxX: LongInt; 

4  609 
begin 
15646  610 
TestCollisionYKickImpl.kick := false; 
611 
TestCollisionYKickImpl.collisionMask := 0; 

612 

613 
if direction < 0 then 

614 
y := centerY  radius 

615 
else 

616 
y := centerY + radius; 

617 

618 
if (y and LAND_HEIGHT_MASK) = 0 then 

619 
begin 

620 
minX := max(centerX  radius + 1, 0); 

621 
maxX := min(centerX + radius  1, LAND_WIDTH  1); 

622 
for x := minX to maxX do 

623 
if Land[y, x] and collisionMask <> 0 then 

624 
begin 

625 
TestCollisionYKickImpl.kick := false; 

626 
TestCollisionYKickImpl.collisionMask := Land[y, x] and collisionMask; 

627 
exit 

628 
end 

629 
else if Land[y, x] and kickMask <> 0 then 

630 
begin 

631 
TestCollisionYKickImpl.kick := true; 

632 
TestCollisionYKickImpl.collisionMask := Land[y, x] and kickMask; 

633 
end; 

634 
end; 

635 
end; 

636 

637 
function TestCollisionXKick(Gear: PGear; Dir: LongInt): Word; 

638 
var centerX, centerY, i: LongInt; 

639 
test: TKickTest; 

640 
info: TCollisionEntry; 

641 
begin 

642 
test := TestCollisionXKickImpl( 

643 
hwRound(Gear^.X), hwRound(Gear^.Y), 

644 
Gear^.Radius, Dir, 

645 
Gear^.CollisionMask and lfLandMask, Gear^.CollisionMask); 

646 

647 
TestCollisionXKick := test.collisionMask; 

6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

648 

15646  649 
if test.kick then 
650 
begin 

651 
if hwAbs(Gear^.dX) < cHHKick then 

652 
exit; 

653 
if ((Gear^.State and gstHHJumping) <> 0) and (hwAbs(Gear^.dX) < _0_4) then 

654 
exit; 

655 

656 
centerX := hwRound(Gear^.X); 

657 
centerY := hwRound(Gear^.Y); 

658 

659 
for i:= 0 to Pred(Count) do 

660 
begin 

661 
info:= cinfos[i]; 

662 
if (Gear <> info.cGear) 

663 
and ((centerX > info.X) xor (Dir > 0)) 

664 
and ((info.cGear^.State and gstNotKickable) = 0) 

665 
and ((info.cGear^.Kind in [gtHedgehog, gtMine, gtKnife]) 

666 
or (info.cGear^.Kind = gtExplosives) and ((info.cGear^.State and gsttmpflag) <> 0)) // only apply X kick if the barrel is knocked over 

667 
and (sqr(centerX  info.X) + sqr(centerY  info.Y) <= sqr(info.Radius + Gear^.Radius + 2)) then 

668 
begin 

669 
with info.cGear^ do 

670 
begin 

671 
dX := Gear^.dX; 

672 
dY := Gear^.dY * _0_5; 

673 
State := State or gstMoving; 

674 
if Kind = gtKnife then State := State and (not gstCollision); 

675 
Active:= true 

676 
end; 

677 
DeleteCI(info.cGear); 

678 
exit(0) 

679 
end 

680 
end 

681 
end 

682 
end; 

10015  683 

15646  684 
function TestCollisionYKick(Gear: PGear; Dir: LongInt): Word; 
685 
var centerX, centerY, i: LongInt; 

686 
test: TKickTest; 

687 
info: TCollisionEntry; 

688 
begin 

689 
test := TestCollisionYKickImpl( 

690 
hwRound(Gear^.X), hwRound(Gear^.Y), 

691 
Gear^.Radius, Dir, 

692 
Gear^.CollisionMask and lfLandMask, Gear^.CollisionMask); 

693 

694 
TestCollisionYKick := test.collisionMask; 

695 

696 
if test.kick then 

697 
begin 

698 
if hwAbs(Gear^.dY) < cHHKick then 

699 
exit; 

700 
if ((Gear^.State and gstHHJumping) <> 0) and (not Gear^.dY.isNegative) and (Gear^.dY < _0_4) then 

701 
exit; 

702 

703 
centerX := hwRound(Gear^.X); 

704 
centerY := hwRound(Gear^.Y); 

705 

706 
for i := 0 to Pred(Count) do 

707 
begin 

708 
info := cinfos[i]; 

709 
if (Gear <> info.cGear) 

710 
and ((centerY + Gear^.Radius > info.Y) xor (Dir > 0)) 

711 
and (info.cGear^.State and gstNotKickable = 0) 

712 
and (info.cGear^.Kind in [gtHedgehog, gtMine, gtKnife, gtExplosives]) 

713 
and (sqr(centerX  info.X) + sqr(centerY  info.Y) <= sqr(info.Radius + Gear^.Radius + 2)) then 

714 
begin 

715 
with info.cGear^ do 

716 
begin 

717 
if (Kind <> gtExplosives) or ((State and gsttmpflag) <> 0) then 

718 
dX := Gear^.dX * _0_5; 

719 
dY := Gear^.dY; 

720 
State := State or gstMoving; 

721 
if Kind = gtKnife then State:= State and (not gstCollision); 

722 
Active := true 

723 
end; 

724 
DeleteCI(info.cGear); 

725 
exit(0) 

726 
end 

727 
end 

728 
end 

4  729 
end; 
730 

10818
f642a28cab0c
Add placement of airmines in engine outside of hog proximity. Has a bug, only protecting 1st team. Also fix a spelling error and rename gstHHChooseTarget to gstChooseTarget
nemo
parents:
10635
diff
changeset

731 
function TestRectangleForObstacle(x1, y1, x2, y2: LongInt; landOnly: boolean): boolean; 
5896
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

732 
var x, y: LongInt; 
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

733 
TestWord: LongWord; 
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

734 
begin 
10818
f642a28cab0c
Add placement of airmines in engine outside of hog proximity. Has a bug, only protecting 1st team. Also fix a spelling error and rename gstHHChooseTarget to gstChooseTarget
nemo
parents:
10635
diff
changeset

735 
TestRectangleForObstacle:= true; 
6990
40e5af28d026
change every return value into a more pascalish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6986
diff
changeset

736 

5896
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

737 
if landOnly then 
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

738 
TestWord:= 255 
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

739 
else 
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

740 
TestWord:= 0; 
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

741 

5896
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

742 
if x1 > x2 then 
6990
40e5af28d026
change every return value into a more pascalish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6986
diff
changeset

743 
begin 
5896
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

744 
x := x1; 
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

745 
x1 := x2; 
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

746 
x2 := x; 
6990
40e5af28d026
change every return value into a more pascalish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6986
diff
changeset

747 
end; 
5896
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

748 

9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

749 
if y1 > y2 then 
6990
40e5af28d026
change every return value into a more pascalish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6986
diff
changeset

750 
begin 
5896
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

751 
y := y1; 
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

752 
y1 := y2; 
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

753 
y2 := y; 
6990
40e5af28d026
change every return value into a more pascalish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6986
diff
changeset

754 
end; 
5896
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

755 

5919
f737843dd331
TestRectForObstacle: areas outside map borders are not passable
sheepluva
parents:
5896
diff
changeset

756 
if (hasBorder and ((y1 < 0) or (x1 < 0) or (x2 > LAND_WIDTH))) then 
6990
40e5af28d026
change every return value into a more pascalish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6986
diff
changeset

757 
exit; 
5919
f737843dd331
TestRectForObstacle: areas outside map borders are not passable
sheepluva
parents:
5896
diff
changeset

758 

5896
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

759 
for y := y1 to y2 do 
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

760 
for x := x1 to x2 do 
6990
40e5af28d026
change every return value into a more pascalish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6986
diff
changeset

761 
if ((y and LAND_HEIGHT_MASK) = 0) and ((x and LAND_WIDTH_MASK) = 0) and (Land[y, x] > TestWord) then 
40e5af28d026
change every return value into a more pascalish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6986
diff
changeset

762 
exit; 
5896
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

763 

10818
f642a28cab0c
Add placement of airmines in engine outside of hog proximity. Has a bug, only protecting 1st team. Also fix a spelling error and rename gstHHChooseTarget to gstChooseTarget
nemo
parents:
10635
diff
changeset

764 
TestRectangleForObstacle:= false 
5896
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

765 
end; 
9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

766 

9ce1cf4e5a32
lua: boolean TestRectForObstacle(x1, y1, x2, y2, landOnly)
sheepluva
parents:
5834
diff
changeset

767 
function CalcSlopeTangent(Gear: PGear; collisionX, collisionY: LongInt; var outDeltaX, outDeltaY: LongInt; TestWord: LongWord): boolean; 
3408  768 
var ldx, ldy, rdx, rdy: LongInt; 
6123  769 
i, j, k, 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

770 
tmpx, tmpy: LongWord; 
3569  771 
dx, dy, s: hwFloat; 
6453
11c578d30bd3
Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents:
6279
diff
changeset

772 
offset: array[0..7,0..1] of ShortInt; 
6123  773 
isColl: 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

774 

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

775 
begin 
6990
40e5af28d026
change every return value into a more pascalish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6986
diff
changeset

776 
CalcSlopeTangent:= false; 
40e5af28d026
change every return value into a more pascalish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6986
diff
changeset

777 

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

778 
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

779 
dy:= Gear^.dY; 
3408  780 

3569  781 
// we start searching from the direction the gear came from 
782 
if (dx.QWordValue > _0_995.QWordValue ) 

783 
or (dy.QWordValue > _0_995.QWordValue ) then 

784 
begin // scale 

6279  785 
s := _0_995 / Distance(dx,dy); 
3569  786 
dx := s * dx; 
787 
dy := s * dy; 

788 
end; 

789 

3408  790 
mx:= hwRound(Gear^.Xdx)  hwRound(Gear^.X); 
791 
my:= hwRound(Gear^.Ydy)  hwRound(Gear^.Y); 

792 

793 
li:= 1; 

794 
ri:= 1; 

3569  795 

3408  796 
// go around collision pixel, checking for first/last collisions 
797 
// this will determinate what angles will be tried to crawl along 

798 
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

799 
begin 
3408  800 
offset[i,0]:= mx; 
801 
offset[i,1]:= my; 

3569  802 

6123  803 
// multiplicator k tries to skip small pixels/gaps when possible 
804 
for k:= 4 downto 1 do 

805 
begin 

806 
tmpx:= collisionX + k * mx; 

807 
tmpy:= collisionY + k * 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

808 

6123  809 
if (((tmpy) and LAND_HEIGHT_MASK) = 0) and (((tmpx) and LAND_WIDTH_MASK) = 0) then 
810 
if (Land[tmpy,tmpx] > TestWord) then 

3408  811 
begin 
6123  812 
// remember the index belonging to the first and last collision (if in 1st half) 
813 
if (i <> 0) then 

814 
begin 

815 
if (ri = 1) then 

816 
ri:= i 

817 
else 

818 
li:= i; 

819 
end; 

3408  820 
end; 
6123  821 
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

822 

6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

823 
if i = 7 then 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

824 
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

825 

3408  826 
// prepare offset for next check (clockwise) 
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

827 
if (mx = 1) and (my <> 1) then 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

828 
my:= my  1 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

829 
else if (my = 1) and (mx <> 1) then 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

830 
mx:= mx + 1 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

831 
else if (mx = 1) and (my <> 1) then 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

832 
my:= my + 1 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

833 
else 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

834 
mx:= mx  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

835 

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

836 
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

837 

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

838 
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

839 
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

840 
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

841 
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

842 

3408  843 
// edgecrawl 
844 
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

845 
begin 
3408  846 
// using mx,my as temporary value buffer here 
3697  847 

3408  848 
jfr:= 8+li+1; 
849 
jto:= 8+li1; 

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

850 

6123  851 
isColl:= false; 
3408  852 
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

853 
begin 
3408  854 
tmpo:= j mod 8; 
6123  855 
// multiplicator k tries to skip small pixels/gaps when possible 
856 
for k:= 3 downto 1 do 

857 
begin 

858 
tmpx:= ldx + k * offset[tmpo,0]; 

859 
tmpy:= ldy + k * offset[tmpo,1]; 

860 
if (((tmpy) and LAND_HEIGHT_MASK) = 0) and (((tmpx) and LAND_WIDTH_MASK) = 0) 

6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

861 
and (Land[tmpy,tmpx] > TestWord) then 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

862 
begin 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

863 
ldx:= tmpx; 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

864 
ldy:= tmpy; 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

865 
isColl:= true; 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

866 
break; 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

867 
end; 
6123  868 
end; 
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

869 
if isColl then 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

870 
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

871 
end; 
3408  872 

873 
jfr:= 8+ri1; 

874 
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

875 

6123  876 
isColl:= false; 
3408  877 
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

878 
begin 
3408  879 
tmpo:= j mod 8; 
6123  880 
for k:= 3 downto 1 do 
881 
begin 

882 
tmpx:= rdx + k * offset[tmpo,0]; 

883 
tmpy:= rdy + k * offset[tmpo,1]; 

884 
if (((tmpy) and LAND_HEIGHT_MASK) = 0) and (((tmpx) and LAND_WIDTH_MASK) = 0) 

6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

885 
and (Land[tmpy,tmpx] > TestWord) then 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

886 
begin 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

887 
rdx:= tmpx; 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

888 
rdy:= tmpy; 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

889 
isColl:= true; 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

890 
break; 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

891 
end; 
6123  892 
end; 
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

893 
if isColl then 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

894 
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

895 
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

896 
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

897 

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

898 
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

899 
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

900 

6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

901 
if ((ldx = 0) and (ldy = 0)) then 
6990
40e5af28d026
change every return value into a more pascalish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6986
diff
changeset

902 
exit; 
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

903 

3414
b2f3bb44777e
some portal changes, warning: no loop prevention yet, note: entry angle not preserved yet
sheepluva
parents:
3411
diff
changeset

904 
outDeltaX:= ldx; 
b2f3bb44777e
some portal changes, warning: no loop prevention yet, note: entry angle not preserved yet
sheepluva
parents:
3411
diff
changeset

905 
outDeltaY:= ldy; 
6990
40e5af28d026
change every return value into a more pascalish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6986
diff
changeset

906 
CalcSlopeTangent:= 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

907 
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

908 

7754  909 
function CalcSlopeNearGear(Gear: PGear; dirX, dirY: LongInt): hwFloat; 
910 
var dx, dy: hwFloat; 

911 
collX, collY, i, y, x, gx, gy, sdx, sdy: LongInt; 

912 
isColl, bSucc: Boolean; 

913 
begin 

914 

10015  915 
if dirY <> 0 then 
7754  916 
begin 
917 
y:= hwRound(Gear^.Y) + Gear^.Radius * dirY; 

918 
gx:= hwRound(Gear^.X); 

919 
collX := gx; 

920 
isColl:= false; 

921 

922 
if (y and LAND_HEIGHT_MASK) = 0 then 

923 
begin 

924 
x:= hwRound(Gear^.X)  Gear^.Radius + 1; 

925 
i:= x + Gear^.Radius * 2  2; 

926 
repeat 

927 
if (x and LAND_WIDTH_MASK) = 0 then 

928 
if Land[y, x] <> 0 then 

7767  929 
if (not isColl) or (abs(xgx) < abs(collXgx)) then 
7754  930 
begin 
931 
isColl:= true; 

932 
collX := x; 

933 
end; 

934 
inc(x) 

935 
until (x > i); 

936 
end; 

937 
end 

938 
else 

939 
begin 

940 
x:= hwRound(Gear^.X) + Gear^.Radius * dirX; 

941 
gy:= hwRound(Gear^.Y); 

942 
collY := gy; 

943 
isColl:= false; 

944 

945 
if (x and LAND_WIDTH_MASK) = 0 then 

946 
begin 

947 
y:= hwRound(Gear^.Y)  Gear^.Radius + 1; 

948 
i:= y + Gear^.Radius * 2  2; 

949 
repeat 

950 
if (y and LAND_HEIGHT_MASK) = 0 then 

951 
if Land[y, x] <> 0 then 

7767  952 
if (not isColl) or (abs(ygy) < abs(collYgy)) then 
7754  953 
begin 
954 
isColl:= true; 

955 
collY := y; 

956 
end; 

957 
inc(y) 

958 
until (y > i); 

959 
end; 

960 
end; 

961 

962 
if isColl then 

963 
begin 

964 
// save original dx/dy 

965 
dx := Gear^.dX; 

966 
dy := Gear^.dY; 

967 

968 
if dirY <> 0 then 

969 
begin 

970 
Gear^.dX.QWordValue:= 0; 

971 
Gear^.dX.isNegative:= (collX >= gx); 

972 
Gear^.dY:= _1*dirY 

973 
end 

974 
else 

975 
begin 

976 
Gear^.dY.QWordValue:= 0; 

977 
Gear^.dY.isNegative:= (collY >= gy); 

978 
Gear^.dX:= _1*dirX 

979 
end; 

980 

981 
sdx:= 0; 

982 
sdy:= 0; 

983 
if dirY <> 0 then 

984 
bSucc := CalcSlopeTangent(Gear, collX, y, sdx, sdy, 0) 

985 
else bSucc := CalcSlopeTangent(Gear, x, collY, sdx, sdy, 0); 

986 

987 
// restore original dx/dy 

988 
Gear^.dX := dx; 

989 
Gear^.dY := dy; 

990 

991 
if bSucc and ((sdx <> 0) or (sdy <> 0)) then 

992 
begin 

993 
dx := int2hwFloat(sdy) / (abs(sdx) + abs(sdy)); 

994 
dx.isNegative := (sdx * sdy) < 0; 

995 
exit (dx); 

996 
end 

997 
end; 

998 

999 
CalcSlopeNearGear := _0; 

1000 
end; 

1001 

6279  1002 
function CalcSlopeBelowGear(Gear: PGear): hwFloat; 
6124  1003 
var dx, dy: hwFloat; 
6279  1004 
collX, i, y, x, gx, sdx, sdy: LongInt; 
6453
11c578d30bd3
Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents:
6279
diff
changeset

1005 
isColl, bSucc: Boolean; 
6124  1006 
begin 
1007 

1008 

1009 
y:= hwRound(Gear^.Y) + Gear^.Radius; 

1010 
gx:= hwRound(Gear^.X); 

1011 
collX := gx; 

1012 
isColl:= false; 

1013 

1014 
if (y and LAND_HEIGHT_MASK) = 0 then 

6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

1015 
begin 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

1016 
x:= hwRound(Gear^.X)  Gear^.Radius + 1; 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

1017 
i:= x + Gear^.Radius * 2  2; 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

1018 
repeat 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

1019 
if (x and LAND_WIDTH_MASK) = 0 then 
14531
e0af4ce7d8bc
fix incorrect mask set in r7b4643ff60ea  this causes ghost hog collisions and odd hog jumps on overlap with active hog
nemo
parents:
14282
diff
changeset

1020 
if (Land[y, x] and lfLandMask) <> 0 then 
7767  1021 
if (not isColl) or (abs(xgx) < abs(collXgx)) then 
6124  1022 
begin 
1023 
isColl:= true; 

1024 
collX := x; 

1025 
end; 

6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

1026 
inc(x) 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

1027 
until (x > i); 
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6543
diff
changeset

1028 
end; 
6124  1029 

1030 
if isColl then 

6279  1031 
begin 
1032 
// save original dx/dy 

1033 
dx := Gear^.dX; 

1034 
dy := Gear^.dY; 

1035 

1036 
Gear^.dX.QWordValue:= 0; 

1037 
Gear^.dX.isNegative:= (collX >= gx); 

1038 
Gear^.dY:= _1; 

1039 

1040 
sdx:= 0; 

1041 
sdy:= 0; 

6453
11c578d30bd3
Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents:
6279
diff
changeset

1042 
bSucc := CalcSlopeTangent(Gear, collX, y, sdx, sdy, 255); 
6124  1043 

6279  1044 
// restore original dx/dy 
1045 
Gear^.dX := dx; 

1046 
Gear^.dY := dy; 

6124  1047 

6453
11c578d30bd3
Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents:
6279
diff
changeset

1048 
if bSucc and (sdx <> 0) and (sdy <> 0) then 
6279  1049 
begin 
1050 
dx := int2hwFloat(sdy) / (abs(sdx) + abs(sdy)); 

1051 
dx.isNegative := (sdx * sdy) < 0; 

1052 
exit (dx); 

1053 
end; 

1054 
end; 

1055 

1056 
CalcSlopeBelowGear := _0; 

6124  1057 
end; 
1058 

15301  1059 
function CheckGearsUnderSprite(Sprite: TSprite; sprX, sprY, Frame: LongInt): boolean; 
1060 
var x, y, bpp, h, w, row, col, gx, gy, r, numFramesFirstCol: LongInt; 

1061 
p: PByteArray; 

1062 
Image: PSDL_Surface; 

1063 
Gear: PGear; 

1064 
begin 

1065 
CheckGearsUnderSprite := false; 

1066 
if checkFails(SpritesData[Sprite].Surface <> nil, 'Assert SpritesData[Sprite].Surface failed', true) then exit; 

1067 

1068 
numFramesFirstCol:= SpritesData[Sprite].imageHeight div SpritesData[Sprite].Height; 

1069 
Image:= SpritesData[Sprite].Surface; 

1070 

1071 
if SDL_MustLock(Image) then 

1072 
if SDLCheck(SDL_LockSurface(Image) >= 0, 'CheckGearsUnderSprite', true) then exit; 

1073 

1074 
bpp:= Image^.format^.BytesPerPixel; 

1075 

1076 
if checkFails(bpp = 4, 'It should be 32 bpp sprite', true) then 

1077 
begin 

1078 
if SDL_MustLock(Image) then 

1079 
SDL_UnlockSurface(Image); 

1080 
exit 

1081 
end; 

1082 

1083 
w:= SpritesData[Sprite].Width; 

1084 
h:= SpritesData[Sprite].Height; 

1085 

1086 
row:= Frame mod numFramesFirstCol; 

1087 
col:= Frame div numFramesFirstCol; 

1088 
p:= PByteArray(@(PByteArray(Image^.pixels)^[ Image^.pitch * row * h + col * w * 4 ])); 

1089 
Gear:= GearsList; 

1090 

1091 
while Gear <> nil do 

1092 
begin 

15304  1093 
if (Gear^.Kind = gtAirMine) or 
1094 
((Gear^.Kind in [gtCase, gtExplosives, gtTarget, gtKnife, gtMine, gtHedgehog, gtSMine]) and (Gear^.CollisionIndex = 1)) then 

15301  1095 
begin 
1096 
gx:= hwRound(Gear^.X); 

1097 
gy:= hwRound(Gear^.Y); 

15302
9299f43ba0ec
disallow placing girders over airmines and moving hogs
alfadur
parents:
15301
diff
changeset

1098 
r:= Gear^.Radius + 1; 
15301  1099 
if (gx + r >= sprX) and (gx  r < sprX + w) and (gy + r >= sprY) and (gy  r < sprY + h) then 
1100 
for y := gy  r to gy + r do 

1101 
for x := gx  r to gx + r do 

1102 
begin 

1103 
if (x >= sprX) and (x < sprX + w) and (y >= sprY) and (y < sprY + h) 

15302
9299f43ba0ec
disallow placing girders over airmines and moving hogs
alfadur
parents:
15301
diff
changeset

1104 
and (Sqr(x  gx) + Sqr(y  gy) <= Sqr(r)) 
9299f43ba0ec
disallow placing girders over airmines and moving hogs
alfadur
parents:
15301
diff
changeset

1105 
and (((PLongword(@(p^[Image^.pitch * (y  sprY) + (x  sprX) * 4]))^) and AMask) <> 0) then 
15301  1106 
begin 
1107 
CheckGearsUnderSprite := true; 

1108 
if SDL_MustLock(Image) then 

1109 
SDL_UnlockSurface(Image); 

1110 
exit 

1111 
end 

1112 
end 

1113 
end; 

1114 

1115 
Gear := Gear^.NextGear 

1116 
end; 

1117 
end; 

1118 

3038  1119 
procedure initModule; 
2716
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2630
diff
changeset

1120 
begin 
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2716
diff
changeset

1121 
Count:= 0; 
2716
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2630
diff
changeset

1122 
end; 
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2630
diff
changeset

1123 

3038  1124 
procedure freeModule; 
2716
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2630
diff
changeset

1125 
begin 
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2630
diff
changeset

1126 

b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2630
diff
changeset

1127 
end; 
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2630
diff
changeset

1128 

4  1129 
end. 