hedgewars/uGears.pas
changeset 4385 f679ffa2dc8c
parent 4380 b78638b36b89
child 4387 3698361802ed
equal deleted inserted replaced
4384:615a3e7bd850 4385:f679ffa2dc8c
    18 
    18 
    19 {$INCLUDE "options.inc"}
    19 {$INCLUDE "options.inc"}
    20 
    20 
    21 unit uGears;
    21 unit uGears;
    22 interface
    22 interface
    23 uses SDLh, uConsts, uFloat, Math, uTypes;
    23 uses SDLh, uConsts, uFloat, uTypes;
    24 
    24 
    25 procedure initModule;
    25 procedure initModule;
    26 procedure freeModule;
    26 procedure freeModule;
    27 function  AddGear(X, Y: LongInt; Kind: TGearType; State: Longword; dX, dY: hwFloat; Timer: LongWord): PGear;
    27 function  AddGear(X, Y: LongInt; Kind: TGearType; State: Longword; dX, dY: hwFloat; Timer: LongWord): PGear;
    28 function SpawnCustomCrateAt(x, y: LongInt; crate: TCrateType; content: Longword ): PGear;
    28 function SpawnCustomCrateAt(x, y: LongInt; crate: TCrateType; content: Longword ): PGear;
    39 function  GearByUID(uid : Longword) : PGear;
    39 function  GearByUID(uid : Longword) : PGear;
    40 procedure InsertGearToList(Gear: PGear);
    40 procedure InsertGearToList(Gear: PGear);
    41 procedure RemoveGearFromList(Gear: PGear);
    41 procedure RemoveGearFromList(Gear: PGear);
    42 function  ModifyDamage(dmg: Longword; Gear: PGear): Longword;
    42 function  ModifyDamage(dmg: Longword; Gear: PGear): Longword;
    43 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt);
    43 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt);
    44 function  GetLaunchX(at: TAmmoType; dir: LongInt; angle: LongInt): LongInt;
    44 
    45 function  GetLaunchY(at: TAmmoType; angle: LongInt): LongInt;
       
    46 
    45 
    47 implementation
    46 implementation
    48 uses uWorld, uStore, uSound, uTeams, uRandom, uCollisions, uIO, uLandGraphics,
    47 uses uWorld, uStore, uSound, uTeams, uRandom, uCollisions, uIO, uLandGraphics,
    49      uAIMisc, uLocale, uAI, uAmmos, uStats, uVisualGears, uScript, GLunit, uMobile, uVariables,
    48      uAIMisc, uLocale, uAI, uAmmos, uStats, uVisualGears, uScript, GLunit, uMobile, uVariables,
    50      uCommands, uUtils, uTextures, uRender, uRenderUtils;
    49      uCommands, uUtils, uTextures, uRender, uRenderUtils, uGearsRender;
    51 
    50 
    52 const MAXROPEPOINTS = 384;
       
    53 var RopePoints: record
       
    54                 Count: Longword;
       
    55                 HookAngle: GLfloat;
       
    56                 ar: array[0..MAXROPEPOINTS] of record
       
    57                                   X, Y: hwFloat;
       
    58                                   dLen: hwFloat;
       
    59                                   b: boolean;
       
    60                                   end;
       
    61                 rounded: array[0..MAXROPEPOINTS + 2] of TVertex2f;
       
    62                 end;
       
    63 
    51 
    64 procedure DeleteGear(Gear: PGear); forward;
    52 procedure DeleteGear(Gear: PGear); forward;
    65 procedure doMakeExplosion(X, Y, Radius: LongInt; Mask: LongWord); forward;
    53 procedure doMakeExplosion(X, Y, Radius: LongInt; Mask: LongWord); forward;
    66 procedure doMakeExplosion(X, Y, Radius: LongInt; Mask, Tint: LongWord); forward;
    54 procedure doMakeExplosion(X, Y, Radius: LongInt; Mask, Tint: LongWord); forward;
    67 procedure AmmoShove(Ammo: PGear; Damage, Power: LongInt); forward;
    55 procedure AmmoShove(Ammo: PGear; Damage, Power: LongInt); forward;
    75 procedure HedgehogChAngle(Gear: PGear); forward;
    63 procedure HedgehogChAngle(Gear: PGear); forward;
    76 procedure ShotgunShot(Gear: PGear); forward;
    64 procedure ShotgunShot(Gear: PGear); forward;
    77 procedure PickUp(HH, Gear: PGear); forward;
    65 procedure PickUp(HH, Gear: PGear); forward;
    78 procedure HHSetWeapon(Gear: PGear); forward;
    66 procedure HHSetWeapon(Gear: PGear); forward;
    79 procedure doStepCase(Gear: PGear); forward;
    67 procedure doStepCase(Gear: PGear); forward;
    80 
       
    81 function GetLaunchX(at: TAmmoType; dir: LongInt; angle: LongInt): LongInt;
       
    82 begin
       
    83     if (Ammoz[at].ejectX <> 0) or (Ammoz[at].ejectY <> 0) then
       
    84         GetLaunchX:= sign(dir) * (8 + hwRound(AngleSin(angle) * Ammoz[at].ejectX) + hwRound(AngleCos(angle) * Ammoz[at].ejectY))
       
    85     else
       
    86         GetLaunchX:= 0
       
    87 end;
       
    88 
       
    89 function GetLaunchY(at: TAmmoType; angle: LongInt): LongInt;
       
    90 begin
       
    91     if (Ammoz[at].ejectX <> 0) or (Ammoz[at].ejectY <> 0) then
       
    92         GetLaunchY:= hwRound(AngleSin(angle) * Ammoz[at].ejectY) - hwRound(AngleCos(angle) * Ammoz[at].ejectX) - 2
       
    93     else
       
    94         GetLaunchY:= 0
       
    95 end;
       
    96 
    68 
    97 {$INCLUDE "GSHandlers.inc"}
    69 {$INCLUDE "GSHandlers.inc"}
    98 {$INCLUDE "HHHandlers.inc"}
    70 {$INCLUDE "HHHandlers.inc"}
    99 
    71 
   100 const doStepHandlers: array[TGearType] of TGearStepProcedure = (
    72 const doStepHandlers: array[TGearType] of TGearStepProcedure = (
  1015     if t^.Kind = gtHedgehog then t^.Active:= true;
   987     if t^.Kind = gtHedgehog then t^.Active:= true;
  1016     t:= t^.NextGear
   988     t:= t^.NextGear
  1017     end
   989     end
  1018 end;
   990 end;
  1019 
   991 
  1020 procedure DrawAltWeapon(Gear: PGear; sx, sy: LongInt);
   992 
  1021 begin
   993 procedure DrawGears;
  1022 with Gear^.Hedgehog^ do
   994 var Gear: PGear;
  1023     begin
   995     x, y: LongInt;
  1024     if not (((Ammoz[CurAmmoType].Ammo.Propz and ammoprop_AltUse) <> 0) and ((Gear^.State and gstAttacked) = 0)) then
   996 begin
  1025         exit;
   997 Gear:= GearsList;
  1026     DrawTexture(sx + 16, sy + 16, ropeIconTex);
   998 while Gear <> nil do
  1027     DrawTextureF(SpritesData[sprAMAmmos].Texture, 0.75, sx + 30, sy + 30, ord(CurAmmoType) - 1, 1, 32, 32);
   999     begin
  1028     end;
  1000     x:= hwRound(Gear^.X) + WorldDx;
  1029 end;
  1001     y:= hwRound(Gear^.Y) + WorldDy;
  1030 
  1002     RenderGear(Gear, x, y);
  1031 procedure DrawRopeLinesRQ(Gear: PGear);
  1003     Gear:= Gear^.NextGear
  1032 begin
  1004     end;
  1033 with RopePoints do
  1005 end;
  1034     begin
       
  1035     rounded[Count].X:= hwRound(Gear^.X);
       
  1036     rounded[Count].Y:= hwRound(Gear^.Y);
       
  1037     rounded[Count + 1].X:= hwRound(Gear^.Hedgehog^.Gear^.X);
       
  1038     rounded[Count + 1].Y:= hwRound(Gear^.Hedgehog^.Gear^.Y);
       
  1039     end;
       
  1040 
       
  1041 if (RopePoints.Count > 0) or (Gear^.Elasticity.QWordValue > 0) then
       
  1042     begin
       
  1043     glDisable(GL_TEXTURE_2D);
       
  1044     //glEnable(GL_LINE_SMOOTH);
       
  1045 
       
  1046     glPushMatrix;
       
  1047 
       
  1048     glTranslatef(WorldDx, WorldDy, 0);
       
  1049 
       
  1050     glLineWidth(4.0);
       
  1051 
       
  1052     Tint($C0, $C0, $C0, $FF);
       
  1053 
       
  1054     glVertexPointer(2, GL_FLOAT, 0, @RopePoints.rounded[0]);
       
  1055     glDrawArrays(GL_LINE_STRIP, 0, RopePoints.Count + 2);
       
  1056     Tint($FF, $FF, $FF, $FF);
       
  1057 
       
  1058     glPopMatrix;
       
  1059 
       
  1060     glEnable(GL_TEXTURE_2D);
       
  1061     //glDisable(GL_LINE_SMOOTH)
       
  1062     end
       
  1063 end;
       
  1064 
       
  1065 procedure DrawRope(Gear: PGear);
       
  1066 var roplen: LongInt;
       
  1067     i: Longword;
       
  1068 
       
  1069     procedure DrawRopeLine(X1, Y1, X2, Y2: LongInt);
       
  1070     var  eX, eY, dX, dY: LongInt;
       
  1071         i, sX, sY, x, y, d: LongInt;
       
  1072         b: boolean;
       
  1073     begin
       
  1074     if (X1 = X2) and (Y1 = Y2) then
       
  1075     begin
       
  1076     //OutError('WARNING: zero length rope line!', false);
       
  1077     exit
       
  1078     end;
       
  1079     eX:= 0;
       
  1080     eY:= 0;
       
  1081     dX:= X2 - X1;
       
  1082     dY:= Y2 - Y1;
       
  1083 
       
  1084     if (dX > 0) then sX:= 1
       
  1085     else
       
  1086     if (dX < 0) then
       
  1087         begin
       
  1088         sX:= -1;
       
  1089         dX:= -dX
       
  1090         end else sX:= dX;
       
  1091 
       
  1092     if (dY > 0) then sY:= 1
       
  1093     else
       
  1094     if (dY < 0) then
       
  1095         begin
       
  1096         sY:= -1;
       
  1097         dY:= -dY
       
  1098         end else sY:= dY;
       
  1099 
       
  1100         if (dX > dY) then d:= dX
       
  1101                     else d:= dY;
       
  1102 
       
  1103         x:= X1;
       
  1104         y:= Y1;
       
  1105 
       
  1106         for i:= 0 to d do
       
  1107             begin
       
  1108             inc(eX, dX);
       
  1109             inc(eY, dY);
       
  1110             b:= false;
       
  1111             if (eX > d) then
       
  1112                 begin
       
  1113                 dec(eX, d);
       
  1114                 inc(x, sX);
       
  1115                 b:= true
       
  1116                 end;
       
  1117             if (eY > d) then
       
  1118                 begin
       
  1119                 dec(eY, d);
       
  1120                 inc(y, sY);
       
  1121                 b:= true
       
  1122                 end;
       
  1123             if b then
       
  1124                 begin
       
  1125                 inc(roplen);
       
  1126                 if (roplen mod 4) = 0 then DrawSprite(sprRopeNode, x - 2, y - 2, 0)
       
  1127                 end
       
  1128         end
       
  1129     end;
       
  1130 begin
       
  1131     if (cReducedQuality and rqSimpleRope) <> 0 then
       
  1132         DrawRopeLinesRQ(Gear)
       
  1133     else
       
  1134         begin
       
  1135         roplen:= 0;
       
  1136         if RopePoints.Count > 0 then
       
  1137             begin
       
  1138             i:= 0;
       
  1139             while i < Pred(RopePoints.Count) do
       
  1140                     begin
       
  1141                     DrawRopeLine(hwRound(RopePoints.ar[i].X) + WorldDx, hwRound(RopePoints.ar[i].Y) + WorldDy,
       
  1142                                 hwRound(RopePoints.ar[Succ(i)].X) + WorldDx, hwRound(RopePoints.ar[Succ(i)].Y) + WorldDy);
       
  1143                     inc(i)
       
  1144                     end;
       
  1145             DrawRopeLine(hwRound(RopePoints.ar[i].X) + WorldDx, hwRound(RopePoints.ar[i].Y) + WorldDy,
       
  1146                         hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy);
       
  1147             DrawRopeLine(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy,
       
  1148                         hwRound(Gear^.Hedgehog^.Gear^.X) + WorldDx, hwRound(Gear^.Hedgehog^.Gear^.Y) + WorldDy);
       
  1149             end else
       
  1150             if Gear^.Elasticity.QWordValue > 0 then
       
  1151             DrawRopeLine(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy,
       
  1152                         hwRound(Gear^.Hedgehog^.Gear^.X) + WorldDx, hwRound(Gear^.Hedgehog^.Gear^.Y) + WorldDy);
       
  1153         end;
       
  1154 
       
  1155 
       
  1156 if RopePoints.Count > 0 then
       
  1157     DrawRotated(sprRopeHook, hwRound(RopePoints.ar[0].X) + WorldDx, hwRound(RopePoints.ar[0].Y) + WorldDy, 1, RopePoints.HookAngle)
       
  1158     else
       
  1159     if Gear^.Elasticity.QWordValue > 0 then
       
  1160         DrawRotated(sprRopeHook, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 0, DxDy2Angle(Gear^.dY, Gear^.dX));
       
  1161 end;
       
  1162 
       
  1163 {$INCLUDE "GearDrawing.inc"}
       
  1164 
  1006 
  1165 procedure FreeGearsList;
  1007 procedure FreeGearsList;
  1166 var t, tt: PGear;
  1008 var t, tt: PGear;
  1167 begin
  1009 begin
  1168     tt:= GearsList;
  1010     tt:= GearsList;