hedgewars/GSHandlers.inc
changeset 7592 cf67e58313ea
parent 7589 63d937a764e2
child 7621 f0d739c34f2b
equal deleted inserted replaced
7591:d9ff60e0a390 7592:cf67e58313ea
   137     HH^.Gear^.State:= (HH^.Gear^.State and (not (gstHHDriven or gstInvisible or gstAttacking))) or gstAttacked;
   137     HH^.Gear^.State:= (HH^.Gear^.State and (not (gstHHDriven or gstInvisible or gstAttacking))) or gstAttacked;
   138     AddGearCI(HH^.Gear);
   138     AddGearCI(HH^.Gear);
   139     HH^.Gear^.Active:= true;
   139     HH^.Gear^.Active:= true;
   140     ScriptCall('onHogRestore', HH^.Gear^.Uid)
   140     ScriptCall('onHogRestore', HH^.Gear^.Uid)
   141 end;
   141 end;
   142 
       
   143 ////////////////////////////////////////////////////////////////////////////////
       
   144 procedure CheckCollision(Gear: PGear); inline;
       
   145 begin
       
   146     if TestCollisionXwithGear(Gear, hwSign(Gear^.dX))
       
   147     or (TestCollisionYwithGear(Gear, hwSign(Gear^.dY)) <> 0) then
       
   148         Gear^.State := Gear^.State or gstCollision
       
   149     else
       
   150         Gear^.State := Gear^.State and (not gstCollision)
       
   151 end;
       
   152 
       
   153 procedure CheckCollisionWithLand(Gear: PGear); inline;
       
   154 begin
       
   155     if TestCollisionX(Gear, hwSign(Gear^.dX))
       
   156     or TestCollisionY(Gear, hwSign(Gear^.dY)) then
       
   157         Gear^.State := Gear^.State or gstCollision
       
   158     else 
       
   159         Gear^.State := Gear^.State and (not gstCollision)
       
   160 end;
       
   161 
       
   162 
       
   163 ////////////////////////////////////////////////////////////////////////////////
       
   164 
   142 
   165 
   143 
   166 ////////////////////////////////////////////////////////////////////////////////
   144 ////////////////////////////////////////////////////////////////////////////////
   167 procedure doStepDrowningGear(Gear: PGear);
   145 procedure doStepDrowningGear(Gear: PGear);
   168     begin
   146     begin
  1404     HHGear^.State := HHGear^.State or gstNotKickable;
  1382     HHGear^.State := HHGear^.State or gstNotKickable;
  1405     Gear^.doStep := @doStepBlowTorchWork
  1383     Gear^.doStep := @doStepBlowTorchWork
  1406 end;
  1384 end;
  1407 
  1385 
  1408 ////////////////////////////////////////////////////////////////////////////////
  1386 ////////////////////////////////////////////////////////////////////////////////
  1409 
       
  1410 procedure doStepRope(Gear: PGear);
       
  1411 forward;
       
  1412 
       
  1413 procedure doStepRopeAfterAttack(Gear: PGear);
       
  1414 var 
       
  1415     HHGear: PGear;
       
  1416 begin
       
  1417     HHGear := Gear^.Hedgehog^.Gear;
       
  1418     if ((HHGear^.State and gstHHDriven) = 0)
       
  1419     or (CheckGearDrowning(HHGear))
       
  1420     or (TestCollisionYwithGear(HHGear, 1) <> 0) then
       
  1421         begin
       
  1422         DeleteGear(Gear);
       
  1423         isCursorVisible := false;
       
  1424         ApplyAmmoChanges(HHGear^.Hedgehog^);
       
  1425         exit
       
  1426         end;
       
  1427 
       
  1428     HedgehogChAngle(HHGear);
       
  1429 
       
  1430     if TestCollisionXwithGear(HHGear, hwSign(HHGear^.dX)) then
       
  1431         SetLittle(HHGear^.dX);
       
  1432 
       
  1433     if HHGear^.dY.isNegative and (TestCollisionYwithGear(HHGear, -1) <> 0) then
       
  1434         HHGear^.dY := _0;
       
  1435     HHGear^.X := HHGear^.X + HHGear^.dX;
       
  1436     HHGear^.Y := HHGear^.Y + HHGear^.dY;
       
  1437     HHGear^.dY := HHGear^.dY + cGravity;
       
  1438     
       
  1439     if (GameFlags and gfMoreWind) <> 0 then
       
  1440         HHGear^.dX := HHGear^.dX + cWindSpeed / HHGear^.Density;
       
  1441 
       
  1442     if (Gear^.Message and gmAttack) <> 0 then
       
  1443         begin
       
  1444         Gear^.X := HHGear^.X;
       
  1445         Gear^.Y := HHGear^.Y;
       
  1446 
       
  1447         ApplyAngleBounds(Gear^.Hedgehog^, amRope);
       
  1448 
       
  1449         Gear^.dX := SignAs(AngleSin(HHGear^.Angle), HHGear^.dX);
       
  1450         Gear^.dY := -AngleCos(HHGear^.Angle);
       
  1451         Gear^.Friction := _4_5 * cRopePercent;
       
  1452         Gear^.Elasticity := _0;
       
  1453         Gear^.State := Gear^.State and (not gsttmpflag);
       
  1454         Gear^.doStep := @doStepRope;
       
  1455         end
       
  1456 end;
       
  1457 
       
  1458 procedure RopeDeleteMe(Gear, HHGear: PGear);
       
  1459 begin
       
  1460     with HHGear^ do
       
  1461         begin
       
  1462         Message := Message and (not gmAttack);
       
  1463         State := (State or gstMoving) and (not gstWinner);
       
  1464         end;
       
  1465     DeleteGear(Gear)
       
  1466 end;
       
  1467 
       
  1468 procedure RopeWaitCollision(Gear, HHGear: PGear);
       
  1469 begin
       
  1470     with HHGear^ do
       
  1471         begin
       
  1472         Message := Message and (not gmAttack);
       
  1473         State := State or gstMoving;
       
  1474         end;
       
  1475     RopePoints.Count := 0;
       
  1476     Gear^.Elasticity := _0;
       
  1477     Gear^.doStep := @doStepRopeAfterAttack
       
  1478 end;
       
  1479 
       
  1480 procedure doStepRopeWork(Gear: PGear);
       
  1481 var 
       
  1482     HHGear: PGear;
       
  1483     len, tx, ty, nx, ny, ropeDx, ropeDy, mdX, mdY: hwFloat;
       
  1484     lx, ly, cd: LongInt;
       
  1485     haveCollision,
       
  1486     haveDivided: boolean;
       
  1487 
       
  1488 begin
       
  1489     HHGear := Gear^.Hedgehog^.Gear;
       
  1490 
       
  1491     if ((HHGear^.State and gstHHDriven) = 0)
       
  1492        or (CheckGearDrowning(HHGear)) or (Gear^.PortalCounter <> 0) then
       
  1493         begin
       
  1494         PlaySound(sndRopeRelease);
       
  1495         RopeDeleteMe(Gear, HHGear);
       
  1496         exit
       
  1497         end;
       
  1498 
       
  1499     if (Gear^.Message and gmLeft  <> 0) and (not TestCollisionXwithGear(HHGear, -1)) then
       
  1500         HHGear^.dX := HHGear^.dX - _0_0002;
       
  1501 
       
  1502     if (Gear^.Message and gmRight <> 0) and (not TestCollisionXwithGear(HHGear,  1)) then
       
  1503         HHGear^.dX := HHGear^.dX + _0_0002;
       
  1504 
       
  1505     // vector between hedgehog and rope attaching point
       
  1506     ropeDx := HHGear^.X - Gear^.X;
       
  1507     ropeDy := HHGear^.Y - Gear^.Y;
       
  1508 
       
  1509     if TestCollisionYwithGear(HHGear, 1) = 0 then
       
  1510         begin
       
  1511 
       
  1512         // depending on the rope vector we know which X-side to check for collision
       
  1513         // in order to find out if the hog can still be moved by gravity
       
  1514         if ropeDx.isNegative = RopeDy.IsNegative then
       
  1515             cd:= -1
       
  1516         else
       
  1517             cd:= 1;
       
  1518 
       
  1519         // apply gravity if there is no obstacle
       
  1520         if not TestCollisionXwithGear(HHGear, cd) then
       
  1521             HHGear^.dY := HHGear^.dY + cGravity;
       
  1522 
       
  1523         if (GameFlags and gfMoreWind) <> 0 then
       
  1524             // apply wind if there's no obstacle
       
  1525             if not TestCollisionXwithGear(HHGear, hwSign(cWindSpeed)) then
       
  1526                 HHGear^.dX := HHGear^.dX + cWindSpeed / HHGear^.Density;
       
  1527         end;
       
  1528 
       
  1529     mdX := ropeDx + HHGear^.dX;
       
  1530     mdY := ropeDy + HHGear^.dY;
       
  1531     len := _1 / Distance(mdX, mdY);
       
  1532     // rope vector plus hedgehog direction vector normalized
       
  1533     mdX := mdX * len;
       
  1534     mdY := mdY * len;
       
  1535 
       
  1536     // for visual purposes only
       
  1537     Gear^.dX := mdX;
       
  1538     Gear^.dY := mdY;
       
  1539 
       
  1540     /////
       
  1541     tx := HHGear^.X;
       
  1542     ty := HHGear^.Y;
       
  1543 
       
  1544     if ((Gear^.Message and gmDown) <> 0) and (Gear^.Elasticity < Gear^.Friction) then
       
  1545         if not (TestCollisionXwithGear(HHGear, hwSign(ropeDx))
       
  1546         or (TestCollisionYwithGear(HHGear, hwSign(ropeDy)) <> 0)) then
       
  1547             Gear^.Elasticity := Gear^.Elasticity + _0_3;
       
  1548 
       
  1549     if ((Gear^.Message and gmUp) <> 0) and (Gear^.Elasticity > _30) then
       
  1550         if not (TestCollisionXwithGear(HHGear, -hwSign(ropeDx))
       
  1551         or (TestCollisionYwithGear(HHGear, -hwSign(ropeDy)) <> 0)) then
       
  1552             Gear^.Elasticity := Gear^.Elasticity - _0_3;
       
  1553 
       
  1554     HHGear^.X := Gear^.X + mdX * Gear^.Elasticity;
       
  1555     HHGear^.Y := Gear^.Y + mdY * Gear^.Elasticity;
       
  1556 
       
  1557     HHGear^.dX := HHGear^.X - tx;
       
  1558     HHGear^.dY := HHGear^.Y - ty;
       
  1559     ////
       
  1560 
       
  1561 
       
  1562     haveDivided := false;
       
  1563     // check whether rope needs dividing
       
  1564 
       
  1565     len := Gear^.Elasticity - _5;
       
  1566     nx := Gear^.X + mdX * len;
       
  1567     ny := Gear^.Y + mdY * len;
       
  1568     tx := mdX * _0_3; // should be the same as increase step
       
  1569     ty := mdY * _0_3;
       
  1570 
       
  1571     while len > _3 do
       
  1572         begin
       
  1573         lx := hwRound(nx);
       
  1574         ly := hwRound(ny);
       
  1575         if ((ly and LAND_HEIGHT_MASK) = 0) and ((lx and LAND_WIDTH_MASK) = 0) and ((Land[ly, lx] and $FF00) <> 0) then
       
  1576             begin
       
  1577             ny := _1 / Distance(ropeDx, ropeDy);
       
  1578             // old rope pos
       
  1579             nx := ropeDx * ny;
       
  1580             ny := ropeDy * ny;
       
  1581 
       
  1582             with RopePoints.ar[RopePoints.Count] do
       
  1583                 begin
       
  1584                 X := Gear^.X;
       
  1585                 Y := Gear^.Y;
       
  1586                 if RopePoints.Count = 0 then
       
  1587                     RopePoints.HookAngle := DxDy2Angle(Gear^.dY, Gear^.dX);
       
  1588                 b := (nx * HHGear^.dY) > (ny * HHGear^.dX);
       
  1589                 dLen := len
       
  1590                 end;
       
  1591                 
       
  1592             with RopePoints.rounded[RopePoints.Count] do
       
  1593                 begin
       
  1594                 X := hwRound(Gear^.X);
       
  1595                 Y := hwRound(Gear^.Y);
       
  1596                 end;
       
  1597 
       
  1598             Gear^.X := Gear^.X + nx * len;
       
  1599             Gear^.Y := Gear^.Y + ny * len;
       
  1600             inc(RopePoints.Count);
       
  1601             TryDo(RopePoints.Count <= MAXROPEPOINTS, 'Rope points overflow', true);
       
  1602             Gear^.Elasticity := Gear^.Elasticity - len;
       
  1603             Gear^.Friction := Gear^.Friction - len;
       
  1604             haveDivided := true;
       
  1605             break
       
  1606             end;
       
  1607         nx := nx - tx;
       
  1608         ny := ny - ty;
       
  1609 
       
  1610         // len := len - _0_3 // should be the same as increase step
       
  1611         len.QWordValue := len.QWordValue - _0_3.QWordValue;
       
  1612         end;
       
  1613 
       
  1614     if not haveDivided then
       
  1615         if RopePoints.Count > 0 then // check whether the last dividing point could be removed
       
  1616             begin
       
  1617             tx := RopePoints.ar[Pred(RopePoints.Count)].X;
       
  1618             ty := RopePoints.ar[Pred(RopePoints.Count)].Y;
       
  1619             mdX := tx - Gear^.X;
       
  1620             mdY := ty - Gear^.Y;
       
  1621             if RopePoints.ar[Pred(RopePoints.Count)].b xor (mdX * (ty - HHGear^.Y) > (tx - HHGear^.X) * mdY) then
       
  1622                 begin
       
  1623                 dec(RopePoints.Count);
       
  1624                 Gear^.X := RopePoints.ar[RopePoints.Count].X;
       
  1625                 Gear^.Y := RopePoints.ar[RopePoints.Count].Y;
       
  1626                 Gear^.Elasticity := Gear^.Elasticity + RopePoints.ar[RopePoints.Count].dLen;
       
  1627                 Gear^.Friction := Gear^.Friction + RopePoints.ar[RopePoints.Count].dLen;
       
  1628 
       
  1629                 // restore hog position
       
  1630                 len := _1 / Distance(mdX, mdY);
       
  1631                 mdX := mdX * len;
       
  1632                 mdY := mdY * len;
       
  1633 
       
  1634                 HHGear^.X := Gear^.X - mdX * Gear^.Elasticity;
       
  1635                 HHGear^.Y := Gear^.Y - mdY * Gear^.Elasticity;
       
  1636                 end
       
  1637             end;
       
  1638 
       
  1639     haveCollision := false;
       
  1640     if TestCollisionXwithGear(HHGear, hwSign(HHGear^.dX)) then
       
  1641         begin
       
  1642         HHGear^.dX := -_0_6 * HHGear^.dX;
       
  1643         haveCollision := true
       
  1644         end;
       
  1645     if TestCollisionYwithGear(HHGear, hwSign(HHGear^.dY)) <> 0 then
       
  1646         begin
       
  1647         HHGear^.dY := -_0_6 * HHGear^.dY;
       
  1648         haveCollision := true
       
  1649         end;
       
  1650 
       
  1651     if haveCollision and (Gear^.Message and (gmLeft or gmRight) <> 0) and (Gear^.Message and (gmUp or gmDown) <> 0) then
       
  1652         begin
       
  1653         HHGear^.dX := SignAs(hwAbs(HHGear^.dX) + _0_2, HHGear^.dX);
       
  1654         HHGear^.dY := SignAs(hwAbs(HHGear^.dY) + _0_2, HHGear^.dY)
       
  1655         end;
       
  1656 
       
  1657     len := hwSqr(HHGear^.dX) + hwSqr(HHGear^.dY);
       
  1658     if len > _0_64 then
       
  1659         begin
       
  1660         len := _0_8 / hwSqrt(len);
       
  1661         HHGear^.dX := HHGear^.dX * len;
       
  1662         HHGear^.dY := HHGear^.dY * len;
       
  1663         end;
       
  1664 
       
  1665     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);
       
  1666 
       
  1667     if not haveCollision then
       
  1668         begin
       
  1669         // backup gear location
       
  1670         tx:= Gear^.X;
       
  1671         ty:= Gear^.Y;
       
  1672 
       
  1673         if RopePoints.Count > 0 then
       
  1674             begin
       
  1675             // set gear location to the remote end of the rope, the attachment point
       
  1676             Gear^.X:= RopePoints.ar[0].X;
       
  1677             Gear^.Y:= RopePoints.ar[0].Y;
       
  1678             end;
       
  1679 
       
  1680         CheckCollision(Gear);
       
  1681         // if we haven't found any collision yet then check the other side too
       
  1682         if (Gear^.State and gstCollision) = 0 then
       
  1683             begin
       
  1684             Gear^.dX.isNegative:= not Gear^.dX.isNegative;
       
  1685             Gear^.dY.isNegative:= not Gear^.dY.isNegative;
       
  1686             CheckCollision(Gear);
       
  1687             Gear^.dX.isNegative:= not Gear^.dX.isNegative;
       
  1688             Gear^.dY.isNegative:= not Gear^.dY.isNegative;
       
  1689             end;
       
  1690 
       
  1691         haveCollision:= (Gear^.State and gstCollision) <> 0;
       
  1692 
       
  1693         // restore gear location
       
  1694         Gear^.X:= tx;
       
  1695         Gear^.Y:= ty;
       
  1696         end;
       
  1697 
       
  1698     // if the attack key is pressed, lose rope contact as well
       
  1699     if (Gear^.Message and gmAttack) <> 0 then
       
  1700         haveCollision:= false;
       
  1701 
       
  1702     if not haveCollision then
       
  1703         begin
       
  1704         if (Gear^.State and gsttmpFlag) <> 0 then
       
  1705             begin
       
  1706             PlaySound(sndRopeRelease);
       
  1707             if Gear^.Hedgehog^.CurAmmoType <> amParachute then
       
  1708                 RopeWaitCollision(Gear, HHGear)
       
  1709             else
       
  1710                 RopeDeleteMe(Gear, HHGear)
       
  1711             end
       
  1712         end
       
  1713     else
       
  1714         if (Gear^.State and gsttmpFlag) = 0 then
       
  1715             Gear^.State := Gear^.State or gsttmpFlag;
       
  1716 end;
       
  1717 
       
  1718 procedure RopeRemoveFromAmmo(Gear, HHGear: PGear);
       
  1719 begin
       
  1720     if (Gear^.State and gstAttacked) = 0 then
       
  1721         begin
       
  1722         OnUsedAmmo(HHGear^.Hedgehog^);
       
  1723         Gear^.State := Gear^.State or gstAttacked
       
  1724         end;
       
  1725     ApplyAmmoChanges(HHGear^.Hedgehog^)
       
  1726 end;
       
  1727 
       
  1728 procedure doStepRopeAttach(Gear: PGear);
       
  1729 var 
       
  1730     HHGear: PGear;
       
  1731     tx, ty, tt: hwFloat;
       
  1732 begin
       
  1733     Gear^.X := Gear^.X - Gear^.dX;
       
  1734     Gear^.Y := Gear^.Y - Gear^.dY;
       
  1735     Gear^.Elasticity := Gear^.Elasticity + _1;
       
  1736 
       
  1737     HHGear := Gear^.Hedgehog^.Gear;
       
  1738     DeleteCI(HHGear);
       
  1739 
       
  1740     if (HHGear^.State and gstMoving) <> 0 then
       
  1741         begin
       
  1742         if TestCollisionXwithGear(HHGear, hwSign(HHGear^.dX)) then
       
  1743             SetLittle(HHGear^.dX);
       
  1744         if HHGear^.dY.isNegative and (TestCollisionYwithGear(HHGear, -1) <> 0) then
       
  1745             HHGear^.dY := _0;
       
  1746 
       
  1747         HHGear^.X := HHGear^.X + HHGear^.dX;
       
  1748         Gear^.X := Gear^.X + HHGear^.dX;
       
  1749 
       
  1750         if TestCollisionYwithGear(HHGear, 1) <> 0 then
       
  1751             begin
       
  1752             CheckHHDamage(HHGear);
       
  1753             HHGear^.dY := _0
       
  1754             //HHGear^.State:= HHGear^.State and (not (gstHHJumping or gstHHHJump));
       
  1755             end
       
  1756         else
       
  1757             begin
       
  1758             HHGear^.Y := HHGear^.Y + HHGear^.dY;
       
  1759             Gear^.Y := Gear^.Y + HHGear^.dY;
       
  1760             HHGear^.dY := HHGear^.dY + cGravity;
       
  1761             if (GameFlags and gfMoreWind) <> 0 then
       
  1762                 HHGear^.dX := HHGear^.dX + cWindSpeed / HHGear^.Density
       
  1763             end;
       
  1764 
       
  1765         tt := Gear^.Elasticity;
       
  1766         tx := _0;
       
  1767         ty := _0;
       
  1768         while tt > _20 do
       
  1769             begin
       
  1770             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
       
  1771                 begin
       
  1772                 Gear^.X := Gear^.X + tx;
       
  1773                 Gear^.Y := Gear^.Y + ty;
       
  1774                 Gear^.Elasticity := tt;
       
  1775                 Gear^.doStep := @doStepRopeWork;
       
  1776                 PlaySound(sndRopeAttach);
       
  1777                 with HHGear^ do
       
  1778                     begin
       
  1779                     State := State and (not (gstAttacking or gstHHJumping or gstHHHJump));
       
  1780                     Message := Message and (not gmAttack)
       
  1781                     end;
       
  1782 
       
  1783                 RopeRemoveFromAmmo(Gear, HHGear);
       
  1784 
       
  1785                 tt := _0;
       
  1786                 exit
       
  1787                 end;
       
  1788             tx := tx + Gear^.dX + Gear^.dX;
       
  1789             ty := ty + Gear^.dY + Gear^.dY;
       
  1790             tt := tt - _2;
       
  1791             end;
       
  1792         end;
       
  1793 
       
  1794     CheckCollision(Gear);
       
  1795 
       
  1796     if (Gear^.State and gstCollision) <> 0 then
       
  1797         if Gear^.Elasticity < _10 then
       
  1798             Gear^.Elasticity := _10000
       
  1799     else
       
  1800         begin
       
  1801         Gear^.doStep := @doStepRopeWork;
       
  1802         PlaySound(sndRopeAttach);
       
  1803         with HHGear^ do
       
  1804             begin
       
  1805             State := State and (not (gstAttacking or gstHHJumping or gstHHHJump));
       
  1806             Message := Message and (not gmAttack)
       
  1807             end;
       
  1808 
       
  1809         RopeRemoveFromAmmo(Gear, HHGear);
       
  1810 
       
  1811         exit
       
  1812         end;
       
  1813 
       
  1814     if (Gear^.Elasticity > Gear^.Friction)
       
  1815         or ((Gear^.Message and gmAttack) = 0)
       
  1816         or ((HHGear^.State and gstHHDriven) = 0)
       
  1817         or (HHGear^.Damage > 0) then
       
  1818             begin
       
  1819             with Gear^.Hedgehog^.Gear^ do
       
  1820                 begin
       
  1821                 State := State and (not gstAttacking);
       
  1822                 Message := Message and (not gmAttack)
       
  1823                 end;
       
  1824         DeleteGear(Gear);
       
  1825         exit;
       
  1826         end;
       
  1827     if CheckGearDrowning(HHGear) then DeleteGear(Gear)
       
  1828 end;
       
  1829 
       
  1830 procedure doStepRope(Gear: PGear);
       
  1831 begin
       
  1832     Gear^.dX := - Gear^.dX;
       
  1833     Gear^.dY := - Gear^.dY;
       
  1834     Gear^.doStep := @doStepRopeAttach;
       
  1835     PlaySound(sndRopeShot)
       
  1836 end;
       
  1837 
       
  1838 ////////////////////////////////////////////////////////////////////////////////
       
  1839 procedure doStepMine(Gear: PGear);
  1387 procedure doStepMine(Gear: PGear);
  1840 var vg: PVisualGear;
  1388 var vg: PVisualGear;
  1841 begin
  1389 begin
  1842     if (Gear^.State and gstMoving) <> 0 then
  1390     if (Gear^.State and gstMoving) <> 0 then
  1843         begin
  1391         begin