1 (*

     2  * Hedgewars, a free turn based strategy game

     3  * Copyright (c) 2004-2012 Andrey Korotaev <unC0Rr@gmail.com>

     4  *

     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

     8  *

     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.

    13  *

    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

    16  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA

    17  *)

    18 

    19 {$INCLUDE "options.inc"}

    20 unit uGearsHandlersRope;

    21 interface

    22 

    23 uses uTypes;

    24 

    25 procedure doStepRope(Gear: PGear);

    26 

    27 implementation

    28 uses uConsts, uFloat, uCollisions, uVariables, uGearsList, uSound, uGearsUtils,

    29     uAmmos, uDebug, uUtils, uGearsHedgehog, uGearsRender;

    30 

    31 procedure doStepRopeAfterAttack(Gear: PGear);

    32 var 

    33     HHGear: PGear;

    34 begin

    35     HHGear := Gear^.Hedgehog^.Gear;

    36     if ((HHGear^.State and gstHHDriven) = 0)

    37     or (CheckGearDrowning(HHGear))

    38     or (TestCollisionYwithGear(HHGear, 1) <> 0) then

    39         begin

    40         DeleteGear(Gear);

    41         isCursorVisible := false;

    42         ApplyAmmoChanges(HHGear^.Hedgehog^);

    43         exit

    44         end;

    45 

    46     HedgehogChAngle(HHGear);

    47 

    48     if TestCollisionXwithGear(HHGear, hwSign(HHGear^.dX)) then

    49         SetLittle(HHGear^.dX);

    50 

    51     if HHGear^.dY.isNegative and (TestCollisionYwithGear(HHGear, -1) <> 0) then

    52         HHGear^.dY := _0;

    53     HHGear^.X := HHGear^.X + HHGear^.dX;

    54     HHGear^.Y := HHGear^.Y + HHGear^.dY;

    55     HHGear^.dY := HHGear^.dY + cGravity;

    56     

    57     if (GameFlags and gfMoreWind) <> 0 then

    58         HHGear^.dX := HHGear^.dX + cWindSpeed / HHGear^.Density;

    59 

    60     if (Gear^.Message and gmAttack) <> 0 then

    61         begin

    62         Gear^.X := HHGear^.X;

    63         Gear^.Y := HHGear^.Y;

    64 

    65         ApplyAngleBounds(Gear^.Hedgehog^, amRope);

    66 

    67         Gear^.dX := SignAs(AngleSin(HHGear^.Angle), HHGear^.dX);

    68         Gear^.dY := -AngleCos(HHGear^.Angle);

    69         Gear^.Friction := _4_5 * cRopePercent;

    70         Gear^.Elasticity := _0;

    71         Gear^.State := Gear^.State and (not gsttmpflag);

    72         Gear^.doStep := @doStepRope;

    73         end

    74 end;

    75 

    76 procedure RopeDeleteMe(Gear, HHGear: PGear);

    77 begin

    78     with HHGear^ do

    79         begin

    80         Message := Message and (not gmAttack);

    81         State := (State or gstMoving) and (not gstWinner);

    82         end;

    83     DeleteGear(Gear)

    84 end;

    85 

    86 procedure RopeWaitCollision(Gear, HHGear: PGear);

    87 begin

    88     with HHGear^ do

    89         begin

    90         Message := Message and (not gmAttack);

    91         State := State or gstMoving;

    92         end;

    93     RopePoints.Count := 0;

    94     Gear^.Elasticity := _0;

    95     Gear^.doStep := @doStepRopeAfterAttack

    96 end;

    97 

    98 procedure doStepRopeWork(Gear: PGear);

    99 var 

   100     HHGear: PGear;

   101     len, tx, ty, nx, ny, ropeDx, ropeDy, mdX, mdY: hwFloat;

   102     lx, ly, cd: LongInt;

   103     haveCollision,

   104     haveDivided: boolean;

   105 

   106 begin

   107     HHGear := Gear^.Hedgehog^.Gear;

   108 

   109     if ((HHGear^.State and gstHHDriven) = 0)

   110        or (CheckGearDrowning(HHGear)) or (Gear^.PortalCounter <> 0) then

   111         begin

   112         PlaySound(sndRopeRelease);

   113         RopeDeleteMe(Gear, HHGear);

   114         exit

   115         end;

   116 

   117     if (Gear^.Message and gmLeft  <> 0) and (not TestCollisionXwithGear(HHGear, -1)) then

   118         HHGear^.dX := HHGear^.dX - _0_0002;

   119 

   120     if (Gear^.Message and gmRight <> 0) and (not TestCollisionXwithGear(HHGear,  1)) then

   121         HHGear^.dX := HHGear^.dX + _0_0002;

   122 

   123     // vector between hedgehog and rope attaching point

   124     ropeDx := HHGear^.X - Gear^.X;

   125     ropeDy := HHGear^.Y - Gear^.Y;

   126 

   127     if TestCollisionYwithGear(HHGear, 1) = 0 then

   128         begin

   129 

   130         // depending on the rope vector we know which X-side to check for collision

   131         // in order to find out if the hog can still be moved by gravity

   132         if ropeDx.isNegative = RopeDy.IsNegative then

   133             cd:= -1

   134         else

   135             cd:= 1;

   136 

   137         // apply gravity if there is no obstacle

   138         if not TestCollisionXwithGear(HHGear, cd) then

   139             HHGear^.dY := HHGear^.dY + cGravity;

   140 

   141         if (GameFlags and gfMoreWind) <> 0 then

   142             // apply wind if there's no obstacle

   143             if not TestCollisionXwithGear(HHGear, hwSign(cWindSpeed)) then

   144                 HHGear^.dX := HHGear^.dX + cWindSpeed / HHGear^.Density;

   145         end;

   146 

   147     mdX := ropeDx + HHGear^.dX;

   148     mdY := ropeDy + HHGear^.dY;

   149     len := _1 / Distance(mdX, mdY);

   150     // rope vector plus hedgehog direction vector normalized

   151     mdX := mdX * len;

   152     mdY := mdY * len;

   153 

   154     // for visual purposes only

   155     Gear^.dX := mdX;

   156     Gear^.dY := mdY;

   157 

   158     /////

   159     tx := HHGear^.X;

   160     ty := HHGear^.Y;

   161 

   162     if ((Gear^.Message and gmDown) <> 0) and (Gear^.Elasticity < Gear^.Friction) then

   163         if not (TestCollisionXwithGear(HHGear, hwSign(ropeDx))

   164         or (TestCollisionYwithGear(HHGear, hwSign(ropeDy)) <> 0)) then

   165             Gear^.Elasticity := Gear^.Elasticity + _0_3;

   166 

   167     if ((Gear^.Message and gmUp) <> 0) and (Gear^.Elasticity > _30) then

   168         if not (TestCollisionXwithGear(HHGear, -hwSign(ropeDx))

   169         or (TestCollisionYwithGear(HHGear, -hwSign(ropeDy)) <> 0)) then

   170             Gear^.Elasticity := Gear^.Elasticity - _0_3;

   171 

   172     HHGear^.X := Gear^.X + mdX * Gear^.Elasticity;

   173     HHGear^.Y := Gear^.Y + mdY * Gear^.Elasticity;

   174 

   175     HHGear^.dX := HHGear^.X - tx;

   176     HHGear^.dY := HHGear^.Y - ty;

   177     ////

   178 

   179 

   180     haveDivided := false;

   181     // check whether rope needs dividing

   182 

   183     len := Gear^.Elasticity - _5;

   184     nx := Gear^.X + mdX * len;

   185     ny := Gear^.Y + mdY * len;

   186     tx := mdX * _0_3; // should be the same as increase step

   187     ty := mdY * _0_3;

   188 

   189     while len > _3 do

   190         begin

   191         lx := hwRound(nx);

   192         ly := hwRound(ny);

   193         if ((ly and LAND_HEIGHT_MASK) = 0) and ((lx and LAND_WIDTH_MASK) = 0) and ((Land[ly, lx] and $FF00) <> 0) then

   194             begin

   195             ny := _1 / Distance(ropeDx, ropeDy);

   196             // old rope pos

   197             nx := ropeDx * ny;

   198             ny := ropeDy * ny;

   199 

   200             with RopePoints.ar[RopePoints.Count] do

   201                 begin

   202                 X := Gear^.X;

   203                 Y := Gear^.Y;

   204                 if RopePoints.Count = 0 then

   205                     RopePoints.HookAngle := DxDy2Angle(Gear^.dY, Gear^.dX);

   206                 b := (nx * HHGear^.dY) > (ny * HHGear^.dX);

   207                 dLen := len

   208                 end;

   209                 

   210             with RopePoints.rounded[RopePoints.Count] do

   211                 begin

   212                 X := hwRound(Gear^.X);

   213                 Y := hwRound(Gear^.Y);

   214                 end;

   215 

   216             Gear^.X := Gear^.X + nx * len;

   217             Gear^.Y := Gear^.Y + ny * len;

   218             inc(RopePoints.Count);

   219             TryDo(RopePoints.Count <= MAXROPEPOINTS, 'Rope points overflow', true);

   220             Gear^.Elasticity := Gear^.Elasticity - len;

   221             Gear^.Friction := Gear^.Friction - len;

   222             haveDivided := true;

   223             break

   224             end;

   225         nx := nx - tx;

   226         ny := ny - ty;

   227 

   228         // len := len - _0_3 // should be the same as increase step

   229         len.QWordValue := len.QWordValue - _0_3.QWordValue;

   230         end;

   231 

   232     if not haveDivided then

   233         if RopePoints.Count > 0 then // check whether the last dividing point could be removed

   234             begin

   235             tx := RopePoints.ar[Pred(RopePoints.Count)].X;

   236             ty := RopePoints.ar[Pred(RopePoints.Count)].Y;

   237             mdX := tx - Gear^.X;

   238             mdY := ty - Gear^.Y;

   239             if RopePoints.ar[Pred(RopePoints.Count)].b xor (mdX * (ty - HHGear^.Y) > (tx - HHGear^.X) * mdY) then

   240                 begin

   241                 dec(RopePoints.Count);

   242                 Gear^.X := RopePoints.ar[RopePoints.Count].X;

   243                 Gear^.Y := RopePoints.ar[RopePoints.Count].Y;

   244                 Gear^.Elasticity := Gear^.Elasticity + RopePoints.ar[RopePoints.Count].dLen;

   245                 Gear^.Friction := Gear^.Friction + RopePoints.ar[RopePoints.Count].dLen;

   246 

   247                 // restore hog position

   248                 len := _1 / Distance(mdX, mdY);

   249                 mdX := mdX * len;

   250                 mdY := mdY * len;

   251 

   252                 HHGear^.X := Gear^.X - mdX * Gear^.Elasticity;

   253                 HHGear^.Y := Gear^.Y - mdY * Gear^.Elasticity;

   254                 end

   255             end;

   256 

   257     haveCollision := false;

   258     if TestCollisionXwithGear(HHGear, hwSign(HHGear^.dX)) then

   259         begin

   260         HHGear^.dX := -_0_6 * HHGear^.dX;

   261         haveCollision := true

   262         end;

   263     if TestCollisionYwithGear(HHGear, hwSign(HHGear^.dY)) <> 0 then

   264         begin

   265         HHGear^.dY := -_0_6 * HHGear^.dY;

   266         haveCollision := true

   267         end;

   268 

   269     if haveCollision and (Gear^.Message and (gmLeft or gmRight) <> 0) and (Gear^.Message and (gmUp or gmDown) <> 0) then

   270         begin

   271         HHGear^.dX := SignAs(hwAbs(HHGear^.dX) + _0_2, HHGear^.dX);

   272         HHGear^.dY := SignAs(hwAbs(HHGear^.dY) + _0_2, HHGear^.dY)

   273         end;

   274 

   275     len := hwSqr(HHGear^.dX) + hwSqr(HHGear^.dY);

   276     if len > _0_64 then

   277         begin

   278         len := _0_8 / hwSqrt(len);

   279         HHGear^.dX := HHGear^.dX * len;

   280         HHGear^.dY := HHGear^.dY * len;

   281         end;

   282 

   283     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);

   284 

   285     if not haveCollision then

   286         begin

   287         // backup gear location

   288         tx:= Gear^.X;

   289         ty:= Gear^.Y;

   290 

   291         if RopePoints.Count > 0 then

   292             begin

   293             // set gear location to the remote end of the rope, the attachment point

   294             Gear^.X:= RopePoints.ar[0].X;

   295             Gear^.Y:= RopePoints.ar[0].Y;

   296             end;

   297 

   298         CheckCollision(Gear);

   299         // if we haven't found any collision yet then check the other side too

   300         if (Gear^.State and gstCollision) = 0 then

   301             begin

   302             Gear^.dX.isNegative:= not Gear^.dX.isNegative;

   303             Gear^.dY.isNegative:= not Gear^.dY.isNegative;

   304             CheckCollision(Gear);

   305             Gear^.dX.isNegative:= not Gear^.dX.isNegative;

   306             Gear^.dY.isNegative:= not Gear^.dY.isNegative;

   307             end;

   308 

   309         haveCollision:= (Gear^.State and gstCollision) <> 0;

   310 

   311         // restore gear location

   312         Gear^.X:= tx;

   313         Gear^.Y:= ty;

   314         end;

   315 

   316     // if the attack key is pressed, lose rope contact as well

   317     if (Gear^.Message and gmAttack) <> 0 then

   318         haveCollision:= false;

   319 

   320     if not haveCollision then

   321         begin

   322         if (Gear^.State and gsttmpFlag) <> 0 then

   323             begin

   324             PlaySound(sndRopeRelease);

   325             if Gear^.Hedgehog^.CurAmmoType <> amParachute then

   326                 RopeWaitCollision(Gear, HHGear)

   327             else

   328                 RopeDeleteMe(Gear, HHGear)

   329             end

   330         end

   331     else

   332         if (Gear^.State and gsttmpFlag) = 0 then

   333             Gear^.State := Gear^.State or gsttmpFlag;

   334 end;

   335 

   336 procedure RopeRemoveFromAmmo(Gear, HHGear: PGear);

   337 begin

   338     if (Gear^.State and gstAttacked) = 0 then

   339         begin

   340         OnUsedAmmo(HHGear^.Hedgehog^);

   341         Gear^.State := Gear^.State or gstAttacked

   342         end;

   343     ApplyAmmoChanges(HHGear^.Hedgehog^)

   344 end;

   345 

   346 procedure doStepRopeAttach(Gear: PGear);

   347 var 

   348     HHGear: PGear;

   349     tx, ty, tt: hwFloat;

   350 begin

   351     Gear^.X := Gear^.X - Gear^.dX;

   352     Gear^.Y := Gear^.Y - Gear^.dY;

   353     Gear^.Elasticity := Gear^.Elasticity + _1;

   354 

   355     HHGear := Gear^.Hedgehog^.Gear;

   356     DeleteCI(HHGear);

   357 

   358     if (HHGear^.State and gstMoving) <> 0 then

   359         begin

   360         if TestCollisionXwithGear(HHGear, hwSign(HHGear^.dX)) then

   361             SetLittle(HHGear^.dX);

   362         if HHGear^.dY.isNegative and (TestCollisionYwithGear(HHGear, -1) <> 0) then

   363             HHGear^.dY := _0;

   364 

   365         HHGear^.X := HHGear^.X + HHGear^.dX;

   366         Gear^.X := Gear^.X + HHGear^.dX;

   367 

   368         if TestCollisionYwithGear(HHGear, 1) <> 0 then

   369             begin

   370             CheckHHDamage(HHGear);

   371             HHGear^.dY := _0

   372             //HHGear^.State:= HHGear^.State and (not (gstHHJumping or gstHHHJump));

   373             end

   374         else

   375             begin

   376             HHGear^.Y := HHGear^.Y + HHGear^.dY;

   377             Gear^.Y := Gear^.Y + HHGear^.dY;

   378             HHGear^.dY := HHGear^.dY + cGravity;

   379             if (GameFlags and gfMoreWind) <> 0 then

   380                 HHGear^.dX := HHGear^.dX + cWindSpeed / HHGear^.Density

   381             end;

   382 

   383         tt := Gear^.Elasticity;

   384         tx := _0;

   385         ty := _0;

   386         while tt > _20 do

   387             begin

   388             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)] and $FF00) <> 0) then

   389                 begin

   390                 Gear^.X := Gear^.X + tx;

   391                 Gear^.Y := Gear^.Y + ty;

   392                 Gear^.Elasticity := tt;

   393                 Gear^.doStep := @doStepRopeWork;

   394                 PlaySound(sndRopeAttach);

   395                 with HHGear^ do

   396                     begin

   397                     State := State and (not (gstAttacking or gstHHJumping or gstHHHJump));

   398                     Message := Message and (not gmAttack)

   399                     end;

   400 

   401                 RopeRemoveFromAmmo(Gear, HHGear);

   402 

   403                 tt := _0;

   404                 exit

   405                 end;

   406             tx := tx + Gear^.dX + Gear^.dX;

   407             ty := ty + Gear^.dY + Gear^.dY;

   408             tt := tt - _2;

   409             end;

   410         end;

   411 

   412     CheckCollision(Gear);

   413 

   414     if (Gear^.State and gstCollision) <> 0 then

   415         if Gear^.Elasticity < _10 then

   416             Gear^.Elasticity := _10000

   417     else

   418         begin

   419         Gear^.doStep := @doStepRopeWork;

   420         PlaySound(sndRopeAttach);

   421         with HHGear^ do

   422             begin

   423             State := State and (not (gstAttacking or gstHHJumping or gstHHHJump));

   424             Message := Message and (not gmAttack)

   425             end;

   426 

   427         RopeRemoveFromAmmo(Gear, HHGear);

   428 

   429         exit

   430         end;

   431 

   432     if (Gear^.Elasticity > Gear^.Friction)

   433         or ((Gear^.Message and gmAttack) = 0)

   434         or ((HHGear^.State and gstHHDriven) = 0)

   435         or (HHGear^.Damage > 0) then

   436             begin

   437             with Gear^.Hedgehog^.Gear^ do

   438                 begin

   439                 State := State and (not gstAttacking);

   440                 Message := Message and (not gmAttack)

   441                 end;

   442         DeleteGear(Gear);

   443         exit;

   444         end;

   445     if CheckGearDrowning(HHGear) then DeleteGear(Gear)

   446 end;

   447 

   448 procedure doStepRope(Gear: PGear);

   449 begin

   450     Gear^.dX := - Gear^.dX;

   451     Gear^.dY := - Gear^.dY;

   452     Gear^.doStep := @doStepRopeAttach;

   453     PlaySound(sndRopeShot)

   454 end;

   455 

   456 end.