hedgewars: comparison hedgewars/uGearsUtils.pas

equal deleted inserted replaced

-:56d2f2d5aad8
+:4feced261c68
 unit uGearsUtils;
 interface
 uses uTypes, uFloat;
 procedure doMakeExplosion(X, Y, Radius: LongInt; AttackingHog: PHedgehog; Mask: Longword); inline;
 procedure doMakeExplosion(X, Y, Radius: LongInt; AttackingHog: PHedgehog; Mask: Longword; const Tint: LongWord);
 function  ModifyDamage(dmg: Longword; Gear: PGear): Longword;
 procedure ApplyDamage(Gear: PGear; AttackerHog: PHedgehog; Damage: Longword; Source: TDamageSource);
 procedure spawnHealthTagForHH(HHGear: PGear; dmg: Longword);
 procedure HHHurt(Hedgehog: PHedgehog; Source: TDamageSource);
 function  GearsNear(X, Y: hwFloat; Kind: TGearType; r: LongInt): PGearArrayS;
 procedure SpawnBoxOfSmth;
 procedure ShotgunShot(Gear: PGear);
 procedure SetAllToActive;
-procedure SetAllHHToActive; inline;
 procedure SetAllHHToActive(Ice: boolean);
+procedure SetAllHHToActive(); inline;
 function  GetAmmo(Hedgehog: PHedgehog): TAmmoType;
 function  GetUtility(Hedgehog: PHedgehog): TAmmoType;
 function WorldWrap(var Gear: PGear): boolean;
 var doStepHandlers: array[TGearType] of TGearStepProcedure;
 implementation
 uses uSound, uCollisions, uUtils, uConsts, uVisualGears, uAIMisc,
 uVariables, uLandGraphics, uScript, uStats, uCaptions, uTeams, uStore,
 uLocale, uTextures, uRenderUtils, uRandom, SDLh, uDebug,
 uGearsList, Math, uVisualGearsList, uGearsHandlersMess,
 uGearsHedgehog;
 procedure doMakeExplosion(X, Y, Radius: LongInt; AttackingHog: PHedgehog; Mask: Longword); inline;
 begin
 King check should be in here instead of ApplyDamage since Tiy wants them kicked less
 *)
 i:= _1;
 if (CurrentHedgehog <> nil) and CurrentHedgehog^.King then
 i:= _1_5;
 if (Gear^.Kind = gtHedgehog) and (Gear^.Hedgehog <> nil) and
 (Gear^.Hedgehog^.King or (Gear^.Hedgehog^.Effects[heFrozen] > 0)) then
 ModifyDamage:= hwRound(cDamageModifier * dmg * i * cDamagePercent * _0_5 * _0_01)
 else
 ModifyDamage:= hwRound(cDamageModifier * dmg * i * cDamagePercent * _0_01)
 end;
 end;
 inc(i, 5);
 end;
 end
 end;
 if (GameFlags and gfKarma <> 0) and (GameFlags and gfInvulnerable = 0) and
 (CurrentHedgehog^.Effects[heInvulnerable] = 0) then
 begin // this cannot just use Damage or it interrupts shotgun and gets you called stupid
 inc(CurrentHedgehog^.Gear^.Karma, tmpDmg);
 CurrentHedgehog^.Gear^.LastDamage := CurrentHedgehog;
 spawnHealthTagForHH(CurrentHedgehog^.Gear, tmpDmg);
 end;
 uStats.HedgehogDamaged(Gear, AttackerHog, Damage, false);
 end;
 end else
 //else if Gear^.Kind <> gtStructure then // not gtHedgehog nor gtStructure
 Gear^.Hedgehog:= AttackerHog;
 inc(Gear^.Damage, Damage);
 ScriptCall('onGearDamage', Gear^.UID, Damage);
 end;
 procedure spawnHealthTagForHH(HHGear: PGear; dmg: Longword);
 var tag: PVisualGear;
 if (tag <> nil) then
 tag^.Hedgehog:= HHGear^.Hedgehog; // the tag needs the tag to determine the text color
 AllInactive:= false;
 HHGear^.Active:= true;
 end;
 procedure HHHurt(Hedgehog: PHedgehog; Source: TDamageSource);
 begin
 if Hedgehog^.Effects[heFrozen] <> 0 then exit;
 if (Source = dsFall) or (Source = dsExplosion) then
 case random(3) of
 3: PlaySoundV(sndOw4, Hedgehog^.Team^.voicepack);
 end
 end;
 procedure CheckHHDamage(Gear: PGear);
 var
 dmg: LongInt;
 i: LongWord;
 particle: PVisualGear;
 begin
 if _0_4 < Gear^.dY then
 end
 end;
 procedure CalcRotationDirAngle(Gear: PGear);
 var
 dAngle: real;
 begin
 // Frac/Round to be kind to JS as of 2012-08-27 where there is yet no int64/uint64
 //dAngle := (Gear^.dX.QWordValue + Gear^.dY.QWordValue) / $80000000;
 dAngle := (Gear^.dX.Round + Gear^.dY.Round) / 2 + (Gear^.dX.Frac/$100000000+Gear^.dY.Frac/$100000000);
 else if 360 < Gear^.DirAngle then
 Gear^.DirAngle := Gear^.DirAngle - 360
 end;
 function CheckGearDrowning(var Gear: PGear): boolean;
 var
 skipSpeed, skipAngle, skipDecay: hwFloat;
 i, maxDrops, X, Y: LongInt;
 vdX, vdY: real;
 particle, splash: PVisualGear;
 isSubmersible: boolean;
 skipDecay := _0_87;
 X:= hwRound(Gear^.X);
 vdX:= hwFloat2Float(Gear^.dX);
 vdY:= hwFloat2Float(Gear^.dY);
 // this could perhaps be a tiny bit higher.
 if  (cWaterLine + 64 + Gear^.Radius > Y) and (hwSqr(Gear^.dX) + hwSqr(Gear^.dY) > skipSpeed)
 and (hwAbs(Gear^.dX) > skipAngle * hwAbs(Gear^.dY)) then
 begin
 Gear^.dY.isNegative := true;
 Gear^.dY := Gear^.dY * skipDecay;
 Gear^.dX := Gear^.dX * skipDecay;
 end
 end
 else
 Gear^.doStep := @doStepDrowningGear;
 if Gear^.Kind = gtFlake then
 exit // skip splashes
 end
 else if (Y > cWaterLine + cVisibleWater*4) and
 ((Gear <> CurrentHedgehog^.Gear) or (CurAmmoGear = nil) or (CurAmmoGear^.State and gstSubmersible = 0)) then
 Gear^.doStep:= @doStepDrowningGear;
 if ((not isSubmersible) and (Y < cWaterLine + 64 + Gear^.Radius))
 or (isSubmersible and (Y < cWaterLine + 2 + Gear^.Radius) and (Gear = CurAmmoGear) and ((CurAmmoGear^.Pos = 0)
 and (CurAmmoGear^.dY < _0_01))) then
 if Gear^.Density * Gear^.dY > _1 then
 PlaySound(sndSplash)
 else if Gear^.Density * Gear^.dY > _0_5 then
 PlaySound(sndSkip)
 else
 PlaySound(sndDroplet2);
 end;
 and (((not isSubmersible) and (Y < cWaterLine + 64 + Gear^.Radius))
 or (isSubmersible and (Y < cWaterLine + 2 + Gear^.Radius) and (Gear = CurAmmoGear) and ((CurAmmoGear^.Pos = 0)
 and (CurAmmoGear^.dY < _0_01)))) then
 begin
 splash:= AddVisualGear(X, cWaterLine, vgtSplash);
 if splash <> nil then
 with splash^ do
 begin
 Scale:= hwFloat2Float(Gear^.Density / _3 * Gear^.dY);
 if Scale > 1 then Scale:= power(Scale,0.3333)
 else Scale:= Scale + ((1-Scale) / 2);
 begin
 dX := dX - vdX / 10;
 dY := dY - vdY / 5;
 if splash <> nil then
 begin
 if splash^.Scale > 1 then
 begin
 dX:= dX * power(splash^.Scale,0.3333); // tone down the droplet height further
 dY:= dY * power(splash^.Scale, 0.3333)
 end
 else
 begin
 dX:= dX * splash^.Scale;
 dY:= dY * splash^.Scale
 end
 end
 if isSubmersible and (Gear = CurAmmoGear) and (CurAmmoGear^.Pos = 0) then
 CurAmmoGear^.Pos := 1000
 end
 else
 begin
