hedgewars/uGearsUtils.pas
changeset 6468 da1e7fe7cff7
child 6490 531bf083e8db
equal deleted inserted replaced
6467:090269e528df 6468:da1e7fe7cff7
       
     1 (*
       
     2  * Hedgewars, a free turn based strategy game
       
     3  * Copyright (c) 2004-2011 Andrey Korotaev <unC0Rr@gmail.com>
       
     4  *
       
     5  * This program is free software; you can redistribute it and/or modify
       
     6  * it under the terms of the GNU General Public License as published by
       
     7  * the Free Software Foundation; version 2 of the License
       
     8  *
       
     9  * This program is distributed in the hope that it will be useful,
       
    10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
       
    11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
       
    12  * GNU General Public License for more details.
       
    13  *
       
    14  * You should have received a copy of the GNU General Public License
       
    15  * along with this program; if not, write to the Free Software
       
    16  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
       
    17  *)
       
    18 
       
    19 {$INCLUDE "options.inc"}
       
    20 
       
    21 unit uGearsUtils;
       
    22 interface
       
    23 uses uTypes;
       
    24 
       
    25 procedure doMakeExplosion(X, Y, Radius: LongInt; AttackingHog: PHedgehog; Mask: Longword; const Tint: LongWord = $FFFFFFFF); 
       
    26 function  ModifyDamage(dmg: Longword; Gear: PGear): Longword;
       
    27 procedure ApplyDamage(Gear: PGear; AttackerHog: PHedgehog; Damage: Longword; Source: TDamageSource);
       
    28 procedure spawnHealthTagForHH(HHGear: PGear; dmg: Longword);
       
    29 procedure HHHurt(Hedgehog: PHedgehog; Source: TDamageSource);
       
    30 procedure CheckHHDamage(Gear: PGear);
       
    31 procedure CalcRotationDirAngle(Gear: PGear);
       
    32 procedure ResurrectHedgehog(gear: PGear);
       
    33 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean = false);
       
    34 function  CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear;
       
    35 function  CheckGearsNear(mX, mY: LongInt; Kind: TGearsType; rX, rY: LongInt): PGear;
       
    36 
       
    37 
       
    38 implementation
       
    39 uses uFloat, uSound, uCollisions, uUtils, uConsts, uVisualGears, uAIMisc,
       
    40     uVariables, uLandGraphics, uScript, uStats, uCaptions, uTeams, uStore,
       
    41     uLocale, uTextures, uRenderUtils, uRandom, uGearsList, SDLh, uDebug;
       
    42 
       
    43 procedure doMakeExplosion(X, Y, Radius: LongInt; AttackingHog: PHedgehog; Mask: Longword; const Tint: LongWord);
       
    44 var Gear: PGear;
       
    45     dmg, dmgRadius, dmgBase: LongInt;
       
    46     fX, fY: hwFloat;
       
    47     vg: PVisualGear;
       
    48     i, cnt: LongInt;
       
    49 begin
       
    50     if Radius > 4 then AddFileLog('Explosion: at (' + inttostr(x) + ',' + inttostr(y) + ')');
       
    51     if Radius > 25 then KickFlakes(Radius, X, Y);
       
    52 
       
    53     if ((Mask and EXPLNoGfx) = 0) then
       
    54         begin
       
    55         vg:= nil;
       
    56         if Radius > 50 then vg:= AddVisualGear(X, Y, vgtBigExplosion)
       
    57         else if Radius > 10 then vg:= AddVisualGear(X, Y, vgtExplosion);
       
    58         if vg <> nil then
       
    59             vg^.Tint:= Tint;
       
    60         end;
       
    61     if (Mask and EXPLAutoSound) <> 0 then PlaySound(sndExplosion);
       
    62 
       
    63     if (Mask and EXPLAllDamageInRadius) = 0 then
       
    64         dmgRadius:= Radius shl 1
       
    65     else
       
    66         dmgRadius:= Radius;
       
    67     dmgBase:= dmgRadius + cHHRadius div 2;
       
    68     fX:= int2hwFloat(X);
       
    69     fY:= int2hwFloat(Y);
       
    70     Gear:= GearsList;
       
    71     while Gear <> nil do
       
    72         begin
       
    73         dmg:= 0;
       
    74         //dmg:= dmgRadius  + cHHRadius div 2 - hwRound(Distance(Gear^.X - int2hwFloat(X), Gear^.Y - int2hwFloat(Y)));
       
    75         //if (dmg > 1) and
       
    76         if (Gear^.State and gstNoDamage) = 0 then
       
    77             begin
       
    78             case Gear^.Kind of
       
    79                 gtHedgehog,
       
    80                     gtMine,
       
    81                     gtBall,
       
    82                     gtMelonPiece,
       
    83                     gtGrenade,
       
    84                     gtClusterBomb,
       
    85                 //    gtCluster, too game breaking I think
       
    86                     gtSMine,
       
    87                     gtCase,
       
    88                     gtTarget,
       
    89                     gtFlame,
       
    90                     gtExplosives,
       
    91                     gtStructure: begin
       
    92     // Run the calcs only once we know we have a type that will need damage
       
    93                             if hwRound(hwAbs(Gear^.X-fX)+hwAbs(Gear^.Y-fY)) < dmgBase then
       
    94                                 dmg:= dmgBase - max(hwRound(Distance(Gear^.X - fX, Gear^.Y - fY)),Gear^.Radius);
       
    95                             if dmg > 1 then
       
    96                                 begin
       
    97                                 dmg:= ModifyDamage(min(dmg div 2, Radius), Gear);
       
    98                                 //AddFileLog('Damage: ' + inttostr(dmg));
       
    99                                 if (Mask and EXPLNoDamage) = 0 then
       
   100                                     begin
       
   101                                     if not Gear^.Invulnerable then
       
   102                                         ApplyDamage(Gear, AttackingHog, dmg, dsExplosion)
       
   103                                     else
       
   104                                         Gear^.State:= Gear^.State or gstWinner;
       
   105                                     end;
       
   106                                 if ((Mask and EXPLDoNotTouchAny) = 0) and (((Mask and EXPLDoNotTouchHH) = 0) or (Gear^.Kind <> gtHedgehog)) then
       
   107                                     begin
       
   108                                     DeleteCI(Gear);
       
   109                                     if Gear^.Kind <> gtHedgehog then
       
   110                                         begin
       
   111                                         Gear^.dX:= Gear^.dX + SignAs(_0_005 * dmg + cHHKick, Gear^.X - fX)/Gear^.Density;
       
   112                                         Gear^.dY:= Gear^.dY + SignAs(_0_005 * dmg + cHHKick, Gear^.Y - fY)/Gear^.Density;
       
   113                                         end
       
   114                                     else
       
   115                                         begin
       
   116                                         Gear^.dX:= Gear^.dX + SignAs(_0_005 * dmg + cHHKick, Gear^.X - fX);
       
   117                                         Gear^.dY:= Gear^.dY + SignAs(_0_005 * dmg + cHHKick, Gear^.Y - fY);
       
   118                                         end;
       
   119 
       
   120                                     Gear^.State:= (Gear^.State or gstMoving) and (not gstLoser);
       
   121                                     if not Gear^.Invulnerable then
       
   122                                         Gear^.State:= (Gear^.State or gstMoving) and (not gstWinner);
       
   123                                     Gear^.Active:= true;
       
   124                                     if Gear^.Kind <> gtFlame then FollowGear:= Gear
       
   125                                     end;
       
   126                                 if ((Mask and EXPLPoisoned) <> 0) and (Gear^.Kind = gtHedgehog) and (not Gear^.Invulnerable) then
       
   127                                     Gear^.Hedgehog^.Effects[hePoisoned] := true;
       
   128                                 end;
       
   129 
       
   130                             end;
       
   131                     gtGrave: begin
       
   132     // Run the calcs only once we know we have a type that will need damage
       
   133                             if hwRound(hwAbs(Gear^.X-fX)+hwAbs(Gear^.Y-fY)) < dmgBase then
       
   134                                 dmg:= dmgBase - hwRound(Distance(Gear^.X - fX, Gear^.Y - fY));
       
   135                             if dmg > 1 then
       
   136                                 begin
       
   137                                 dmg:= ModifyDamage(min(dmg div 2, Radius), Gear);
       
   138                                 Gear^.dY:= - _0_004 * dmg;
       
   139                                 Gear^.Active:= true
       
   140                                 end
       
   141                             end;
       
   142                 end;
       
   143             end;
       
   144         Gear:= Gear^.NextGear
       
   145         end;
       
   146 
       
   147     if (Mask and EXPLDontDraw) = 0 then
       
   148         if (GameFlags and gfSolidLand) = 0 then
       
   149             begin
       
   150             cnt:= DrawExplosion(X, Y, Radius) div 1608; // approx 2 16x16 circles to erase per chunk
       
   151             if (cnt > 0) and (SpritesData[sprChunk].Texture <> nil) then
       
   152                 for i:= 0 to cnt do
       
   153                     AddVisualGear(X, Y, vgtChunk)
       
   154             end;
       
   155 
       
   156     uAIMisc.AwareOfExplosion(0, 0, 0)
       
   157 end;
       
   158 
       
   159 function ModifyDamage(dmg: Longword; Gear: PGear): Longword;
       
   160 var i: hwFloat;
       
   161 begin
       
   162 (* Invulnerability cannot be placed in here due to still needing kicks
       
   163    Not without a new damage machine.
       
   164    King check should be in here instead of ApplyDamage since Tiy wants them kicked less
       
   165 *)
       
   166 i:= _1;
       
   167 if (CurrentHedgehog <> nil) and CurrentHedgehog^.King then i:= _1_5;
       
   168 if (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.King) then
       
   169    ModifyDamage:= hwRound(_0_01 * cDamageModifier * dmg * i * cDamagePercent * _0_5)
       
   170 else
       
   171    ModifyDamage:= hwRound(_0_01 * cDamageModifier * dmg * i * cDamagePercent)
       
   172 end;
       
   173 
       
   174 procedure ApplyDamage(Gear: PGear; AttackerHog: PHedgehog; Damage: Longword; Source: TDamageSource);
       
   175 var s: shortstring;
       
   176     vampDmg, tmpDmg, i: Longword;
       
   177     vg: PVisualGear;
       
   178 begin
       
   179   if Damage = 0 then exit; // nothing to apply
       
   180 
       
   181     if (Gear^.Kind = gtHedgehog) then
       
   182     begin
       
   183     Gear^.LastDamage := AttackerHog;
       
   184 
       
   185     Gear^.Hedgehog^.Team^.Clan^.Flawless:= false;
       
   186     HHHurt(Gear^.Hedgehog, Source);
       
   187     AddDamageTag(hwRound(Gear^.X), hwRound(Gear^.Y), Damage, Gear^.Hedgehog^.Team^.Clan^.Color);
       
   188     tmpDmg:= min(Damage, max(0,Gear^.Health-Gear^.Damage));
       
   189     if (Gear <> CurrentHedgehog^.Gear) and (CurrentHedgehog^.Gear <> nil) and (tmpDmg >= 1) then
       
   190         begin
       
   191         if cVampiric then
       
   192             begin
       
   193             vampDmg:= hwRound(int2hwFloat(tmpDmg)*_0_8);
       
   194             if vampDmg >= 1 then
       
   195                 begin
       
   196                 // was considering pulsing on attack, Tiy thinks it should be permanent while in play
       
   197                 //CurrentHedgehog^.Gear^.State:= CurrentHedgehog^.Gear^.State or gstVampiric;
       
   198                 inc(CurrentHedgehog^.Gear^.Health,vampDmg);
       
   199                 str(vampDmg, s);
       
   200                 s:= '+' + s;
       
   201                 AddCaption(s, CurrentHedgehog^.Team^.Clan^.Color, capgrpAmmoinfo);
       
   202                 RenderHealth(CurrentHedgehog^);
       
   203                 RecountTeamHealth(CurrentHedgehog^.Team);
       
   204                 i:= 0;
       
   205                 while i < vampDmg do
       
   206                     begin
       
   207                     vg:= AddVisualGear(hwRound(CurrentHedgehog^.Gear^.X), hwRound(CurrentHedgehog^.Gear^.Y), vgtStraightShot);
       
   208                     if vg <> nil then
       
   209                         with vg^ do
       
   210                             begin
       
   211                             Tint:= $FF0000FF;
       
   212                             State:= ord(sprHealth)
       
   213                             end;
       
   214                     inc(i, 5);
       
   215                     end;
       
   216                 end
       
   217             end;
       
   218         if ((GameFlags and gfKarma) <> 0) and
       
   219            ((GameFlags and gfInvulnerable) = 0) and
       
   220            (not CurrentHedgehog^.Gear^.Invulnerable) then
       
   221            begin // this cannot just use Damage or it interrupts shotgun and gets you called stupid
       
   222            inc(CurrentHedgehog^.Gear^.Karma, tmpDmg);
       
   223            CurrentHedgehog^.Gear^.LastDamage := CurrentHedgehog;
       
   224            spawnHealthTagForHH(CurrentHedgehog^.Gear, tmpDmg);
       
   225            end;
       
   226         uStats.HedgehogDamaged(Gear, AttackerHog, Damage, false);    
       
   227         end;
       
   228     end else if Gear^.Kind <> gtStructure then // not gtHedgehog nor gtStructure
       
   229         begin
       
   230         Gear^.Hedgehog:= AttackerHog;
       
   231         end;
       
   232     inc(Gear^.Damage, Damage);
       
   233     
       
   234     ScriptCall('onGearDamage', Gear^.UID, Damage);
       
   235 end;
       
   236 
       
   237 procedure spawnHealthTagForHH(HHGear: PGear; dmg: Longword);
       
   238 var tag: PVisualGear;
       
   239 begin
       
   240 tag:= AddVisualGear(hwRound(HHGear^.X), hwRound(HHGear^.Y), vgtHealthTag, dmg);
       
   241 if (tag <> nil) then
       
   242     tag^.Hedgehog:= HHGear^.Hedgehog; // the tag needs the tag to determine the text color
       
   243 AllInactive:= false;
       
   244 HHGear^.Active:= true;
       
   245 end;
       
   246     
       
   247 procedure HHHurt(Hedgehog: PHedgehog; Source: TDamageSource);
       
   248 begin
       
   249 if (Source = dsFall) or (Source = dsExplosion) then
       
   250     case random(3) of
       
   251         0: PlaySound(sndOoff1, Hedgehog^.Team^.voicepack);
       
   252         1: PlaySound(sndOoff2, Hedgehog^.Team^.voicepack);
       
   253         2: PlaySound(sndOoff3, Hedgehog^.Team^.voicepack);
       
   254     end
       
   255 else if (Source = dsPoison) then
       
   256     case random(2) of
       
   257         0: PlaySound(sndPoisonCough, Hedgehog^.Team^.voicepack);
       
   258         1: PlaySound(sndPoisonMoan, Hedgehog^.Team^.voicepack);
       
   259     end
       
   260 else
       
   261     case random(4) of
       
   262         0: PlaySound(sndOw1, Hedgehog^.Team^.voicepack);
       
   263         1: PlaySound(sndOw2, Hedgehog^.Team^.voicepack);
       
   264         2: PlaySound(sndOw3, Hedgehog^.Team^.voicepack);
       
   265         3: PlaySound(sndOw4, Hedgehog^.Team^.voicepack);
       
   266     end
       
   267 end;
       
   268 
       
   269 procedure CheckHHDamage(Gear: PGear);
       
   270 var 
       
   271     dmg: Longword;
       
   272     i: LongInt;
       
   273     particle: PVisualGear;
       
   274 begin
       
   275     if _0_4 < Gear^.dY then
       
   276         begin
       
   277         dmg := ModifyDamage(1 + hwRound((hwAbs(Gear^.dY) - _0_4) * 70), Gear);
       
   278         PlaySound(sndBump);
       
   279         if dmg < 1 then exit;
       
   280 
       
   281         for i:= min(12, (3 + dmg div 10)) downto 0 do
       
   282             begin
       
   283             particle := AddVisualGear(hwRound(Gear^.X) - 5 + Random(10), hwRound(Gear^.Y) + 12, vgtDust);
       
   284             if particle <> nil then particle^.dX := particle^.dX + (Gear^.dX.QWordValue / 21474836480);
       
   285             end;
       
   286 
       
   287         if (Gear^.Invulnerable) then exit;
       
   288 
       
   289         //if _0_6 < Gear^.dY then
       
   290         //    PlaySound(sndOw4, Gear^.Hedgehog^.Team^.voicepack)
       
   291         //else
       
   292         //    PlaySound(sndOw1, Gear^.Hedgehog^.Team^.voicepack);
       
   293 
       
   294         if Gear^.LastDamage <> nil then
       
   295             ApplyDamage(Gear, Gear^.LastDamage, dmg, dsFall)
       
   296             else
       
   297             ApplyDamage(Gear, CurrentHedgehog, dmg, dsFall);
       
   298     end
       
   299 end;
       
   300 
       
   301 
       
   302 procedure CalcRotationDirAngle(Gear: PGear);
       
   303 var 
       
   304     dAngle: real;
       
   305 begin
       
   306     dAngle := (Gear^.dX.QWordValue + Gear^.dY.QWordValue) / $80000000;
       
   307     if not Gear^.dX.isNegative then
       
   308         Gear^.DirAngle := Gear^.DirAngle + dAngle
       
   309     else
       
   310         Gear^.DirAngle := Gear^.DirAngle - dAngle;
       
   311 
       
   312     if Gear^.DirAngle < 0 then Gear^.DirAngle := Gear^.DirAngle + 360
       
   313     else if 360 < Gear^.DirAngle then Gear^.DirAngle := Gear^.DirAngle - 360
       
   314 end;
       
   315 
       
   316 function CheckGearDrowning(Gear: PGear): boolean;
       
   317 var 
       
   318     skipSpeed, skipAngle, skipDecay: hwFloat;
       
   319     i, maxDrops, X, Y: LongInt;
       
   320     vdX, vdY: real;
       
   321     particle: PVisualGear;
       
   322     isSubmersible: boolean;
       
   323 begin
       
   324     isSubmersible:= (Gear = CurrentHedgehog^.Gear) and (CurAmmoGear <> nil) and (CurAmmoGear^.AmmoType = amJetpack);
       
   325     // probably needs tweaking. might need to be in a case statement based upon gear type
       
   326     Y:= hwRound(Gear^.Y);
       
   327     if cWaterLine < Y + Gear^.Radius then
       
   328         begin
       
   329         skipSpeed := _0_25;
       
   330         skipAngle := _1_9;
       
   331         skipDecay := _0_87;
       
   332         X:= hwRound(Gear^.X);
       
   333         vdX:= hwFloat2Float(Gear^.dX);
       
   334         vdY:= hwFloat2Float(Gear^.dY);
       
   335         // this could perhaps be a tiny bit higher.
       
   336         if  (hwSqr(Gear^.dX) + hwSqr(Gear^.dY) > skipSpeed) and
       
   337            (hwAbs(Gear^.dX) > skipAngle * hwAbs(Gear^.dY)) then
       
   338             begin
       
   339             Gear^.dY.isNegative := true;
       
   340             Gear^.dY := Gear^.dY * skipDecay;
       
   341             Gear^.dX := Gear^.dX * skipDecay;
       
   342             CheckGearDrowning := false;
       
   343             PlaySound(sndSkip)
       
   344             end
       
   345         else
       
   346             begin
       
   347             if not isSubmersible then
       
   348                 begin
       
   349                 CheckGearDrowning := true;
       
   350                 Gear^.State := gstDrowning;
       
   351                 Gear^.RenderTimer := false;
       
   352                 if (Gear^.Kind <> gtSniperRifleShot) and (Gear^.Kind <> gtShotgunShot) and 
       
   353                    (Gear^.Kind <> gtDEagleShot) and (Gear^.Kind <> gtSineGunShot) then
       
   354                     if Gear^.Kind = gtHedgehog then
       
   355                         begin
       
   356                         if Gear^.Hedgehog^.Effects[heResurrectable] then
       
   357                             ResurrectHedgehog(Gear)
       
   358                         else
       
   359                             begin
       
   360                             Gear^.doStep := @doStepDrowningGear;
       
   361                             Gear^.State := Gear^.State and (not gstHHDriven);
       
   362                             AddCaption(Format(GetEventString(eidDrowned), Gear^.Hedgehog^.Name), cWhiteColor, capgrpMessage);
       
   363                             end
       
   364                         end
       
   365                     else Gear^.doStep := @doStepDrowningGear;
       
   366                     if Gear^.Kind = gtFlake then exit // skip splashes 
       
   367                 end;
       
   368             if ((not isSubmersible) and (Y < cWaterLine + 64 + Gear^.Radius)) or
       
   369                (isSubmersible and (Y < cWaterLine + 2 + Gear^.Radius) and ((CurAmmoGear^.Pos = 0) and (CurAmmoGear^.dY < _0_01))) then
       
   370                 // don't play splash if they are already way past the surface
       
   371                 PlaySound(sndSplash)
       
   372             end;
       
   373 
       
   374         if ((cReducedQuality and rqPlainSplash) = 0) and 
       
   375            (((not isSubmersible) and (Y < cWaterLine + 64 + Gear^.Radius)) or
       
   376              (isSubmersible and (Y < cWaterLine + 2 + Gear^.Radius) and ((CurAmmoGear^.Pos = 0) and (CurAmmoGear^.dY < _0_01)))) then
       
   377             begin
       
   378             AddVisualGear(X, cWaterLine, vgtSplash);
       
   379 
       
   380             maxDrops := (Gear^.Radius div 2) + round(vdX * Gear^.Radius * 2) + round(vdY * Gear^.Radius * 2);
       
   381             for i:= max(maxDrops div 3, min(32, Random(maxDrops))) downto 0 do
       
   382                 begin
       
   383                 particle := AddVisualGear(X - 3 + Random(6), cWaterLine, vgtDroplet);
       
   384                 if particle <> nil then
       
   385                     begin
       
   386                     particle^.dX := particle^.dX - vdX / 10;
       
   387                     particle^.dY := particle^.dY - vdY / 5;
       
   388                     end
       
   389                 end
       
   390             end;
       
   391         if isSubmersible and (CurAmmoGear^.Pos = 0) then CurAmmoGear^.Pos := 1000
       
   392         end
       
   393     else
       
   394         CheckGearDrowning := false;
       
   395 end;
       
   396 
       
   397 
       
   398 procedure ResurrectHedgehog(gear: PGear);
       
   399 var tempTeam : PTeam;
       
   400 begin
       
   401     AttackBar:= 0;
       
   402     gear^.dX := _0;
       
   403     gear^.dY := _0;
       
   404     gear^.Damage := 0;
       
   405     gear^.Health := gear^.Hedgehog^.InitialHealth;
       
   406     gear^.Hedgehog^.Effects[hePoisoned] := false;
       
   407     if not CurrentHedgehog^.Effects[heResurrectable] then
       
   408         with CurrentHedgehog^ do 
       
   409             begin
       
   410             inc(Team^.stats.AIKills);
       
   411             FreeTexture(Team^.AIKillsTex);
       
   412             Team^.AIKillsTex := RenderStringTex(inttostr(Team^.stats.AIKills), Team^.Clan^.Color, fnt16);
       
   413             end;
       
   414     tempTeam := gear^.Hedgehog^.Team;
       
   415     DeleteCI(gear);
       
   416     FindPlace(gear, false, 0, LAND_WIDTH, true); 
       
   417     if gear <> nil then begin
       
   418         RenderHealth(gear^.Hedgehog^);
       
   419         ScriptCall('onGearResurrect', gear^.uid);
       
   420         gear^.State := gstWait;
       
   421     end;
       
   422     RecountTeamHealth(tempTeam);
       
   423 end;
       
   424 
       
   425 
       
   426 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean);
       
   427 
       
   428     function CountNonZeroz(x, y, r, c: LongInt): LongInt;
       
   429     var i: LongInt;
       
   430         count: LongInt = 0;
       
   431     begin
       
   432     if (y and LAND_HEIGHT_MASK) = 0 then
       
   433         for i:= max(x - r, 0) to min(x + r, LAND_WIDTH - 4) do
       
   434             if Land[y, i] <> 0 then
       
   435                begin
       
   436                inc(count);
       
   437                if count = c then exit(count)
       
   438                end;
       
   439     CountNonZeroz:= count;
       
   440     end;
       
   441 
       
   442 var x: LongInt;
       
   443     y, sy: LongInt;
       
   444     ar: array[0..511] of TPoint;
       
   445     ar2: array[0..1023] of TPoint;
       
   446     cnt, cnt2: Longword;
       
   447     delta: LongInt;
       
   448     reallySkip, tryAgain: boolean;
       
   449 begin
       
   450 reallySkip:= false; // try not skipping proximity at first
       
   451 tryAgain:= true;
       
   452 while tryAgain do
       
   453     begin
       
   454     delta:= 250;
       
   455     cnt2:= 0;
       
   456     repeat
       
   457         x:= Left + LongInt(GetRandom(Delta));
       
   458         repeat
       
   459             inc(x, Delta);
       
   460             cnt:= 0;
       
   461             y:= min(1024, topY) - 2 * Gear^.Radius;
       
   462             while y < cWaterLine do
       
   463                 begin
       
   464                 repeat
       
   465                     inc(y, 2);
       
   466                 until (y >= cWaterLine) or (CountNonZeroz(x, y, Gear^.Radius - 1, 1) = 0);
       
   467 
       
   468                 sy:= y;
       
   469 
       
   470                 repeat
       
   471                     inc(y);
       
   472                 until (y >= cWaterLine) or (CountNonZeroz(x, y, Gear^.Radius - 1, 1) <> 0);
       
   473 
       
   474                 if (y - sy > Gear^.Radius * 2) and
       
   475                    (((Gear^.Kind = gtExplosives)
       
   476                        and (y < cWaterLine)
       
   477                        and (reallySkip or (CheckGearsNear(x, y - Gear^.Radius, [gtFlame, gtHedgehog, gtMine, gtCase, gtExplosives], 60, 60) = nil))
       
   478                        and (CountNonZeroz(x, y+1, Gear^.Radius - 1, Gear^.Radius+1) > Gear^.Radius))
       
   479                    or
       
   480                      ((Gear^.Kind <> gtExplosives)
       
   481                        and (y < cWaterLine)
       
   482                        and (reallySkip or (CheckGearsNear(x, y - Gear^.Radius, [gtFlame, gtHedgehog, gtMine, gtCase, gtExplosives], 110, 110) = nil)))) then
       
   483                     begin
       
   484                     ar[cnt].X:= x;
       
   485                     if withFall then ar[cnt].Y:= sy + Gear^.Radius
       
   486                                 else ar[cnt].Y:= y - Gear^.Radius;
       
   487                     inc(cnt)
       
   488                     end;
       
   489 
       
   490                 inc(y, 45)
       
   491                 end;
       
   492 
       
   493             if cnt > 0 then
       
   494                 with ar[GetRandom(cnt)] do
       
   495                     begin
       
   496                     ar2[cnt2].x:= x;
       
   497                     ar2[cnt2].y:= y;
       
   498                     inc(cnt2)
       
   499                     end
       
   500         until (x + Delta > Right);
       
   501 
       
   502         dec(Delta, 60)
       
   503     until (cnt2 > 0) or (Delta < 70);
       
   504     if (cnt2 = 0) and skipProximity and (not reallySkip) then tryAgain:= true
       
   505     else tryAgain:= false;
       
   506     reallySkip:= true;
       
   507     end;
       
   508 
       
   509 if cnt2 > 0 then
       
   510     with ar2[GetRandom(cnt2)] do
       
   511         begin
       
   512         Gear^.X:= int2hwFloat(x);
       
   513         Gear^.Y:= int2hwFloat(y);
       
   514         AddFileLog('Assigned Gear coordinates (' + inttostr(x) + ',' + inttostr(y) + ')');
       
   515         end
       
   516     else
       
   517     begin
       
   518     OutError('Can''t find place for Gear', false);
       
   519     if Gear^.Kind = gtHedgehog then Gear^.Hedgehog^.Effects[heResurrectable] := false;
       
   520     DeleteGear(Gear);
       
   521     Gear:= nil
       
   522     end
       
   523 end;
       
   524 
       
   525 function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear;
       
   526 var t: PGear;
       
   527 begin
       
   528 t:= GearsList;
       
   529 rX:= sqr(rX);
       
   530 rY:= sqr(rY);
       
   531 
       
   532 while t <> nil do
       
   533     begin
       
   534     if (t <> Gear) and (t^.Kind = Kind) then
       
   535         if not((hwSqr(Gear^.X - t^.X) / rX + hwSqr(Gear^.Y - t^.Y) / rY) > _1) then
       
   536         exit(t);
       
   537     t:= t^.NextGear
       
   538     end;
       
   539 
       
   540 CheckGearNear:= nil
       
   541 end;
       
   542 
       
   543 
       
   544 function CheckGearsNear(mX, mY: LongInt; Kind: TGearsType; rX, rY: LongInt): PGear;
       
   545 var t: PGear;
       
   546 begin
       
   547 t:= GearsList;
       
   548 rX:= sqr(rX);
       
   549 rY:= sqr(rY);
       
   550 while t <> nil do
       
   551     begin
       
   552     if t^.Kind in Kind then
       
   553         if not (hwSqr(int2hwFloat(mX) - t^.X) / rX + hwSqr(int2hwFloat(mY) - t^.Y) / rY > _1) then
       
   554             exit(t);
       
   555     t:= t^.NextGear
       
   556     end;
       
   557 CheckGearsNear:= nil
       
   558 end;
       
   559 end.