hedgewars/uGears.pas
changeset 6468 da1e7fe7cff7
parent 6453 11c578d30bd3
child 6472 bced12412f94
equal deleted inserted replaced
6467:090269e528df 6468:da1e7fe7cff7
    35 interface
    35 interface
    36 uses SDLh, uConsts, uFloat, uTypes;
    36 uses SDLh, uConsts, uFloat, uTypes;
    37 
    37 
    38 procedure initModule;
    38 procedure initModule;
    39 procedure freeModule;
    39 procedure freeModule;
    40 function  AddGear(X, Y: LongInt; Kind: TGearType; State: Longword; dX, dY: hwFloat; Timer: LongWord): PGear;
       
    41 function  SpawnCustomCrateAt(x, y: LongInt; crate: TCrateType; content: Longword ): PGear;
    40 function  SpawnCustomCrateAt(x, y: LongInt; crate: TCrateType; content: Longword ): PGear;
    42 function  SpawnFakeCrateAt(x, y: LongInt; crate: TCrateType; explode: boolean; poison: boolean ): PGear;
    41 function  SpawnFakeCrateAt(x, y: LongInt; crate: TCrateType; explode: boolean; poison: boolean ): PGear;
    43 function  GetAmmo: TAmmoType;
    42 function  GetAmmo: TAmmoType;
    44 function  GetUtility: TAmmoType;
    43 function  GetUtility: TAmmoType;
    45 procedure ResurrectHedgehog(gear: PGear);
       
    46 procedure HideHog(HH: PHedgehog);
    44 procedure HideHog(HH: PHedgehog);
    47 procedure RestoreHog(HH: PHedgehog);
    45 procedure RestoreHog(HH: PHedgehog);
    48 procedure ProcessGears;
    46 procedure ProcessGears;
    49 procedure EndTurnCleanup;
    47 procedure EndTurnCleanup;
    50 procedure ApplyDamage(Gear: PGear; AttackerHog: PHedgehog; Damage: Longword; Source: TDamageSource);
       
    51 procedure SetAllToActive;
    48 procedure SetAllToActive;
    52 procedure SetAllHHToActive;
    49 procedure SetAllHHToActive;
    53 procedure DrawGears;
    50 procedure DrawGears;
    54 procedure FreeGearsList;
    51 procedure FreeGearsList;
    55 procedure AddMiscGears;
    52 procedure AddMiscGears;
    56 procedure AssignHHCoords;
    53 procedure AssignHHCoords;
    57 function  GearByUID(uid : Longword) : PGear;
    54 function  GearByUID(uid : Longword) : PGear;
    58 procedure InsertGearToList(Gear: PGear);
    55 procedure InsertGearToList(Gear: PGear);
    59 procedure RemoveGearFromList(Gear: PGear);
    56 procedure RemoveGearFromList(Gear: PGear);
    60 function  ModifyDamage(dmg: Longword; Gear: PGear): Longword;
       
    61 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean = false);
       
    62 procedure DeleteGear(Gear: PGear); 
    57 procedure DeleteGear(Gear: PGear); 
    63 
    58 
    64 
    59 
    65 implementation
    60 implementation
    66 uses uStore, uSound, uTeams, uRandom, uCollisions, uIO, uLandGraphics,
    61 uses uStore, uSound, uTeams, uRandom, uCollisions, uIO, uLandGraphics,
    67      uAIMisc, uLocale, uAI, uAmmos, uStats, uVisualGears, uScript, GLunit, uMobile, uVariables,
    62      uAIMisc, uLocale, uAI, uAmmos, uStats, uVisualGears, uScript, GLunit, uMobile, uVariables,
    68      uCommands, uUtils, uTextures, uRenderUtils, uGearsRender, uCaptions, uDebug, uLandTexture;
    63      uCommands, uUtils, uTextures, uRenderUtils, uGearsRender, uCaptions, uDebug, uLandTexture,
    69 
    64      uGearsHedgehog;
    70 
    65 
    71 procedure doMakeExplosion(X, Y, Radius: LongInt; AttackingHog: PHedgehog; Mask: Longword; const Tint: LongWord = $FFFFFFFF); forward;
    66 
    72 procedure AmmoShove(Ammo: PGear; Damage, Power: LongInt); forward;
    67 procedure AmmoShove(Ammo: PGear; Damage, Power: LongInt); forward;
    73 //procedure AmmoFlameWork(Ammo: PGear); forward;
    68 //procedure AmmoFlameWork(Ammo: PGear); forward;
    74 function  GearsNear(X, Y: hwFloat; Kind: TGearType; r: LongInt): TPGearArray; forward;
    69 function  GearsNear(X, Y: hwFloat; Kind: TGearType; r: LongInt): TPGearArray; forward;
    75 function  CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear; forward;
       
    76 procedure SpawnBoxOfSmth; forward;
    70 procedure SpawnBoxOfSmth; forward;
    77 procedure AfterAttack; forward;
       
    78 procedure HedgehogStep(Gear: PGear); forward;
       
    79 procedure doStepHedgehogMoving(Gear: PGear); forward;
       
    80 procedure HedgehogChAngle(HHGear: PGear); forward;
       
    81 procedure ShotgunShot(Gear: PGear); forward;
    71 procedure ShotgunShot(Gear: PGear); forward;
    82 procedure PickUp(HH, Gear: PGear); forward;
    72 procedure PickUp(HH, Gear: PGear); forward;
    83 procedure HHSetWeapon(HHGear: PGear); forward;
    73 procedure HHSetWeapon(HHGear: PGear); forward;
    84 procedure doStepCase(Gear: PGear); forward;
    74 procedure doStepCase(Gear: PGear); forward;
    85 
    75 
    86 // For better maintainability the step handlers of gears are stored in
    76 // For better maintainability the step handlers of gears are stored in
    87 // separate files.
    77 // separate files.
    88 // Note: step handlers of gears that are hedgehogs are in a different file
    78 // Note: step handlers of gears that are hedgehogs are in a different file
    89 //       than the handlers for all other gears.
    79 //       than the handlers for all other gears.
    90 {$INCLUDE "GSHandlers.inc"}
    80 {$INCLUDE "GSHandlers.inc"}
    91 {$INCLUDE "HHHandlers.inc"}
       
    92 
    81 
    93 const doStepHandlers: array[TGearType] of TGearStepProcedure = (
    82 const doStepHandlers: array[TGearType] of TGearStepProcedure = (
    94             @doStepBomb,
    83             @doStepBomb,
    95             @doStepHedgehog,
    84             @doStepHedgehog,
    96             @doStepShell,
    85             @doStepShell,
   152             @doStepSnowflake,
   141             @doStepSnowflake,
   153             @doStepStructure,
   142             @doStepStructure,
   154             @doStepLandGun,
   143             @doStepLandGun,
   155             @doStepTardis);
   144             @doStepTardis);
   156 
   145 
   157 procedure InsertGearToList(Gear: PGear);
       
   158 var tmp, ptmp: PGear;
       
   159 begin
       
   160     tmp:= GearsList;
       
   161     ptmp:= GearsList;
       
   162     while (tmp <> nil) and (tmp^.Z <= Gear^.Z) do
       
   163         begin
       
   164         ptmp:= tmp;
       
   165         tmp:= tmp^.NextGear
       
   166         end;
       
   167 
       
   168     if ptmp <> tmp then
       
   169         begin
       
   170         Gear^.NextGear:= ptmp^.NextGear;
       
   171         Gear^.PrevGear:= ptmp;
       
   172         if ptmp^.NextGear <> nil then ptmp^.NextGear^.PrevGear:= Gear;
       
   173         ptmp^.NextGear:= Gear
       
   174         end
       
   175     else
       
   176         begin
       
   177         Gear^.NextGear:= GearsList;
       
   178         if Gear^.NextGear <> nil then Gear^.NextGear^.PrevGear:= Gear;
       
   179         GearsList:= Gear;
       
   180         end;
       
   181 end;
       
   182 
       
   183 procedure RemoveGearFromList(Gear: PGear);
       
   184 begin
       
   185 if Gear^.NextGear <> nil then Gear^.NextGear^.PrevGear:= Gear^.PrevGear;
       
   186 if Gear^.PrevGear <> nil then
       
   187     Gear^.PrevGear^.NextGear:= Gear^.NextGear
       
   188 else
       
   189     GearsList:= Gear^.NextGear
       
   190 end;
       
   191 
       
   192 procedure spawnHealthTagForHH(HHGear: PGear; dmg: Longword);
       
   193 var tag: PVisualGear;
       
   194 begin
       
   195 tag:= AddVisualGear(hwRound(HHGear^.X), hwRound(HHGear^.Y), vgtHealthTag, dmg);
       
   196 if (tag <> nil) then
       
   197     tag^.Hedgehog:= HHGear^.Hedgehog; // the tag needs the tag to determine the text color
       
   198 AllInactive:= false;
       
   199 HHGear^.Active:= true;
       
   200 end;
       
   201 
       
   202 function AddGear(X, Y: LongInt; Kind: TGearType; State: Longword; dX, dY: hwFloat; Timer: LongWord): PGear;
       
   203 const Counter: Longword = 0;
       
   204 var gear: PGear;
       
   205 begin
       
   206 inc(Counter);
       
   207 AddFileLog('AddGear: #' + inttostr(Counter) + ' (' + inttostr(x) + ',' + inttostr(y) + '), d(' + floattostr(dX) + ',' + floattostr(dY) + ') type = ' + EnumToStr(Kind));
       
   208 
       
   209 New(gear);
       
   210 FillChar(gear^, sizeof(TGear), 0);
       
   211 gear^.X:= int2hwFloat(X);
       
   212 gear^.Y:= int2hwFloat(Y);
       
   213 gear^.Target.X:= NoPointX;
       
   214 gear^.Kind := Kind;
       
   215 gear^.State:= State;
       
   216 gear^.Active:= true;
       
   217 gear^.dX:= dX;
       
   218 gear^.dY:= dY;
       
   219 gear^.doStep:= doStepHandlers[Kind];
       
   220 gear^.CollisionIndex:= -1;
       
   221 gear^.Timer:= Timer;
       
   222 gear^.FlightTime:= 0;
       
   223 gear^.uid:= Counter;
       
   224 gear^.SoundChannel:= -1;
       
   225 gear^.ImpactSound:= sndNone;
       
   226 gear^.nImpactSounds:= 0;
       
   227 gear^.Density:= _1;
       
   228 // Define ammo association, if any.
       
   229 gear^.AmmoType:= GearKindAmmoTypeMap[Kind];
       
   230 if Ammoz[Gear^.AmmoType].Ammo.Propz and ammoprop_NeedTarget <> 0 then gear^.Z:= cHHZ+1
       
   231 else gear^.Z:= cUsualZ;
       
   232 
       
   233 if CurrentHedgehog <> nil then
       
   234     begin
       
   235     gear^.Hedgehog:= CurrentHedgehog;
       
   236     gear^.IntersectGear:= CurrentHedgehog^.Gear
       
   237     end;
       
   238     
       
   239 case Kind of
       
   240      gtGrenade,
       
   241      gtClusterBomb,
       
   242      gtGasBomb: begin
       
   243                 gear^.ImpactSound:= sndGrenadeImpact;
       
   244                 gear^.nImpactSounds:= 1;
       
   245                 gear^.AdvBounce:= 1;
       
   246                 gear^.Radius:= 5;
       
   247                 gear^.Elasticity:= _0_8;
       
   248                 gear^.Friction:= _0_8;
       
   249                 gear^.Density:= _1_5;
       
   250                 gear^.RenderTimer:= true;
       
   251                 if gear^.Timer = 0 then gear^.Timer:= 3000
       
   252                 end;
       
   253   gtWatermelon: begin
       
   254                 gear^.ImpactSound:= sndMelonImpact;
       
   255                 gear^.nImpactSounds:= 1;
       
   256                 gear^.AdvBounce:= 1;
       
   257                 gear^.Radius:= 6;
       
   258                 gear^.Elasticity:= _0_8;
       
   259                 gear^.Friction:= _0_995;
       
   260                 gear^.Density:= _2;
       
   261                 gear^.RenderTimer:= true;
       
   262                 if gear^.Timer = 0 then gear^.Timer:= 3000
       
   263                 end;
       
   264   gtMelonPiece: begin
       
   265                 gear^.Density:= _2;
       
   266                 end;
       
   267     gtHedgehog: begin
       
   268                 gear^.AdvBounce:= 1;
       
   269                 gear^.Radius:= cHHRadius;
       
   270                 gear^.Elasticity:= _0_35;
       
   271                 gear^.Friction:= _0_999;
       
   272                 gear^.Angle:= cMaxAngle div 2;
       
   273                 gear^.Density:= _3;
       
   274                 gear^.Z:= cHHZ;
       
   275                 if (GameFlags and gfAISurvival) <> 0 then
       
   276                     if gear^.Hedgehog^.BotLevel > 0 then
       
   277                         gear^.Hedgehog^.Effects[heResurrectable] := true;
       
   278                 end;
       
   279        gtShell: begin
       
   280                 gear^.Radius:= 4;
       
   281                 gear^.Density:= _1;
       
   282                 end;
       
   283        gtSnowball: begin
       
   284                 gear^.ImpactSound:= sndMudballImpact;
       
   285                 gear^.nImpactSounds:= 1;
       
   286                 gear^.Radius:= 4;
       
   287                 gear^.Elasticity:= _1;
       
   288                 gear^.Friction:= _1;
       
   289                 gear^.Density:= _0_5;
       
   290                 end;
       
   291 
       
   292      gtFlake: begin
       
   293                 with Gear^ do
       
   294                     begin
       
   295                     Pos:= 0;
       
   296                     Radius:= 1;
       
   297                     DirAngle:= random * 360;
       
   298                     if State and gstTmpFlag = 0 then
       
   299                         begin
       
   300                         dx.isNegative:= GetRandom(2) = 0;
       
   301                         dx.QWordValue:= GetRandom(100000000);
       
   302                         dy.isNegative:= false;
       
   303                         dy.QWordValue:= GetRandom(70000000);
       
   304                         if GetRandom(2) = 0 then dx := -dx
       
   305                         end;
       
   306                     State:= State or gstInvisible;
       
   307                     Health:= random(vobFrameTicks);
       
   308                     Timer:= random(vobFramesCount);
       
   309                     Angle:= (random(2) * 2 - 1) * (1 + random(10000)) * vobVelocity
       
   310                     end
       
   311                 end;
       
   312        gtGrave: begin
       
   313                 gear^.ImpactSound:= sndGraveImpact;
       
   314                 gear^.nImpactSounds:= 1;
       
   315                 gear^.Radius:= 10;
       
   316                 gear^.Elasticity:= _0_6;
       
   317                 end;
       
   318          gtBee: begin
       
   319                 gear^.Radius:= 5;
       
   320                 gear^.Timer:= 500;
       
   321                 gear^.RenderTimer:= true;
       
   322                 gear^.Elasticity:= _0_9;
       
   323                 gear^.Tag:= 0;
       
   324                 end;
       
   325    gtSeduction: begin
       
   326                 gear^.Radius:= 250;
       
   327                 end;
       
   328  gtShotgunShot: begin
       
   329                 gear^.Timer:= 900;
       
   330                 gear^.Radius:= 2
       
   331                 end;
       
   332   gtPickHammer: begin
       
   333                 gear^.Radius:= 10;
       
   334                 gear^.Timer:= 4000
       
   335                 end;
       
   336    gtHammerHit: begin
       
   337                 gear^.Radius:= 8;
       
   338                 gear^.Timer:= 125
       
   339                 end;
       
   340         gtRope: begin
       
   341                 gear^.Radius:= 3;
       
   342                 gear^.Friction:= _450 * _0_01 * cRopePercent;
       
   343                 RopePoints.Count:= 0;
       
   344                 end;
       
   345         gtMine: begin
       
   346                 gear^.ImpactSound:= sndMineImpact;
       
   347                 gear^.nImpactSounds:= 1;
       
   348                 gear^.Health:= 10;
       
   349                 gear^.State:= gear^.State or gstMoving;
       
   350                 gear^.Radius:= 2;
       
   351                 gear^.Elasticity:= _0_55;
       
   352                 gear^.Friction:= _0_995;
       
   353                 gear^.Density:= _0_9;
       
   354                 if cMinesTime < 0 then
       
   355                     gear^.Timer:= getrandom(51)*100
       
   356                 else
       
   357                     gear^.Timer:= cMinesTime;
       
   358                 end;
       
   359        gtSMine: begin
       
   360                 gear^.Health:= 10;
       
   361                 gear^.State:= gear^.State or gstMoving;
       
   362                 gear^.Radius:= 2;
       
   363                 gear^.Elasticity:= _0_55;
       
   364                 gear^.Friction:= _0_995;
       
   365                 gear^.Density:= _0_9;
       
   366                 gear^.Timer:= 500;
       
   367                 end;
       
   368         gtCase: begin
       
   369                 gear^.ImpactSound:= sndGraveImpact;
       
   370                 gear^.nImpactSounds:= 1;
       
   371                 gear^.Radius:= 16;
       
   372                 gear^.Elasticity:= _0_3
       
   373                 end;
       
   374   gtExplosives: begin
       
   375                 gear^.ImpactSound:= sndGrenadeImpact;
       
   376                 gear^.nImpactSounds:= 1;
       
   377                 gear^.Radius:= 16;
       
   378                 gear^.Elasticity:= _0_4;
       
   379                 gear^.Friction:= _0_995;
       
   380                 gear^.Density:= _6;
       
   381                 gear^.Health:= cBarrelHealth;
       
   382                 gear^.Z:= cHHZ-1
       
   383                 end;
       
   384   gtDEagleShot: begin
       
   385                 gear^.Radius:= 1;
       
   386                 gear^.Health:= 50
       
   387                 end;
       
   388   gtSniperRifleShot: begin
       
   389                 gear^.Radius:= 1;
       
   390                 gear^.Health:= 50
       
   391                 end;
       
   392     gtDynamite: begin
       
   393                 gear^.Radius:= 3;
       
   394                 gear^.Elasticity:= _0_55;
       
   395                 gear^.Friction:= _0_03;
       
   396                 gear^.Density:= _2;
       
   397                 gear^.Timer:= 5000;
       
   398                 end;
       
   399      gtCluster: begin
       
   400                 gear^.Radius:= 2;
       
   401                 gear^.Density:= _1_5;
       
   402                 gear^.RenderTimer:= true
       
   403                 end;
       
   404       gtShover: gear^.Radius:= 20;
       
   405        gtFlame: begin
       
   406                 gear^.Tag:= GetRandom(32);
       
   407                 gear^.Radius:= 1;
       
   408                 gear^.Health:= 5;
       
   409                 gear^.Density:= _1;
       
   410                 if (gear^.dY.QWordValue = 0) and (gear^.dX.QWordValue = 0) then
       
   411                     begin
       
   412                     gear^.dY:= (getrandom - _0_8) * _0_03;
       
   413                     gear^.dX:= (getrandom - _0_5) * _0_4
       
   414                     end
       
   415                 end;
       
   416    gtFirePunch: begin
       
   417                 gear^.Radius:= 15;
       
   418                 gear^.Tag:= Y
       
   419                 end;
       
   420      gtAirBomb: begin
       
   421                 gear^.Radius:= 5;
       
   422                 gear^.Density:= _2;
       
   423                 end;
       
   424    gtBlowTorch: begin
       
   425                 gear^.Radius:= cHHRadius + cBlowTorchC;
       
   426                 gear^.Timer:= 7500
       
   427                 end;
       
   428     gtSwitcher: begin
       
   429                 gear^.Z:= cCurrHHZ
       
   430                 end;
       
   431       gtTarget: begin
       
   432                 gear^.ImpactSound:= sndGrenadeImpact;
       
   433                 gear^.nImpactSounds:= 1;
       
   434                 gear^.Radius:= 10;
       
   435                 gear^.Elasticity:= _0_3;
       
   436                 gear^.Timer:= 0
       
   437                 end;
       
   438       gtTardis: begin
       
   439                 gear^.Timer:= 0;
       
   440                 gear^.Pos:= 1;
       
   441                 gear^.Z:= cCurrHHZ+1;
       
   442                 end;
       
   443       gtMortar: begin
       
   444                 gear^.Radius:= 4;
       
   445                 gear^.Elasticity:= _0_2;
       
   446                 gear^.Friction:= _0_08;
       
   447                 gear^.Density:= _1;
       
   448                 end;
       
   449         gtWhip: gear^.Radius:= 20;
       
   450       gtHammer: gear^.Radius:= 20;
       
   451     gtKamikaze: begin
       
   452                 gear^.Health:= 2048;
       
   453                 gear^.Radius:= 20
       
   454                 end;
       
   455         gtCake: begin
       
   456                 gear^.Health:= 2048;
       
   457                 gear^.Radius:= 7;
       
   458                 gear^.Z:= cOnHHZ;
       
   459                 gear^.RenderTimer:= true;
       
   460                 gear^.DirAngle:= -90 * hwSign(Gear^.dX);
       
   461                 if not dX.isNegative then gear^.Angle:= 1 else gear^.Angle:= 3
       
   462                 end;
       
   463  gtHellishBomb: begin
       
   464                 gear^.ImpactSound:= sndHellishImpact1;
       
   465                 gear^.nImpactSounds:= 4;
       
   466                 gear^.AdvBounce:= 1;
       
   467                 gear^.Radius:= 4;
       
   468                 gear^.Elasticity:= _0_5;
       
   469                 gear^.Friction:= _0_96;
       
   470                 gear^.Density:= _1_5;
       
   471                 gear^.RenderTimer:= true;
       
   472                 gear^.Timer:= 5000
       
   473                 end;
       
   474        gtDrill: begin
       
   475                 if gear^.Timer = 0 then gear^.Timer:= 5000;
       
   476                 // Tag for drill strike. if 1 then first impact occured already
       
   477                 gear^.Tag := 0;
       
   478                 gear^.Radius:= 4;
       
   479                 gear^.Density:= _1;
       
   480                 end;
       
   481         gtBall: begin
       
   482                 gear^.ImpactSound:= sndGrenadeImpact;
       
   483                 gear^.nImpactSounds:= 1;
       
   484                 gear^.AdvBounce:= 1;
       
   485                 gear^.Radius:= 5;
       
   486                 gear^.Tag:= random(8);
       
   487                 gear^.Timer:= 5000;
       
   488                 gear^.Elasticity:= _0_7;
       
   489                 gear^.Friction:= _0_995;
       
   490                 gear^.Density:= _1_5;
       
   491                 end;
       
   492      gtBallgun: begin
       
   493                 gear^.Timer:= 5001;
       
   494                 end;
       
   495      gtRCPlane: begin
       
   496                 gear^.Timer:= 15000;
       
   497                 gear^.Health:= 3;
       
   498                 gear^.Radius:= 8
       
   499                 end;
       
   500      gtJetpack: begin
       
   501                 gear^.Health:= 2000;
       
   502                 gear^.Damage:= 100
       
   503                 end;
       
   504      gtMolotov: begin
       
   505                 gear^.Radius:= 6;
       
   506                 gear^.Density:= _2;
       
   507                 end;
       
   508        gtBirdy: begin
       
   509                 gear^.Radius:= 16; // todo: check
       
   510                 gear^.Timer:= 0;
       
   511                 gear^.Health := 2000;
       
   512                 gear^.FlightTime := 2;
       
   513                 end;
       
   514          gtEgg: begin
       
   515                 gear^.Radius:= 4;
       
   516                 gear^.Elasticity:= _0_6;
       
   517                 gear^.Friction:= _0_96;
       
   518                 gear^.Density:= _1;
       
   519                 if gear^.Timer = 0 then gear^.Timer:= 3000
       
   520                 end;
       
   521       gtPortal: begin
       
   522                 gear^.ImpactSound:= sndMelonImpact;
       
   523                 gear^.nImpactSounds:= 1;
       
   524                 gear^.AdvBounce:= 0;
       
   525                 gear^.Radius:= 17;
       
   526                 // set color
       
   527                 gear^.Tag:= 2 * gear^.Timer;
       
   528                 gear^.Timer:= 15000;
       
   529                 gear^.RenderTimer:= false;
       
   530                 gear^.Health:= 100;
       
   531                 end;
       
   532        gtPiano: begin
       
   533                 gear^.Radius:= 32;
       
   534                 gear^.Density:= _50;
       
   535                 end;
       
   536  gtSineGunShot: begin
       
   537                 gear^.Radius:= 5;
       
   538                 gear^.Health:= 6000;
       
   539                 end;
       
   540 gtFlamethrower: begin
       
   541                 gear^.Tag:= 10;
       
   542                 gear^.Timer:= 10;
       
   543                 gear^.Health:= 500;
       
   544                 gear^.Damage:= 100;
       
   545                 end;
       
   546      gtLandGun: begin
       
   547                 gear^.Tag:= 10;
       
   548                 gear^.Timer:= 10;
       
   549                 gear^.Health:= 1000;
       
   550                 gear^.Damage:= 100;
       
   551                 end;
       
   552  gtPoisonCloud: begin
       
   553                 gear^.Timer:= 5000;
       
   554                 gear^.dY:= int2hwfloat(-4 + longint(getRandom(8))) / 1000;
       
   555                 end;
       
   556  gtResurrector: begin
       
   557                 gear^.Radius := 100;
       
   558                 gear^.Tag := 0
       
   559                 end;
       
   560      gtWaterUp: begin
       
   561                 gear^.Tag := 47;
       
   562                 end;
       
   563   gtNapalmBomb: begin
       
   564                 gear^.Timer:= 1000;
       
   565                 gear^.Radius:= 5;
       
   566                 gear^.Density:= _1_5;
       
   567                 end;
       
   568    gtStructure: begin
       
   569                 gear^.Elasticity:= _0_55;
       
   570                 gear^.Friction:= _0_995;
       
   571                 gear^.Density:= _0_9;
       
   572                 gear^.Radius:= 13;
       
   573                 gear^.Health:= 200;
       
   574                 gear^.Tag:= 3;
       
   575                 end;
       
   576     end;
       
   577 
       
   578 InsertGearToList(gear);
       
   579 AddGear:= gear;
       
   580 
       
   581 ScriptCall('onGearAdd', gear^.uid);
       
   582 end;
       
   583 
       
   584 procedure DeleteGear(Gear: PGear);
       
   585 var team: PTeam;
       
   586     t,i: Longword;
       
   587     k: boolean;
       
   588 begin
       
   589 
       
   590 ScriptCall('onGearDelete', gear^.uid);
       
   591 
       
   592 DeleteCI(Gear);
       
   593 
       
   594 FreeTexture(Gear^.Tex);
       
   595 Gear^.Tex:= nil;
       
   596 
       
   597 // make sure that portals have their link removed before deletion
       
   598 if (Gear^.Kind = gtPortal) then
       
   599     begin
       
   600     if (Gear^.IntersectGear <> nil) then
       
   601         if (Gear^.IntersectGear^.IntersectGear = Gear) then
       
   602             Gear^.IntersectGear^.IntersectGear:= nil;
       
   603     end
       
   604 else if Gear^.Kind = gtHedgehog then
       
   605     (*
       
   606     This behaviour dates back to revision 4, and I accidentally encountered it with TARDIS.  I don't think it must apply to any modern weapon, since if it was actually hit, the best the gear could do would be to destroy itself immediately, and you'd still end up with two graves.  I believe it should be removed
       
   607      if (CurAmmoGear <> nil) and (CurrentHedgehog^.Gear = Gear) then
       
   608         begin
       
   609         AttackBar:= 0;
       
   610         Gear^.Message:= gmDestroy;
       
   611         CurAmmoGear^.Message:= gmDestroy;
       
   612         exit
       
   613         end
       
   614     else*)
       
   615         begin
       
   616         if (hwRound(Gear^.Y) >= cWaterLine) then
       
   617             begin
       
   618             t:= max(Gear^.Damage, Gear^.Health);
       
   619             Gear^.Damage:= t;
       
   620             if ((not SuddenDeathDmg and (cWaterOpacity < $FF)) or (SuddenDeathDmg and (cWaterOpacity < $FF))) and (hwRound(Gear^.Y) < cWaterLine + 256) then
       
   621                 spawnHealthTagForHH(Gear, t);
       
   622             end;
       
   623 
       
   624         team:= Gear^.Hedgehog^.Team;
       
   625         if CurrentHedgehog^.Gear = Gear then
       
   626             begin
       
   627             AttackBar:= 0;
       
   628             FreeActionsList; // to avoid ThinkThread on drawned gear
       
   629             if ((Ammoz[CurrentHedgehog^.CurAmmoType].Ammo.Propz and ammoprop_NoRoundEnd) <> 0) and (CurrentHedgehog^.MultiShootAttacks > 0) then OnUsedAmmo(CurrentHedgehog^);
       
   630             end;
       
   631 
       
   632         Gear^.Hedgehog^.Gear:= nil;
       
   633         if Gear^.Hedgehog^.King then
       
   634             begin
       
   635             // are there any other kings left? Just doing nil check.  Presumably a mortally wounded king will get reaped soon enough
       
   636             k:= false;
       
   637             for i:= 0 to Pred(team^.Clan^.TeamsNumber) do
       
   638                 if (team^.Clan^.Teams[i]^.Hedgehogs[0].Gear <> nil) then k:= true;
       
   639             if not k then
       
   640                 for i:= 0 to Pred(team^.Clan^.TeamsNumber) do
       
   641                     begin
       
   642                     team^.Clan^.Teams[i]^.hasGone:= true;
       
   643                     TeamGoneEffect(team^.Clan^.Teams[i]^)
       
   644                     end
       
   645             end;
       
   646 
       
   647         // should be not CurrentHedgehog, but hedgehog of the last gear which caused damage to this hog
       
   648         // same stand for CheckHHDamage
       
   649         if (Gear^.LastDamage <> nil) then
       
   650             uStats.HedgehogDamaged(Gear, Gear^.LastDamage, 0, true)
       
   651         else
       
   652             uStats.HedgehogDamaged(Gear, CurrentHedgehog, 0, true);
       
   653 
       
   654         inc(KilledHHs);
       
   655         RecountTeamHealth(team);
       
   656         if (CurrentHedgehog <> nil) and CurrentHedgehog^.Effects[heResurrectable] and (not Gear^.Hedgehog^.Effects[heResurrectable]) then
       
   657             with CurrentHedgehog^ do 
       
   658                 begin
       
   659                 inc(Team^.stats.AIKills);
       
   660                 FreeTexture(Team^.AIKillsTex);
       
   661                 Team^.AIKillsTex := RenderStringTex(inttostr(Team^.stats.AIKills), Team^.Clan^.Color, fnt16);
       
   662                 end
       
   663         end;
       
   664 with Gear^ do
       
   665     AddFileLog('Delete: #' + inttostr(uid) + ' (' + inttostr(hwRound(x)) + ',' + inttostr(hwRound(y)) + '), d(' + floattostr(dX) + ',' + floattostr(dY) + ') type = ' + EnumToStr(Kind));
       
   666 
       
   667 if CurAmmoGear = Gear then CurAmmoGear:= nil;
       
   668 if FollowGear = Gear then FollowGear:= nil;
       
   669 if lastGearByUID = Gear then lastGearByUID := nil;
       
   670 RemoveGearFromList(Gear);
       
   671 Dispose(Gear)
       
   672 end;
       
   673 
       
   674 function CheckNoDamage: boolean; // returns TRUE in case of no damaged hhs
   146 function CheckNoDamage: boolean; // returns TRUE in case of no damaged hhs
   675 var Gear: PGear;
   147 var Gear: PGear;
   676     dmg: LongInt;
   148     dmg: LongInt;
   677 begin
   149 begin
   678 CheckNoDamage:= true;
   150 CheckNoDamage:= true;
  1073     if (GameFlags and gfResetHealth) <> 0 then
   545     if (GameFlags and gfResetHealth) <> 0 then
  1074         for i:= 0 to Pred(TeamsCount) do
   546         for i:= 0 to Pred(TeamsCount) do
  1075             RecountTeamHealth(TeamsArray[i])
   547             RecountTeamHealth(TeamsArray[i])
  1076 end;
   548 end;
  1077 
   549 
  1078 procedure ApplyDamage(Gear: PGear; AttackerHog: PHedgehog; Damage: Longword; Source: TDamageSource);
       
  1079 var s: shortstring;
       
  1080     vampDmg, tmpDmg, i: Longword;
       
  1081     vg: PVisualGear;
       
  1082 begin
       
  1083   if Damage = 0 then exit; // nothing to apply
       
  1084 
       
  1085     if (Gear^.Kind = gtHedgehog) then
       
  1086     begin
       
  1087     Gear^.LastDamage := AttackerHog;
       
  1088 
       
  1089     Gear^.Hedgehog^.Team^.Clan^.Flawless:= false;
       
  1090     HHHurt(Gear^.Hedgehog, Source);
       
  1091     AddDamageTag(hwRound(Gear^.X), hwRound(Gear^.Y), Damage, Gear^.Hedgehog^.Team^.Clan^.Color);
       
  1092     tmpDmg:= min(Damage, max(0,Gear^.Health-Gear^.Damage));
       
  1093     if (Gear <> CurrentHedgehog^.Gear) and (CurrentHedgehog^.Gear <> nil) and (tmpDmg >= 1) then
       
  1094         begin
       
  1095         if cVampiric then
       
  1096             begin
       
  1097             vampDmg:= hwRound(int2hwFloat(tmpDmg)*_0_8);
       
  1098             if vampDmg >= 1 then
       
  1099                 begin
       
  1100                 // was considering pulsing on attack, Tiy thinks it should be permanent while in play
       
  1101                 //CurrentHedgehog^.Gear^.State:= CurrentHedgehog^.Gear^.State or gstVampiric;
       
  1102                 inc(CurrentHedgehog^.Gear^.Health,vampDmg);
       
  1103                 str(vampDmg, s);
       
  1104                 s:= '+' + s;
       
  1105                 AddCaption(s, CurrentHedgehog^.Team^.Clan^.Color, capgrpAmmoinfo);
       
  1106                 RenderHealth(CurrentHedgehog^);
       
  1107                 RecountTeamHealth(CurrentHedgehog^.Team);
       
  1108                 i:= 0;
       
  1109                 while i < vampDmg do
       
  1110                     begin
       
  1111                     vg:= AddVisualGear(hwRound(CurrentHedgehog^.Gear^.X), hwRound(CurrentHedgehog^.Gear^.Y), vgtStraightShot);
       
  1112                     if vg <> nil then
       
  1113                         with vg^ do
       
  1114                             begin
       
  1115                             Tint:= $FF0000FF;
       
  1116                             State:= ord(sprHealth)
       
  1117                             end;
       
  1118                     inc(i, 5);
       
  1119                     end;
       
  1120                 end
       
  1121             end;
       
  1122         if ((GameFlags and gfKarma) <> 0) and
       
  1123            ((GameFlags and gfInvulnerable) = 0) and
       
  1124            (not CurrentHedgehog^.Gear^.Invulnerable) then
       
  1125            begin // this cannot just use Damage or it interrupts shotgun and gets you called stupid
       
  1126            inc(CurrentHedgehog^.Gear^.Karma, tmpDmg);
       
  1127            CurrentHedgehog^.Gear^.LastDamage := CurrentHedgehog;
       
  1128            spawnHealthTagForHH(CurrentHedgehog^.Gear, tmpDmg);
       
  1129            end;
       
  1130         uStats.HedgehogDamaged(Gear, AttackerHog, Damage, false);    
       
  1131         end;
       
  1132     end else if Gear^.Kind <> gtStructure then // not gtHedgehog nor gtStructure
       
  1133         begin
       
  1134         Gear^.Hedgehog:= AttackerHog;
       
  1135         end;
       
  1136     inc(Gear^.Damage, Damage);
       
  1137     
       
  1138     ScriptCall('onGearDamage', Gear^.UID, Damage);
       
  1139 end;
       
  1140 
       
  1141 procedure SetAllToActive;
   550 procedure SetAllToActive;
  1142 var t: PGear;
   551 var t: PGear;
  1143 begin
   552 begin
  1144 AllInactive:= false;
   553 AllInactive:= false;
  1145 t:= GearsList;
   554 t:= GearsList;
  1598             end;
  1007             end;
  1599         t := t^.NextGear;
  1008         t := t^.NextGear;
  1600     end;
  1009     end;
  1601 end;
  1010 end;
  1602 
  1011 
  1603 function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear;
       
  1604 var t: PGear;
       
  1605 begin
       
  1606 t:= GearsList;
       
  1607 rX:= sqr(rX);
       
  1608 rY:= sqr(rY);
       
  1609 
       
  1610 while t <> nil do
       
  1611     begin
       
  1612     if (t <> Gear) and (t^.Kind = Kind) then
       
  1613         if not((hwSqr(Gear^.X - t^.X) / rX + hwSqr(Gear^.Y - t^.Y) / rY) > _1) then
       
  1614         exit(t);
       
  1615     t:= t^.NextGear
       
  1616     end;
       
  1617 
       
  1618 CheckGearNear:= nil
       
  1619 end;
       
  1620 
       
  1621 {procedure AmmoFlameWork(Ammo: PGear);
  1012 {procedure AmmoFlameWork(Ammo: PGear);
  1622 var t: PGear;
  1013 var t: PGear;
  1623 begin
  1014 begin
  1624 t:= GearsList;
  1015 t:= GearsList;
  1625 while t <> nil do
  1016 while t <> nil do
  1636             end;
  1027             end;
  1637     t:= t^.NextGear
  1028     t:= t^.NextGear
  1638     end;
  1029     end;
  1639 end;}
  1030 end;}
  1640 
  1031 
  1641 function CheckGearsNear(mX, mY: LongInt; Kind: TGearsType; rX, rY: LongInt): PGear;
       
  1642 var t: PGear;
       
  1643 begin
       
  1644 t:= GearsList;
       
  1645 rX:= sqr(rX);
       
  1646 rY:= sqr(rY);
       
  1647 while t <> nil do
       
  1648     begin
       
  1649     if t^.Kind in Kind then
       
  1650         if not (hwSqr(int2hwFloat(mX) - t^.X) / rX + hwSqr(int2hwFloat(mY) - t^.Y) / rY > _1) then
       
  1651             exit(t);
       
  1652     t:= t^.NextGear
       
  1653     end;
       
  1654 CheckGearsNear:= nil
       
  1655 end;
       
  1656 
  1032 
  1657 function CountGears(Kind: TGearType): Longword;
  1033 function CountGears(Kind: TGearType): Longword;
  1658 var t: PGear;
  1034 var t: PGear;
  1659     count: Longword = 0;
  1035     count: Longword = 0;
  1660 begin
  1036 begin
  1664     begin
  1040     begin
  1665     if t^.Kind = Kind then inc(count);
  1041     if t^.Kind = Kind then inc(count);
  1666     t:= t^.NextGear
  1042     t:= t^.NextGear
  1667     end;
  1043     end;
  1668 CountGears:= count;
  1044 CountGears:= count;
  1669 end;
       
  1670 
       
  1671 procedure ResurrectHedgehog(gear: PGear);
       
  1672 var tempTeam : PTeam;
       
  1673 begin
       
  1674     AttackBar:= 0;
       
  1675     gear^.dX := _0;
       
  1676     gear^.dY := _0;
       
  1677     gear^.Damage := 0;
       
  1678     gear^.Health := gear^.Hedgehog^.InitialHealth;
       
  1679     gear^.Hedgehog^.Effects[hePoisoned] := false;
       
  1680     if not CurrentHedgehog^.Effects[heResurrectable] then
       
  1681         with CurrentHedgehog^ do 
       
  1682             begin
       
  1683             inc(Team^.stats.AIKills);
       
  1684             FreeTexture(Team^.AIKillsTex);
       
  1685             Team^.AIKillsTex := RenderStringTex(inttostr(Team^.stats.AIKills), Team^.Clan^.Color, fnt16);
       
  1686             end;
       
  1687     tempTeam := gear^.Hedgehog^.Team;
       
  1688     DeleteCI(gear);
       
  1689     FindPlace(gear, false, 0, LAND_WIDTH, true); 
       
  1690     if gear <> nil then begin
       
  1691         RenderHealth(gear^.Hedgehog^);
       
  1692         ScriptCall('onGearResurrect', gear^.uid);
       
  1693         gear^.State := gstWait;
       
  1694     end;
       
  1695     RecountTeamHealth(tempTeam);
       
  1696 end;
  1045 end;
  1697 
  1046 
  1698 function SpawnCustomCrateAt(x, y: LongInt; crate: TCrateType; content: Longword): PGear;
  1047 function SpawnCustomCrateAt(x, y: LongInt; crate: TCrateType; content: Longword): PGear;
  1699 begin
  1048 begin
  1700     FollowGear := AddGear(x, y, gtCase, 0, _0, _0, 0);
  1049     FollowGear := AddGear(x, y, gtCase, 0, _0, _0, 0);
  1884     if (FollowGear <> nil) then
  1233     if (FollowGear <> nil) then
  1885         AddVoice(sndReinforce, CurrentTeam^.voicepack)
  1234         AddVoice(sndReinforce, CurrentTeam^.voicepack)
  1886     end
  1235     end
  1887 end;
  1236 end;
  1888 
  1237 
  1889 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean = false);
       
  1890 
       
  1891     function CountNonZeroz(x, y, r, c: LongInt): LongInt;
       
  1892     var i: LongInt;
       
  1893         count: LongInt = 0;
       
  1894     begin
       
  1895     if (y and LAND_HEIGHT_MASK) = 0 then
       
  1896         for i:= max(x - r, 0) to min(x + r, LAND_WIDTH - 4) do
       
  1897             if Land[y, i] <> 0 then
       
  1898                begin
       
  1899                inc(count);
       
  1900                if count = c then exit(count)
       
  1901                end;
       
  1902     CountNonZeroz:= count;
       
  1903     end;
       
  1904 
       
  1905 var x: LongInt;
       
  1906     y, sy: LongInt;
       
  1907     ar: array[0..511] of TPoint;
       
  1908     ar2: array[0..1023] of TPoint;
       
  1909     cnt, cnt2: Longword;
       
  1910     delta: LongInt;
       
  1911     reallySkip, tryAgain: boolean;
       
  1912 begin
       
  1913 reallySkip:= false; // try not skipping proximity at first
       
  1914 tryAgain:= true;
       
  1915 while tryAgain do
       
  1916     begin
       
  1917     delta:= 250;
       
  1918     cnt2:= 0;
       
  1919     repeat
       
  1920         x:= Left + LongInt(GetRandom(Delta));
       
  1921         repeat
       
  1922             inc(x, Delta);
       
  1923             cnt:= 0;
       
  1924             y:= min(1024, topY) - 2 * Gear^.Radius;
       
  1925             while y < cWaterLine do
       
  1926                 begin
       
  1927                 repeat
       
  1928                     inc(y, 2);
       
  1929                 until (y >= cWaterLine) or (CountNonZeroz(x, y, Gear^.Radius - 1, 1) = 0);
       
  1930 
       
  1931                 sy:= y;
       
  1932 
       
  1933                 repeat
       
  1934                     inc(y);
       
  1935                 until (y >= cWaterLine) or (CountNonZeroz(x, y, Gear^.Radius - 1, 1) <> 0);
       
  1936 
       
  1937                 if (y - sy > Gear^.Radius * 2) and
       
  1938                    (((Gear^.Kind = gtExplosives)
       
  1939                        and (y < cWaterLine)
       
  1940                        and (reallySkip or (CheckGearsNear(x, y - Gear^.Radius, [gtFlame, gtHedgehog, gtMine, gtCase, gtExplosives], 60, 60) = nil))
       
  1941                        and (CountNonZeroz(x, y+1, Gear^.Radius - 1, Gear^.Radius+1) > Gear^.Radius))
       
  1942                    or
       
  1943                      ((Gear^.Kind <> gtExplosives)
       
  1944                        and (y < cWaterLine)
       
  1945                        and (reallySkip or (CheckGearsNear(x, y - Gear^.Radius, [gtFlame, gtHedgehog, gtMine, gtCase, gtExplosives], 110, 110) = nil)))) then
       
  1946                     begin
       
  1947                     ar[cnt].X:= x;
       
  1948                     if withFall then ar[cnt].Y:= sy + Gear^.Radius
       
  1949                                 else ar[cnt].Y:= y - Gear^.Radius;
       
  1950                     inc(cnt)
       
  1951                     end;
       
  1952 
       
  1953                 inc(y, 45)
       
  1954                 end;
       
  1955 
       
  1956             if cnt > 0 then
       
  1957                 with ar[GetRandom(cnt)] do
       
  1958                     begin
       
  1959                     ar2[cnt2].x:= x;
       
  1960                     ar2[cnt2].y:= y;
       
  1961                     inc(cnt2)
       
  1962                     end
       
  1963         until (x + Delta > Right);
       
  1964 
       
  1965         dec(Delta, 60)
       
  1966     until (cnt2 > 0) or (Delta < 70);
       
  1967     if (cnt2 = 0) and skipProximity and (not reallySkip) then tryAgain:= true
       
  1968     else tryAgain:= false;
       
  1969     reallySkip:= true;
       
  1970     end;
       
  1971 
       
  1972 if cnt2 > 0 then
       
  1973     with ar2[GetRandom(cnt2)] do
       
  1974         begin
       
  1975         Gear^.X:= int2hwFloat(x);
       
  1976         Gear^.Y:= int2hwFloat(y);
       
  1977         AddFileLog('Assigned Gear coordinates (' + inttostr(x) + ',' + inttostr(y) + ')');
       
  1978         end
       
  1979     else
       
  1980     begin
       
  1981     OutError('Can''t find place for Gear', false);
       
  1982     if Gear^.Kind = gtHedgehog then Gear^.Hedgehog^.Effects[heResurrectable] := false;
       
  1983     DeleteGear(Gear);
       
  1984     Gear:= nil
       
  1985     end
       
  1986 end;
       
  1987 
       
  1988 function ModifyDamage(dmg: Longword; Gear: PGear): Longword;
       
  1989 var i: hwFloat;
       
  1990 begin
       
  1991 (* Invulnerability cannot be placed in here due to still needing kicks
       
  1992    Not without a new damage machine.
       
  1993    King check should be in here instead of ApplyDamage since Tiy wants them kicked less
       
  1994 *)
       
  1995 i:= _1;
       
  1996 if (CurrentHedgehog <> nil) and CurrentHedgehog^.King then i:= _1_5;
       
  1997 if (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.King) then
       
  1998    ModifyDamage:= hwRound(_0_01 * cDamageModifier * dmg * i * cDamagePercent * _0_5)
       
  1999 else
       
  2000    ModifyDamage:= hwRound(_0_01 * cDamageModifier * dmg * i * cDamagePercent)
       
  2001 end;
       
  2002 
  1238 
  2003 function GearByUID(uid : Longword) : PGear;
  1239 function GearByUID(uid : Longword) : PGear;
  2004 var gear: PGear;
  1240 var gear: PGear;
  2005 begin
  1241 begin
  2006 GearByUID:= nil;
  1242 GearByUID:= nil;