-if not (Gear^.Kind in [gtJetpack, gtBee]) then Gear^.State:= Gear^.State and not gstSubmersible;  // making it temporary for most gears is more attractive I think
+if (not ((Gear^.Kind = gtJetpack) or (Gear^.Kind = gtBee))) then
+Gear^.State:= (Gear^.State and (not gstSubmersible));  // making it temporary for most gears is more attractive I think
 CheckGearDrowning := false
 end
 end;
 gear^.Damage := 0;
 gear^.Health := gear^.Hedgehog^.InitialHealth;
 gear^.Hedgehog^.Effects[hePoisoned] := 0;
 if (CurrentHedgehog^.Effects[heResurrectable] = 0) or ((CurrentHedgehog^.Effects[heResurrectable] <> 0)
 and (Gear^.Hedgehog^.Team^.Clan <> CurrentHedgehog^.Team^.Clan)) then
 with CurrentHedgehog^ do
 begin
 inc(Team^.stats.AIKills);
 FreeTexture(Team^.AIKillsTex);
 Team^.AIKillsTex := RenderStringTex(inttostr(Team^.stats.AIKills), Team^.Clan^.Color, fnt16);
 end;
 if sparkles <> nil then
 begin
 sparkles^.Tint:= tempTeam^.Clan^.Color shl 8 or $FF;
 //sparkles^.Angle:= random(360);
 end;
 FindPlace(gear, false, 0, LAND_WIDTH, true);
 if gear <> nil then
 begin
 AddVisualGear(hwRound(gear^.X), hwRound(gear^.Y), vgtExplosion);
 PlaySound(sndWarp);
 RenderHealth(gear^.Hedgehog^);
 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean);
 var x: LongInt;
 y, sy: LongInt;
 ar: array[0..1023] of TPoint;
 ar2: array[0..2047] of TPoint;
