forgot this commit.
(*
* Hedgewars, a free turn based strategy game
* Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; version 2 of the License
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
*)
{$INCLUDE "options.inc"}
unit uGearsHandlersRope;
interface
uses uTypes;
procedure doStepRope(Gear: PGear);
implementation
uses uConsts, uFloat, uCollisions, uVariables, uGearsList, uSound, uGearsUtils,
uAmmos, uDebug, uUtils, uGearsHedgehog, uGearsRender;
const
IsNilHHFatal = false;
procedure doStepRopeAfterAttack(Gear: PGear);
var
HHGear: PGear;
tX: hwFloat;
begin
HHGear := Gear^.Hedgehog^.Gear;
if HHGear = nil then
begin
OutError('ERROR: doStepRopeAfterAttack called while HHGear = nil', IsNilHHFatal);
DeleteGear(Gear);
exit()
end
else if not CurrentTeam^.ExtDriven and (FollowGear <> nil) then FollowGear := HHGear;
tX:= HHGear^.X;
if WorldWrap(HHGear) and (WorldEdge = weWrap) and
((TestCollisionXwithGear(HHGear, 1) <> 0) or (TestCollisionXwithGear(HHGear, -1) <> 0)) then
begin
HHGear^.X:= tX;
HHGear^.dX.isNegative:= hwRound(tX) > leftX + HHGear^.Radius * 2
end;
if (HHGear^.Hedgehog^.CurAmmoType = amParachute) and (HHGear^.dY > _0_39) then
begin
DeleteGear(Gear);
ApplyAmmoChanges(HHGear^.Hedgehog^);
HHGear^.Message:= HHGear^.Message or gmLJump;
exit
end;
if ((HHGear^.State and gstHHDriven) = 0)
or (CheckGearDrowning(HHGear))
or (TestCollisionYwithGear(HHGear, 1) <> 0) then
begin
DeleteGear(Gear);
if (TestCollisionYwithGear(HHGear, 1) <> 0) and (GetAmmoEntry(HHGear^.Hedgehog^, amRope)^.Count >= 1) and ((Ammoz[HHGear^.Hedgehog^.CurAmmoType].Ammo.Propz and ammoprop_AltUse) <> 0) and (HHGear^.Hedgehog^.MultiShootAttacks = 0) then
HHGear^.Hedgehog^.CurAmmoType:= amRope;
isCursorVisible := false;
ApplyAmmoChanges(HHGear^.Hedgehog^);
exit
end;
HedgehogChAngle(HHGear);
if TestCollisionXwithGear(HHGear, hwSign(HHGear^.dX)) <> 0 then
SetLittle(HHGear^.dX);
if HHGear^.dY.isNegative and (TestCollisionYwithGear(HHGear, -1) <> 0) then
HHGear^.dY := _0;
HHGear^.X := HHGear^.X + HHGear^.dX;
HHGear^.Y := HHGear^.Y + HHGear^.dY;
HHGear^.dY := HHGear^.dY + cGravity;
if (GameFlags and gfMoreWind) <> 0 then
HHGear^.dX := HHGear^.dX + cWindSpeed / HHGear^.Density;
if (Gear^.Message and gmAttack) <> 0 then
begin
Gear^.X := HHGear^.X;
Gear^.Y := HHGear^.Y;
ApplyAngleBounds(Gear^.Hedgehog^, amRope);
Gear^.dX := SignAs(AngleSin(HHGear^.Angle), HHGear^.dX);
Gear^.dY := -AngleCos(HHGear^.Angle);
Gear^.Friction := _4_5 * cRopePercent;
Gear^.Elasticity := _0;
Gear^.State := Gear^.State and (not gsttmpflag);
Gear^.doStep := @doStepRope;
end
end;
procedure RopeDeleteMe(Gear, HHGear: PGear);
begin
with HHGear^ do
begin
Message := Message and (not gmAttack);
State := (State or gstMoving) and (not gstWinner);
end;
DeleteGear(Gear)
end;
procedure RopeWaitCollision(Gear, HHGear: PGear);
begin
with HHGear^ do
begin
Message := Message and (not gmAttack);
State := State or gstMoving;
end;
RopePoints.Count := 0;
Gear^.Elasticity := _0;
Gear^.doStep := @doStepRopeAfterAttack
end;
procedure doStepRopeWork(Gear: PGear);
var
HHGear: PGear;
len, tx, ty, nx, ny, ropeDx, ropeDy, mdX, mdY: hwFloat;
lx, ly, cd: LongInt;
haveCollision,
haveDivided: boolean;
wrongSide: boolean;
begin
HHGear := Gear^.Hedgehog^.Gear;
if HHGear = nil then
begin
OutError('ERROR: doStepRopeWork called while HHGear = nil', IsNilHHFatal);
DeleteGear(Gear);
exit()
end
else if not CurrentTeam^.ExtDriven and (FollowGear <> nil) then FollowGear := HHGear;
if ((HHGear^.State and gstHHDriven) = 0) or
(CheckGearDrowning(HHGear)) or (Gear^.PortalCounter <> 0) then
begin
PlaySound(sndRopeRelease);
RopeDeleteMe(Gear, HHGear);
exit
end;
if GameTicks mod 4 <> 0 then exit;
tX:= HHGear^.X;
if WorldWrap(HHGear) and (WorldEdge = weWrap) and
((TestCollisionXwithGear(HHGear, 1) <> 0) or (TestCollisionXwithGear(HHGear, -1) <> 0)) then
begin
PlaySound(sndRopeRelease);
RopeDeleteMe(Gear, HHGear);
HHGear^.X:= tX;
HHGear^.dX.isNegative:= hwRound(tX) > leftX + HHGear^.Radius * 2;
exit
end;
tX:= HHGear^.X;
HHGear^.dX.QWordValue:= HHGear^.dX.QWordValue shl 2;
HHGear^.dY.QWordValue:= HHGear^.dY.QWordValue shl 2;
if (Gear^.Message and gmLeft <> 0) and (TestCollisionXwithGear(HHGear, -1) = 0) then
HHGear^.dX := HHGear^.dX - _0_0032;
if (Gear^.Message and gmRight <> 0) and (TestCollisionXwithGear(HHGear, 1) = 0) then
HHGear^.dX := HHGear^.dX + _0_0032;
// vector between hedgehog and rope attaching point
ropeDx := HHGear^.X - Gear^.X;
ropeDy := HHGear^.Y - Gear^.Y;
if TestCollisionYwithXYShift(HHGear, 0, 1, 1) = 0 then
begin
// depending on the rope vector we know which X-side to check for collision
// in order to find out if the hog can still be moved by gravity
if ropeDx.isNegative = RopeDy.IsNegative then
cd:= -1
else
cd:= 1;
// apply gravity if there is no obstacle
if TestCollisionXwithXYShift(HHGear, _2*cd, 0, cd, true) = 0 then
HHGear^.dY := HHGear^.dY + cGravity * 16;
if (GameFlags and gfMoreWind) <> 0 then
// apply wind if there's no obstacle
if TestCollisionXwithGear(HHGear, hwSign(cWindSpeed)) = 0 then
HHGear^.dX := HHGear^.dX + cWindSpeed * 16 / HHGear^.Density;
end;
mdX := ropeDx + HHGear^.dX;
mdY := ropeDy + HHGear^.dY;
len := _1 / Distance(mdX, mdY);
// rope vector plus hedgehog direction vector normalized
mdX := mdX * len;
mdY := mdY * len;
// for visual purposes only
Gear^.dX := mdX;
Gear^.dY := mdY;
/////
tx := HHGear^.X;
ty := HHGear^.Y;
if ((Gear^.Message and gmDown) <> 0) and (Gear^.Elasticity < Gear^.Friction) then
if not ((TestCollisionXwithXYShift(HHGear, _2*hwSign(ropeDx), 0, hwSign(ropeDx), true) <> 0)
or ((ropeDy.QWordValue <> 0) and (TestCollisionYwithXYShift(HHGear, 0, hwSign(ropeDy), hwSign(ropeDy)) <> 0))) then
Gear^.Elasticity := Gear^.Elasticity + _1_2;
if ((Gear^.Message and gmUp) <> 0) and (Gear^.Elasticity > _30) then
if not ((TestCollisionXwithXYShift(HHGear, -_2*hwSign(ropeDx), 0, -hwSign(ropeDx), true) <> 0)
or ((ropeDy.QWordValue <> 0) and (TestCollisionYwithXYShift(HHGear, 0, -hwSign(ropeDy), -hwSign(ropeDy)) <> 0))) then
Gear^.Elasticity := Gear^.Elasticity - _1_2;
HHGear^.X := Gear^.X + mdX * Gear^.Elasticity;
HHGear^.Y := Gear^.Y + mdY * Gear^.Elasticity;
HHGear^.dX := HHGear^.X - tx;
HHGear^.dY := HHGear^.Y - ty;
haveDivided := false;
// check whether rope needs dividing
len := Gear^.Elasticity - _5;
nx := Gear^.X + mdX * len;
ny := Gear^.Y + mdY * len;
tx := mdX * _1_2; // should be the same as increase step
ty := mdY * _1_2;
while len > _3 do
begin
lx := hwRound(nx);
ly := hwRound(ny);
if ((ly and LAND_HEIGHT_MASK) = 0) and ((lx and LAND_WIDTH_MASK) = 0) and (Land[ly, lx] > lfAllObjMask) then
begin
tx := _1 / Distance(ropeDx, ropeDy);
// old rope pos
nx := ropeDx * tx;
ny := ropeDy * tx;
with RopePoints.ar[RopePoints.Count] do
begin
X := Gear^.X;
Y := Gear^.Y;
if RopePoints.Count = 0 then
RopePoints.HookAngle := DxDy2Angle(Gear^.dY, Gear^.dX);
b := (nx * HHGear^.dY) > (ny * HHGear^.dX);
sx:= Gear^.dX.isNegative;
sy:= Gear^.dY.isNegative;
sb:= Gear^.dX.QWordValue < Gear^.dY.QWordValue;
dLen := len
end;
with RopePoints.rounded[RopePoints.Count] do
begin
X := hwRound(Gear^.X);
Y := hwRound(Gear^.Y);
end;
Gear^.X := Gear^.X + nx * len;
Gear^.Y := Gear^.Y + ny * len;
inc(RopePoints.Count);
if checkFails(RopePoints.Count <= MAXROPEPOINTS, 'Rope points overflow', true) then exit;
Gear^.Elasticity := Gear^.Elasticity - len;
Gear^.Friction := Gear^.Friction - len;
haveDivided := true;
break
end;
nx := nx - tx;
ny := ny - ty;
// len := len - _1_2 // should be the same as increase step
len.QWordValue := len.QWordValue - _1_2.QWordValue;
end;
if not haveDivided then
if RopePoints.Count > 0 then // check whether the last dividing point could be removed
begin
tx := RopePoints.ar[Pred(RopePoints.Count)].X;
ty := RopePoints.ar[Pred(RopePoints.Count)].Y;
mdX := tx - Gear^.X;
mdY := ty - Gear^.Y;
ropeDx:= tx - HHGear^.X;
ropeDy:= ty - HHGear^.Y;
if RopePoints.ar[Pred(RopePoints.Count)].b xor (mdX * ropeDy > ropeDx * mdY) then
begin
dec(RopePoints.Count);
Gear^.X := tx;
Gear^.Y := ty;
// oops, opposite quadrant, don't restore hog position in such case, just remove the point
wrongSide:= (ropeDx.isNegative = RopePoints.ar[RopePoints.Count].sx)
and (ropeDy.isNegative = RopePoints.ar[RopePoints.Count].sy);
// previous check could be inaccurate in vertical/horizontal rope positions,
// so perform this check also, even though odds are 1 to 415927 to hit this
if (not wrongSide)
and ((ropeDx.isNegative = RopePoints.ar[RopePoints.Count].sx)
<> (ropeDy.isNegative = RopePoints.ar[RopePoints.Count].sy)) then
if RopePoints.ar[RopePoints.Count].sb then
wrongSide:= ropeDy.isNegative = RopePoints.ar[RopePoints.Count].sy
else
wrongSide:= ropeDx.isNegative = RopePoints.ar[RopePoints.Count].sx;
if wrongSide then
begin
Gear^.Elasticity := Gear^.Elasticity - RopePoints.ar[RopePoints.Count].dLen;
Gear^.Friction := Gear^.Friction - RopePoints.ar[RopePoints.Count].dLen;
end else
begin
Gear^.Elasticity := Gear^.Elasticity + RopePoints.ar[RopePoints.Count].dLen;
Gear^.Friction := Gear^.Friction + RopePoints.ar[RopePoints.Count].dLen;
// restore hog position
len := _1 / Distance(mdX, mdY);
mdX := mdX * len;
mdY := mdY * len;
HHGear^.X := Gear^.X - mdX * Gear^.Elasticity;
HHGear^.Y := Gear^.Y - mdY * Gear^.Elasticity;
end;
end
end;
haveCollision := false;
if TestCollisionXwithXYShift(HHGear, _2*hwSign(HHGear^.dX), 0, hwSign(HHGear^.dX), true) <> 0 then
begin
HHGear^.dX := -_0_6 * HHGear^.dX;
haveCollision := true
end;
if TestCollisionYwithXYShift(HHGear, 0, 1*hwSign(HHGear^.dY), hwSign(HHGear^.dY)) <> 0 then
begin
HHGear^.dY := -_0_6 * HHGear^.dY;
haveCollision := true
end;
if haveCollision and (Gear^.Message and (gmLeft or gmRight) <> 0) and (Gear^.Message and (gmUp or gmDown) <> 0) then
begin
HHGear^.dX := SignAs(hwAbs(HHGear^.dX) + _0_8, HHGear^.dX);
HHGear^.dY := SignAs(hwAbs(HHGear^.dY) + _0_8, HHGear^.dY)
end;
len := hwSqr(HHGear^.dX) + hwSqr(HHGear^.dY);
if len > _10 then
begin
len := _3_2 / hwSqrt(len);
HHGear^.dX := HHGear^.dX * len;
HHGear^.dY := HHGear^.dY * len;
end;
haveCollision:= ((hwRound(Gear^.Y) and LAND_HEIGHT_MASK) = 0) and ((hwRound(Gear^.X) and LAND_WIDTH_MASK) = 0) and ((Land[hwRound(Gear^.Y), hwRound(Gear^.X)]) <> 0);
if not haveCollision then
begin
// backup gear location
tx:= Gear^.X;
ty:= Gear^.Y;
if RopePoints.Count > 0 then
begin
// set gear location to the remote end of the rope, the attachment point
Gear^.X:= RopePoints.ar[0].X;
Gear^.Y:= RopePoints.ar[0].Y;
end;
CheckCollision(Gear);
// if we haven't found any collision yet then check the other side too
if (Gear^.State and gstCollision) = 0 then
begin
Gear^.dX.isNegative:= not Gear^.dX.isNegative;
Gear^.dY.isNegative:= not Gear^.dY.isNegative;
CheckCollision(Gear);
Gear^.dX.isNegative:= not Gear^.dX.isNegative;
Gear^.dY.isNegative:= not Gear^.dY.isNegative;
end;
haveCollision:= (Gear^.State and gstCollision) <> 0;
// restore gear location
Gear^.X:= tx;
Gear^.Y:= ty;
end;
// if the attack key is pressed, lose rope contact as well
if (Gear^.Message and gmAttack) <> 0 then
haveCollision:= false;
HHGear^.dX.QWordValue:= HHGear^.dX.QWordValue shr 2;
HHGear^.dY.QWordValue:= HHGear^.dY.QWordValue shr 2;
if (not haveCollision) and ((Gear^.State and gsttmpFlag) <> 0) then
begin
begin
PlaySound(sndRopeRelease);
if Gear^.Hedgehog^.CurAmmoType <> amParachute then
RopeWaitCollision(Gear, HHGear)
else
RopeDeleteMe(Gear, HHGear)
end
end
else
if (Gear^.State and gsttmpFlag) = 0 then
Gear^.State := Gear^.State or gsttmpFlag;
end;
procedure RopeRemoveFromAmmo(Gear, HHGear: PGear);
begin
if (Gear^.State and gstAttacked) = 0 then
begin
OnUsedAmmo(HHGear^.Hedgehog^);
Gear^.State := Gear^.State or gstAttacked;
ApplyAmmoChanges(HHGear^.Hedgehog^);
end;
end;
procedure doStepRopeAttach(Gear: PGear);
var
HHGear: PGear;
tx, ty, tt: hwFloat;
begin
Gear^.X := Gear^.X - Gear^.dX;
Gear^.Y := Gear^.Y - Gear^.dY;
Gear^.Elasticity := Gear^.Elasticity + _1;
HHGear := Gear^.Hedgehog^.Gear;
if HHGear = nil then
begin
OutError('ERROR: doStepRopeAttach called while HHGear = nil', IsNilHHFatal);
DeleteGear(Gear);
exit()
end
else if not CurrentTeam^.ExtDriven and (FollowGear <> nil) then FollowGear := HHGear;
// Destroy rope if it touched bouncy or world wrap world edge.
// TODO: Allow to shoot rope through the world wrap edge and rope normally.
if (WorldWrap(Gear) and (WorldEdge = weWrap)) or
((WorldEdge = weBounce) and ((hwRound(Gear^.X) <= LeftX) or (hwRound(Gear^.X) >= RightX))) then
begin
HHGear^.State := HHGear^.State and (not (gstAttacking or gstHHJumping or gstHHHJump));
HHGear^.Message := HHGear^.Message and (not gmAttack);
DeleteGear(Gear);
if (GetAmmoEntry(HHGear^.Hedgehog^, amRope)^.Count >= 1) and ((Ammoz[HHGear^.Hedgehog^.CurAmmoType].Ammo.Propz and ammoprop_AltUse) <> 0) and (HHGear^.Hedgehog^.MultiShootAttacks = 0) then
HHGear^.Hedgehog^.CurAmmoType:= amRope;
isCursorVisible := false;
ApplyAmmoChanges(HHGear^.Hedgehog^);
exit()
end;
DeleteCI(HHGear);
if (HHGear^.State and gstMoving) <> 0 then
begin
doStepHedgehogMoving(HHGear);
Gear^.X := Gear^.X + HHGear^.dX;
Gear^.Y := Gear^.Y + HHGear^.dY;
// hedgehog can teleport up to 5 pixels upwards when sliding,
// so we have to give up the maintained rope length
// after doStepHedgehogMoving() call and recalculate
// it based on the gear and current hedgehog positions
Gear^.Elasticity:= int2hwFloat(hwRound(Distance(Gear^.X - HHGear^.X, Gear^.Y - HHGear^.Y) + _0_001));
tt := Gear^.Elasticity;
tx := _0;
ty := _0;
while tt > _20 do
begin
if ((hwRound(Gear^.Y+ty) and LAND_HEIGHT_MASK) = 0) and ((hwRound(Gear^.X+tx) and LAND_WIDTH_MASK) = 0) and (Land[hwRound(Gear^.Y+ty), hwRound(Gear^.X+tx)] > lfAllObjMask) then
begin
Gear^.X := Gear^.X + tx;
Gear^.Y := Gear^.Y + ty;
Gear^.Elasticity := tt;
Gear^.doStep := @doStepRopeWork;
PlaySound(sndRopeAttach);
with HHGear^ do
begin
State := State and (not (gstAttacking or gstHHJumping or gstHHHJump));
Message := Message and (not gmAttack)
end;
RopeRemoveFromAmmo(Gear, HHGear);
exit
end;
tx := tx + Gear^.dX + Gear^.dX;
ty := ty + Gear^.dY + Gear^.dY;
tt := tt - _2;
end;
end;
if Gear^.Elasticity < _20 then Gear^.CollisionMask:= lfLandMask
else Gear^.CollisionMask:= lfNotCurHogCrate; //lfNotObjMask or lfNotHHObjMask;
CheckCollision(Gear);
if (Gear^.State and gstCollision) <> 0 then
if Gear^.Elasticity < _10 then
Gear^.Elasticity := _10000
else
begin
Gear^.doStep := @doStepRopeWork;
PlaySound(sndRopeAttach);
with HHGear^ do
begin
State := State and (not (gstAttacking or gstHHJumping or gstHHHJump));
Message := Message and (not gmAttack)
end;
RopeRemoveFromAmmo(Gear, HHGear);
exit
end;
if (Gear^.Elasticity > Gear^.Friction)
or ((Gear^.Message and gmAttack) = 0)
or ((HHGear^.State and gstHHDriven) = 0)
or (HHGear^.Damage > 0) then
begin
with Gear^.Hedgehog^.Gear^ do
begin
State := State and (not gstAttacking);
Message := Message and (not gmAttack)
end;
DeleteGear(Gear);
if (GetAmmoEntry(HHGear^.Hedgehog^, amRope)^.Count >= 1) and ((Ammoz[HHGear^.Hedgehog^.CurAmmoType].Ammo.Propz and ammoprop_AltUse) <> 0) and (HHGear^.Hedgehog^.MultiShootAttacks = 0) then
HHGear^.Hedgehog^.CurAmmoType:= amRope;
isCursorVisible := false;
ApplyAmmoChanges(HHGear^.Hedgehog^);
exit;
end;
if CheckGearDrowning(HHGear) then DeleteGear(Gear)
end;
procedure doStepRope(Gear: PGear);
begin
Gear^.dX := - Gear^.dX;
Gear^.dY := - Gear^.dY;
Gear^.doStep := @doStepRopeAttach;
PlaySound(sndRopeShot)
end;
end.