hedgewars/uGearsHandlersRope.pas
changeset 7647 e496587db93e
parent 7612 047c6692a2e7
child 7648 796ff8debbbc
equal deleted inserted replaced
7646:3c18ad8af8a2 7647:e496587db93e
    71         Gear^.State := Gear^.State and (not gsttmpflag);
    71         Gear^.State := Gear^.State and (not gsttmpflag);
    72         Gear^.doStep := @doStepRope;
    72         Gear^.doStep := @doStepRope;
    73         end
    73         end
    74 end;
    74 end;
    75 
    75 
    76 procedure unstickHog(Gear, HHGear: PGear);
       
    77 var i: LongInt;
       
    78     stuck: Boolean;
       
    79 begin
       
    80     if (TestCollisionYwithGear(HHGear, 1) <> 0) and (TestCollisionYwithGear(HHGear, -1) = 0) then
       
    81         begin
       
    82         i:= 1;
       
    83         repeat
       
    84             begin
       
    85             inc(i);
       
    86             stuck:= TestCollisionYwithGear(HHGear, 1) <> 0;
       
    87             if stuck then HHGear^.Y:= HHGear^.Y-_1
       
    88             end
       
    89         until (i = 8) or (not stuck);
       
    90         HHGear^.Y:= HHGear^.Y+_1;
       
    91         // experiment in simulating something the shoppa players apparently expect
       
    92         if Gear^.Message and gmDown <> 0 then
       
    93             begin
       
    94             //HHGear^.dY:= HHGear^.dY / 16;
       
    95             //HHGear^.dY.QWordValue:= 0;
       
    96             HHGear^.dY:= -_0_1;
       
    97             HHGear^.dX:= HHGear^.dX * _1_5;
       
    98             end;
       
    99         if Gear^.Message and gmRight <> 0 then
       
   100             HHGear^.dX.isNegative:= false
       
   101         else if Gear^.Message and gmLeft <> 0 then
       
   102             HHGear^.dX.isNegative:= true
       
   103         end
       
   104     else if (TestCollisionYwithGear(HHGear, -1) <> 0) and (TestCollisionYwithGear(HHGear, 1) = 0) then
       
   105         begin
       
   106         i:= 1;
       
   107         repeat
       
   108             begin
       
   109             inc(i);
       
   110             stuck:= TestCollisionYwithGear(HHGear, -1) <> 0;
       
   111             if stuck then HHGear^.Y:= HHGear^.Y+_1
       
   112             end
       
   113         until (i = 8) or (not stuck);
       
   114         HHGear^.Y:= HHGear^.Y-_1;
       
   115         if Gear^.Message and gmDown <> 0 then
       
   116             begin
       
   117             //HHGear^.dY:= HHGear^.dY / 16;
       
   118             //HHGear^.dY.QWordValue:= 0;
       
   119             HHGear^.dY:= _0_1;
       
   120             HHGear^.dX:= HHGear^.dX * _1_5;
       
   121             end;
       
   122         if Gear^.Message and gmRight <> 0 then
       
   123             HHGear^.dX.isNegative:= true
       
   124         else if Gear^.Message and gmLeft <> 0 then
       
   125             HHGear^.dX.isNegative:= false
       
   126         end;
       
   127     if TestCollisionXwithGear(HHGear, 1) and (not TestCollisionXwithGear(HHGear, -1)) then
       
   128         begin
       
   129         i:= 1;
       
   130         repeat
       
   131             begin
       
   132             inc(i);
       
   133             stuck:= TestCollisionXwithGear(HHGear, 1);
       
   134             if stuck then HHGear^.X:= HHGear^.X-_1
       
   135             end
       
   136         until (i = 8) or (not stuck);
       
   137         HHGear^.X:= HHGear^.X+_1;
       
   138         if Gear^.Message and gmDown <> 0 then
       
   139             begin
       
   140             //HHGear^.dX:= HHGear^.dX / 16;
       
   141             //HHGear^.dX.QWordValue:= 0;
       
   142             HHGear^.dX:= -_0_1;
       
   143             HHGear^.dY:= HHGear^.dY * _1_5;
       
   144             end;
       
   145         if Gear^.Message and gmRight <> 0 then
       
   146             HHGear^.dY.isNegative:= true
       
   147         else if Gear^.Message and gmLeft <> 0 then
       
   148             HHGear^.dY.isNegative:= false
       
   149         end
       
   150     else if TestCollisionXwithGear(HHGear, -1) and (not TestCollisionXwithGear(HHGear, 1)) then
       
   151         begin
       
   152         i:= 1;
       
   153         repeat
       
   154             begin
       
   155             inc(i);
       
   156             stuck:= TestCollisionXwithGear(HHGear, -1);
       
   157             if stuck then HHGear^.X:= HHGear^.X+_1
       
   158             end
       
   159         until (i = 8) or (not stuck);
       
   160         HHGear^.X:= HHGear^.X-_1;
       
   161         if Gear^.Message and gmDown <> 0 then
       
   162             begin
       
   163             //HHGear^.dX:= HHGear^.dX / 16;
       
   164             //HHGear^.dX.QWordValue:= 0;
       
   165             HHGear^.dX:= _0_1;
       
   166             HHGear^.dY:= HHGear^.dY * _1_5;
       
   167             end;
       
   168         if Gear^.Message and gmRight <> 0 then
       
   169             HHGear^.dY.isNegative:= false
       
   170         else if Gear^.Message and gmLeft <> 0 then
       
   171             HHGear^.dY.isNegative:= true
       
   172         end
       
   173 end;
       
   174 
       
   175 procedure RopeDeleteMe(Gear, HHGear: PGear);
    76 procedure RopeDeleteMe(Gear, HHGear: PGear);
   176 begin
    77 begin
   177     PlaySound(sndRopeRelease);
       
   178     HHGear^.dX.QWordValue:= HHGear^.dX.QWordValue div Gear^.stepFreq;
       
   179     HHGear^.dY.QWordValue:= HHGear^.dY.QWordValue div Gear^.stepFreq;
       
   180     with HHGear^ do
    78     with HHGear^ do
   181         begin
    79         begin
   182         Message := Message and (not gmAttack);
    80         Message := Message and (not gmAttack);
   183         State := (State or gstMoving) and (not gstWinner);
    81         State := (State or gstMoving) and (not gstWinner);
   184         end;
    82         end;
   185     unstickHog(Gear, HHGear);
       
   186     DeleteGear(Gear)
    83     DeleteGear(Gear)
   187 end;
    84 end;
   188 
    85 
   189 procedure RopeWaitCollision(Gear, HHGear: PGear);
    86 procedure RopeWaitCollision(Gear, HHGear: PGear);
   190 begin
    87 begin
   191     PlaySound(sndRopeRelease);
       
   192     with HHGear^ do
    88     with HHGear^ do
   193         begin
    89         begin
   194         Message := Message and (not gmAttack);
    90         Message := Message and (not gmAttack);
   195         State := State or gstMoving;
    91         State := State or gstMoving;
   196         end;
    92         end;
   197     unstickHog(Gear, HHGear);
       
   198     RopePoints.Count := 0;
    93     RopePoints.Count := 0;
   199     Gear^.Elasticity := _0;
    94     Gear^.Elasticity := _0;
   200     Gear^.doStep := @doStepRopeAfterAttack;
    95     Gear^.doStep := @doStepRopeAfterAttack
   201     HHGear^.dX.QWordValue:= HHGear^.dX.QWordValue div Gear^.stepFreq;
       
   202     HHGear^.dY.QWordValue:= HHGear^.dY.QWordValue div Gear^.stepFreq;
       
   203     Gear^.stepFreq := 1
       
   204 end;
    96 end;
   205 
    97 
   206 procedure doStepRopeWork(Gear: PGear);
    98 procedure doStepRopeWork(Gear: PGear);
   207 var 
    99 var 
   208     HHGear: PGear;
   100     HHGear: PGear;
   209     len, tx, ty, nx, ny, ropeDx, ropeDy, mdX, mdY, t: hwFloat;
   101     len, tx, ty, nx, ny, ropeDx, ropeDy, mdX, mdY, sDx, sDy: hwFloat;
   210     lx, ly, cd, i: LongInt;
   102     i, lx, ly, cd: LongInt;
   211     haveCollision,
   103     haveCollision,
   212     haveDivided: boolean;
   104     haveDivided: boolean;
   213 
   105 
   214 begin
   106 begin
   215     if GameTicks mod 8 <> 0 then exit;
   107     if GameTicks mod 8 <> 0 then exit;
   216 
   108 
   217     HHGear := Gear^.Hedgehog^.Gear;
   109     HHGear := Gear^.Hedgehog^.Gear;
   218     haveCollision:= false;
   110 
   219     if (Gear^.Message and gmLeft  <> 0) and (not TestCollisionXwithGear(HHGear, -1)) then
   111     HHGear^.dX.QWordValue:= HHGear^.dX.QWordValue shl 3;
   220         HHGear^.dX := HHGear^.dX - _0_0128
   112     HHGear^.dY.QWordValue:= HHGear^.dY.QWordValue shl 3;
   221     else haveCollision:= true;
       
   222 
       
   223     if (Gear^.Message and gmRight <> 0) and (not TestCollisionXwithGear(HHGear,  1)) then
       
   224         HHGear^.dX := HHGear^.dX + _0_0128
       
   225     else haveCollision:= true;
       
   226 
       
   227 
   113 
   228     if ((HHGear^.State and gstHHDriven) = 0)
   114     if ((HHGear^.State and gstHHDriven) = 0)
   229        or (CheckGearDrowning(HHGear)) or (Gear^.PortalCounter <> 0) then
   115        or (CheckGearDrowning(HHGear)) or (Gear^.PortalCounter <> 0) then
   230         begin
   116         begin
       
   117         PlaySound(sndRopeRelease);
   231         RopeDeleteMe(Gear, HHGear);
   118         RopeDeleteMe(Gear, HHGear);
   232         exit
   119         exit
   233         end;
   120         end;
       
   121 
       
   122     if (Gear^.Message and gmLeft  <> 0) and (not TestCollisionXwithGear(HHGear, -1)) then
       
   123         HHGear^.dX := HHGear^.dX - _0_0128;
       
   124 
       
   125     if (Gear^.Message and gmRight <> 0) and (not TestCollisionXwithGear(HHGear,  1)) then
       
   126         HHGear^.dX := HHGear^.dX + _0_0128;
   234 
   127 
   235     // vector between hedgehog and rope attaching point
   128     // vector between hedgehog and rope attaching point
   236     ropeDx := HHGear^.X - Gear^.X;
   129     ropeDx := HHGear^.X - Gear^.X;
   237     ropeDy := HHGear^.Y - Gear^.Y;
   130     ropeDy := HHGear^.Y - Gear^.Y;
   238 
   131 
   252 
   145 
   253         if (GameFlags and gfMoreWind) <> 0 then
   146         if (GameFlags and gfMoreWind) <> 0 then
   254             // apply wind if there's no obstacle
   147             // apply wind if there's no obstacle
   255             if not TestCollisionXwithGear(HHGear, hwSign(cWindSpeed)) then
   148             if not TestCollisionXwithGear(HHGear, hwSign(cWindSpeed)) then
   256                 HHGear^.dX := HHGear^.dX + cWindSpeed * 64 / HHGear^.Density;
   149                 HHGear^.dX := HHGear^.dX + cWindSpeed * 64 / HHGear^.Density;
   257         end
   150         end;
   258     else haveCollision:= true;
       
   259 
       
   260     if ((Gear^.Message and gmDown) <> 0) and (Gear^.Elasticity < Gear^.Friction) then
       
   261         if not (TestCollisionXwithGear(HHGear, hwSign(ropeDx))
       
   262         or (TestCollisionYwithGear(HHGear, hwSign(ropeDy)) <> 0)) then
       
   263             Gear^.Elasticity := Gear^.Elasticity + _2_4
       
   264     else haveCollision:= true;
       
   265 
       
   266     if ((Gear^.Message and gmUp) <> 0) and (Gear^.Elasticity > _30) then
       
   267         if not (TestCollisionXwithGear(HHGear, -hwSign(ropeDx))
       
   268         or (TestCollisionYwithGear(HHGear, -hwSign(ropeDy)) <> 0)) then
       
   269             Gear^.Elasticity := Gear^.Elasticity - _2_4
       
   270     else haveCollision:= true;
       
   271 
       
   272 (*
       
   273 I am not so sure this is useful. Disabling
       
   274     if haveCollision then
       
   275         begin
       
   276         if TestCollisionXwithGear(HHGear, hwSign(HHGear^.dX)) and not TestCollisionXwithGear(HHGear, hwSign(HHGear^.dX)) then
       
   277             HHGear^.dX.isNegative:= not HHGear^.dX.isNegative;
       
   278         if (TestCollisionYwithGear(HHGear, hwSign(HHGear^.dY)) <> 0) and (TestCollisionYwithGear(HHGear, -hwSign(HHGear^.dY)) = 0) then
       
   279             HHGear^.dY.isNegative:= not HHGear^.dY.isNegative;
       
   280         end;
       
   281 *)
       
   282 
   151 
   283     mdX := ropeDx + HHGear^.dX;
   152     mdX := ropeDx + HHGear^.dX;
   284     mdY := ropeDy + HHGear^.dY;
   153     mdY := ropeDy + HHGear^.dY;
   285     len := _1 / Distance(mdX, mdY);
   154     len := _1 / Distance(mdX, mdY);
   286     // rope vector plus hedgehog direction vector normalized
   155     // rope vector plus hedgehog direction vector normalized
   293 
   162 
   294     /////
   163     /////
   295     tx := HHGear^.X;
   164     tx := HHGear^.X;
   296     ty := HHGear^.Y;
   165     ty := HHGear^.Y;
   297 
   166 
       
   167     if ((Gear^.Message and gmDown) <> 0) and (Gear^.Elasticity < Gear^.Friction) then
       
   168         if not (TestCollisionXwithGear(HHGear, hwSign(ropeDx))
       
   169         or (TestCollisionYwithGear(HHGear, hwSign(ropeDy)) <> 0)) then
       
   170             Gear^.Elasticity := Gear^.Elasticity + _2_4;
       
   171 
       
   172     if ((Gear^.Message and gmUp) <> 0) and (Gear^.Elasticity > _30) then
       
   173         if not (TestCollisionXwithGear(HHGear, -hwSign(ropeDx))
       
   174         or (TestCollisionYwithGear(HHGear, -hwSign(ropeDy)) <> 0)) then
       
   175             Gear^.Elasticity := Gear^.Elasticity - _2_4;
       
   176 
   298     HHGear^.X := Gear^.X + mdX * Gear^.Elasticity;
   177     HHGear^.X := Gear^.X + mdX * Gear^.Elasticity;
   299     HHGear^.Y := Gear^.Y + mdY * Gear^.Elasticity;
   178     HHGear^.Y := Gear^.Y + mdY * Gear^.Elasticity;
   300 
   179 
   301     HHGear^.dX := HHGear^.X - tx;
   180     HHGear^.dX := Gear^.X + mdX * Gear^.Elasticity - tx;
   302     HHGear^.dY := HHGear^.Y - ty;
   181     HHGear^.dY := Gear^.Y + mdY * Gear^.Elasticity - ty;
       
   182 
       
   183     sDx:= HHGear^.dX / 8;
       
   184     sDy:= HHGear^.dY / 8;
       
   185 
       
   186     HHGear^.X:= tx;
       
   187     HHGear^.Y:= ty;
       
   188 
       
   189     i:= 0;
       
   190     while not ((i = 8)
       
   191         or TestCollisionXwithGear(HHGear, hwSign(HHGear^.dX))
       
   192         or (TestCollisionYwithGear(HHGear, hwSign(HHGear^.dY)) <> 0)) do
       
   193         begin
       
   194         inc(i);
       
   195         HHGear^.X:= HHGear^.X + sDx;
       
   196         HHGear^.Y:= HHGear^.Y + sDy;
       
   197         end;
   303     ////
   198     ////
   304 
   199 
   305 
   200 
   306     haveDivided := false;
   201     haveDivided := false;
   307     // check whether rope needs dividing
   202     // check whether rope needs dividing
   445 
   340 
   446     if not haveCollision then
   341     if not haveCollision then
   447         begin
   342         begin
   448         if (Gear^.State and gsttmpFlag) <> 0 then
   343         if (Gear^.State and gsttmpFlag) <> 0 then
   449             begin
   344             begin
       
   345             PlaySound(sndRopeRelease);
   450             if Gear^.Hedgehog^.CurAmmoType <> amParachute then
   346             if Gear^.Hedgehog^.CurAmmoType <> amParachute then
   451                 RopeWaitCollision(Gear, HHGear)
   347                 RopeWaitCollision(Gear, HHGear)
   452             else
   348             else
   453                 RopeDeleteMe(Gear, HHGear)
   349                 RopeDeleteMe(Gear, HHGear)
   454             end
   350             end
   455         end
   351         end
   456     else
   352     else
   457         if (Gear^.State and gsttmpFlag) = 0 then
   353         if (Gear^.State and gsttmpFlag) = 0 then
   458             Gear^.State := Gear^.State or gsttmpFlag;
   354             Gear^.State := Gear^.State or gsttmpFlag;
       
   355 
       
   356     HHGear^.dX.QWordValue:= HHGear^.dX.QWordValue shr 3;
       
   357     HHGear^.dY.QWordValue:= HHGear^.dY.QWordValue shr 3;
   459 end;
   358 end;
   460 
   359 
   461 procedure RopeRemoveFromAmmo(Gear, HHGear: PGear);
   360 procedure RopeRemoveFromAmmo(Gear, HHGear: PGear);
   462 begin
   361 begin
   463     if (Gear^.State and gstAttacked) = 0 then
   362     if (Gear^.State and gstAttacked) = 0 then
   514                 begin
   413                 begin
   515                 Gear^.X := Gear^.X + tx;
   414                 Gear^.X := Gear^.X + tx;
   516                 Gear^.Y := Gear^.Y + ty;
   415                 Gear^.Y := Gear^.Y + ty;
   517                 Gear^.Elasticity := tt;
   416                 Gear^.Elasticity := tt;
   518                 Gear^.doStep := @doStepRopeWork;
   417                 Gear^.doStep := @doStepRopeWork;
   519                 Gear^.stepFreq:= 8;
       
   520                 PlaySound(sndRopeAttach);
   418                 PlaySound(sndRopeAttach);
   521                 with HHGear^ do
   419                 with HHGear^ do
   522                     begin
   420                     begin
   523                     dX.QWordValue:= dX.QWordValue shl 3;
       
   524                     dY.QWordValue:= dY.QWordValue shl 3;
       
   525                     State := State and (not (gstAttacking or gstHHJumping or gstHHHJump));
   421                     State := State and (not (gstAttacking or gstHHJumping or gstHHHJump));
   526                     Message := Message and (not gmAttack)
   422                     Message := Message and (not gmAttack)
   527                     end;
   423                     end;
   528 
   424 
   529                 RopeRemoveFromAmmo(Gear, HHGear);
   425                 RopeRemoveFromAmmo(Gear, HHGear);
   535             ty := ty + Gear^.dY + Gear^.dY;
   431             ty := ty + Gear^.dY + Gear^.dY;
   536             tt := tt - _2;
   432             tt := tt - _2;
   537             end;
   433             end;
   538         end;
   434         end;
   539 
   435 
   540     if Gear^.Elasticity < _20 then Gear^.CollisionMask:= $FF00
       
   541     else Gear^.CollisionMask:= $FF7F;
       
   542     CheckCollision(Gear);
   436     CheckCollision(Gear);
   543 
   437 
   544     if (Gear^.State and gstCollision) <> 0 then
   438     if (Gear^.State and gstCollision) <> 0 then
   545         if Gear^.Elasticity < _10 then
   439         if Gear^.Elasticity < _10 then
   546             Gear^.Elasticity := _10000
   440             Gear^.Elasticity := _10000
   547     else
   441     else
   548         begin
   442         begin
   549         Gear^.doStep := @doStepRopeWork;
   443         Gear^.doStep := @doStepRopeWork;
   550         Gear^.stepFreq:= 8;
       
   551         PlaySound(sndRopeAttach);
   444         PlaySound(sndRopeAttach);
   552         with HHGear^ do
   445         with HHGear^ do
   553             begin
   446             begin
   554             dX.QWordValue:= dX.QWordValue shl 3;
       
   555             dY.QWordValue:= dY.QWordValue shl 3;
       
   556             State := State and (not (gstAttacking or gstHHJumping or gstHHHJump));
   447             State := State and (not (gstAttacking or gstHHJumping or gstHHHJump));
   557             Message := Message and (not gmAttack)
   448             Message := Message and (not gmAttack)
   558             end;
   449             end;
   559 
   450 
   560         RopeRemoveFromAmmo(Gear, HHGear);
   451         RopeRemoveFromAmmo(Gear, HHGear);