+temp: TPoint;
 cnt, cnt2: Longword;
 delta: LongInt;
 ignoreNearObjects, ignoreOverlap, tryAgain: boolean;
 begin
 ignoreNearObjects:= false; // try not skipping proximity at first
 ignoreOverlap:= false; // this not only skips proximity, but allows overlapping objects (barrels, mines, hogs, crates).  Saving it for a 3rd pass.  With this active, winning AI Survival goes back to virtual impossibility
 tryAgain:= true;
 if WorldEdge <> weNone then
 begin
 Left:= max(Left, LongInt(leftX) + Gear^.Radius);
 Right:= min(Right,rightX-Gear^.Radius)
 end;
 while tryAgain do
 while y < cWaterLine do
 begin
 repeat
 inc(y, 2);
 until (y >= cWaterLine) or
-(not ignoreOverlap and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, $FFFF) = 0)) or
+((not ignoreOverlap) and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, $FFFF) = 0)) or
 (ignoreOverlap and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, lfLandMask) = 0));
 sy:= y;
 repeat
 inc(y);
 until (y >= cWaterLine) or
-(not ignoreOverlap and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, $FFFF) <> 0)) or
+((not ignoreOverlap) and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, $FFFF) <> 0)) or
 (ignoreOverlap and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, lfLandMask) <> 0));
 if (y - sy > Gear^.Radius * 2)
 and (((Gear^.Kind = gtExplosives)
 and (y < cWaterLine)
 and (ignoreNearObjects or NoGearsToAvoid(x, y - Gear^.Radius, 60, 60))
 inc(y, 10)
 end;
 if cnt > 0 then
-with ar[GetRandom(cnt)] do
+begin
+temp := ar[GetRandom(cnt)];
+with temp do
 begin
 ar2[cnt2].x:= x;
 ar2[cnt2].y:= y;
 inc(cnt2)
 end
+end
 until (x + Delta > Right);
 dec(Delta, 60)
 until (cnt2 > 0) or (Delta < 70);
 // if either of these has not been tried, do another pass
 if ignoreNearObjects then ignoreOverlap:= true;
 ignoreNearObjects:= true;
 end;
 if cnt2 > 0 then
-with ar2[GetRandom(cnt2)] do
+begin
+temp := ar2[GetRandom(cnt2)];
+with temp do
 begin
 Gear^.X:= int2hwFloat(x);
 Gear^.Y:= int2hwFloat(y);
 AddFileLog('Assigned Gear coordinates (' + inttostr(x) + ',' + inttostr(y) + ')');
 end
+end
 else
 begin
 OutError('Can''t find place for Gear', false);
 if Gear^.Kind = gtHedgehog then
 Gear^.Hedgehog^.Effects[heResurrectable] := 0;
 procedure CheckCollisionWithLand(Gear: PGear); inline;
 begin
 if (TestCollisionX(Gear, hwSign(Gear^.dX)) <> 0)
 or (TestCollisionY(Gear, hwSign(Gear^.dY)) <> 0) then
 Gear^.State := Gear^.State or gstCollision
 else
 Gear^.State := Gear^.State and (not gstCollision)
 end;
 function MakeHedgehogsStep(Gear: PGear) : boolean;
 begin
 Ammo^.Health:= 0;
 while i > 0 do
 begin
 dec(i);
 Gear:= t^.ar[i];
 if ((Ammo^.Kind = gtFlame) or (Ammo^.Kind = gtBlowTorch)) and
 (Gear^.Kind = gtHedgehog) and (Gear^.Hedgehog^.Effects[heFrozen] > 255) then
 Gear^.Hedgehog^.Effects[heFrozen]:= max(255,Gear^.Hedgehog^.Effects[heFrozen]-10000);
 tmpDmg:= ModifyDamage(Damage, Gear);
 if (Gear^.State and gstNoDamage) = 0 then
 begin
 if (Ammo^.Kind = gtDEagleShot) or (Ammo^.Kind = gtSniperRifleShot) then
 begin
 VGear := AddVisualGear(hwround(Ammo^.X), hwround(Ammo^.Y), vgtBulletHit);
 if VGear <> nil then
 VGear^.Angle := DxDy2Angle(-Ammo^.dX, Ammo^.dY);
 end;
 end;
 ApplyDamage(Gear, Ammo^.Hedgehog, tmpDmg, dsShove)
 end
 else
 Gear^.State:= Gear^.State or gstWinner;
 if (Gear^.Kind = gtExplosives) and (Ammo^.Kind = gtBlowtorch) then
 begin
 if (Ammo^.Hedgehog^.Gear <> nil) then
 Ammo^.Hedgehog^.Gear^.State:= Ammo^.Hedgehog^.Gear^.State and (not gstNotKickable);
 ApplyDamage(Gear, Ammo^.Hedgehog, tmpDmg * 100, dsUnknown); // crank up damage for explosives + blowtorch
 end;
 begin
 r:= r*r;
 s:= 0;
 SetLength(GearsNearArray, s);
 t := GearsList;
 while t <> nil do
 begin
 if (t^.Kind = Kind)
 and ((X - t^.X)*(X - t^.X) + (Y - t^.Y)*(Y-t^.Y) < int2hwFloat(r)) then
 begin
 inc(s);
 SetLength(GearsNearArray, s);
 GearsNearArray[s - 1] := t;
 begin
 LeftImpactTimer:= 333;
 Gear^.dX.isNegative:= false;
 Gear^.X:= int2hwfloat(LongInt(leftX) + Gear^.Radius)
 end
 else
 begin
 RightImpactTimer:= 333;
 Gear^.dX.isNegative:= true;
 Gear^.X:= int2hwfloat(rightX-Gear^.Radius)
 end;
 PlaySound(sndMelonImpact)
 end
 else if WorldEdge = weSea then
 begin
 if (hwRound(Gear^.Y) > cWaterLine) and (Gear^.State and gstSubmersible <> 0) then
-Gear^.State:= Gear^.State and not gstSubmersible
+Gear^.State:= Gear^.State and (not gstSubmersible)
 else
 begin
 Gear^.State:= Gear^.State or gstSubmersible;
 Gear^.X:= int2hwFloat(PlayWidth)*int2hwFloat(min(max(0,hwRound(Gear^.Y)),PlayHeight))/PlayHeight;
 Gear^.Y:= int2hwFloat(cWaterLine+cVisibleWater+Gear^.Radius*2);
 end;
 (*
 * Window in the sky (Gear moved high into the sky, Y is used to determine X) [unfortunately, not a safe thing to do. shame, I thought aerial bombardment would be kinda neat
 This one would be really easy to freeze game unless it was flagged unfortunately.
 else
 begin
 Gear^.X:= int2hwFloat(PlayWidth)*int2hwFloat(min(max(0,hwRound(Gear^.Y)),PlayHeight))/PlayHeight;
 Gear^.Y:= -_2048-_256-_256;
 tdx:= Gear^.dX;
 Gear^.dX:= Gear^.dY;

changeset 10015	4feced261c68
parent 10012	82dd9f0c88f7
parent 9954	bf51bc7e2808
child 10105	8c5fa1d15bd5