hedgewars: comparison hedgewars/uGears.pas

equal deleted inserted replaced

-:c4170faf7b0a
+:0cf2edcfdd8f
 dLen: hwFloat;
 b: boolean;
 end;
 end;
-procedure DeleteGear(var Gear: PGear); forward;
+procedure DeleteGear(Gear: PGear); forward;
 procedure doMakeExplosion(X, Y, Radius: LongInt; Mask: LongWord); forward;
 procedure AmmoShove(Ammo: PGear; Damage, Power: LongInt); forward;
 //procedure AmmoFlameWork(Ammo: PGear); forward;
 function  CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear; forward;
 procedure SpawnBoxOfSmth; forward;
 procedure AfterAttack; forward;
-procedure FindPlace(Gear: PGear; withFall: boolean; Left, Right: LongInt); forward;
+procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt); forward;
 procedure HedgehogStep(Gear: PGear); forward;
 procedure HedgehogChAngle(Gear: PGear); forward;
 procedure ShotgunShot(Gear: PGear); forward;
 {$INCLUDE GSHandlers.inc}
 end;
 InsertGearToList(Result);
 AddGear:= Result
 end;
-procedure DeleteGear(var Gear: PGear);
+procedure DeleteGear(Gear: PGear);
 var team: PTeam;
-t: Longword;
+	t: Longword;
 begin
 DeleteCI(Gear);
 if Gear^.Tex <> nil then
 	begin
 			t:= max(Gear^.Damage, Gear^.Health);
 			Gear^.Damage:= t;
 			AddGear(hwRound(Gear^.X), hwRound(Gear^.Y), gtHealthTag, t, _0, _0, 0)^.Hedgehog:= Gear^.Hedgehog;
 			uStats.HedgehogDamaged(Gear)
 			end;
 		team:= PHedgehog(Gear^.Hedgehog)^.Team;
 		if CurrentHedgehog^.Gear = Gear then
 			FreeActionsList; // to avoid ThinkThread on drawned gear
 		PHedgehog(Gear^.Hedgehog)^.Gear:= nil;
 		inc(KilledHHs);
-		RecountTeamHealth(team);
+		RecountTeamHealth(team)
 		end;
 {$IFDEF DEBUGFILE}
 with Gear^ do AddFileLog('Delete: #' + inttostr(uid) + ' (' + inttostr(hwRound(x)) + ',' + inttostr(hwRound(y)) + '), d(' + floattostr(dX) + ',' + floattostr(dY) + ') type = ' + inttostr(ord(Kind)));
 {$ENDIF}
 if Gear^.TriggerId <> 0 then TickTrigger(Gear^.TriggerId);
 if CurAmmoGear = Gear then CurAmmoGear:= nil;
 if FollowGear = Gear then FollowGear:= nil;
 RemoveGearFromList(Gear);
-Dispose(Gear);
+Dispose(Gear)
-Gear:= nil
 end;
 function CheckNoDamage: boolean; // returns TRUE in case of no damaged hhs
 var Gear: PGear;
 begin
 	end;
 end;
 procedure AddMiscGears;
 var i: LongInt;
+	Gear: PGear;
 begin
 AddGear(0, 0, gtATStartGame, 0, _0, _0, 2000);
 if (GameFlags and gfForts) = 0 then
 	for i:= 0 to Pred(cLandAdditions) do
-		FindPlace(AddGear(0, 0, gtMine, 0, _0, _0, 0), false, 0, 2048);
+		begin
+		Gear:= AddGear(0, 0, gtMine, 0, _0, _0, 0);
+		FindPlace(Gear, false, 0, 2048)
+		end
 end;
 procedure doMakeExplosion(X, Y, Radius: LongInt; Mask: LongWord);
 var Gear: PGear;
 dmg, dmgRadius: LongInt;
 SetAllToActive
 end;
 procedure AssignHHCoords;
 var i, t, p, j: LongInt;
-ar: array[0..Pred(cMaxHHs)] of PGear;
+ar: array[0..Pred(cMaxHHs)] of PHedgehog;
 Count: Longword;
 begin
 if (GameFlags and (gfForts or gfDivideTeams)) <> 0 then
 	begin
 	t:= 0;
 				with Teams[j]^ do
 					for i:= 0 to cMaxHHIndex do
 						with Hedgehogs[i] do
 							if (Gear <> nil) and (Gear^.X.QWordValue = 0) then
 								begin
-								FindPlace(Gear, false, t, t + 1024);
+								FindPlace(Gear, false, t, t + 1024);// could make Gear == nil
-								Gear^.Pos:= GetRandom(19);
+								if Gear <> nil then
-								Gear^.dX.isNegative:= p = 1;
+									begin
+									Gear^.Pos:= GetRandom(19);
+									Gear^.dX.isNegative:= p = 1;
+									end
 								end;
 		inc(t, 1024)
 		end
 	end else // mix hedgehogs
 	begin
 		begin
 		for i:= 0 to cMaxHHIndex do
 			with Hedgehogs[i] do
 				if (Gear <> nil) and (Gear^.X.QWordValue = 0) then
 					begin
-					ar[Count]:= Gear;
+					ar[Count]:= @Hedgehogs[i];
 					inc(Count)
 					end;
 		end;
 	while (Count > 0) do
 		begin
 		i:= GetRandom(Count);
-		FindPlace(ar[i], false, 0, 2048);
+		FindPlace(ar[i]^.Gear, false, 0, 2048);
-		ar[i]^.dX.isNegative:= ar[i]^.X > _1024;
+		if ar[i]^.Gear <> nil then
-		ar[i]^.Pos:= GetRandom(19);
+			begin
-		ar[i]:= ar[Count - 1];
+			ar[i]^.Gear^.dX.isNegative:= ar[i]^.Gear^.X > _1024;
+			ar[i]^.Gear^.Pos:= GetRandom(19);
+			ar[i]:= ar[Count - 1]
+			end;
 		dec(Count)
 		end
 	end
 end;
 begin
 t:= GearsList;
 rX:= sqr(rX);
 rY:= sqr(rY);
 while t <> nil do
-begin
+	begin
-if t^.Kind in Kind then
+	if t^.Kind in Kind then
-if not (hwSqr(int2hwFloat(mX) - t^.X) / rX + hwSqr(int2hwFloat(mY) - t^.Y) / rY > _1) then
+		if not (hwSqr(int2hwFloat(mX) - t^.X) / rX + hwSqr(int2hwFloat(mY) - t^.Y) / rY > _1) then
-exit(t);
+			exit(t);
-t:= t^.NextGear
+	t:= t^.NextGear
-end;
+	end;
 CheckGearsNear:= nil
 end;
 function CountGears(Kind: TGearType): Longword;
 var t: PGear;
 Result: Longword;
 begin
 Result:= 0;
 t:= GearsList;
 while t <> nil do
-begin
+	begin
-if t^.Kind = Kind then inc(Result);
+	if t^.Kind = Kind then inc(Result);
-t:= t^.NextGear
+	t:= t^.NextGear
-end;
+	end;
 CountGears:= Result
 end;
 procedure SpawnBoxOfSmth;
 var t: LongInt;
 end;
 end;
 FindPlace(FollowGear, true, 0, 2048)
 end;
-procedure FindPlace(Gear: PGear; withFall: boolean; Left, Right: LongInt);
+procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt);
-function CountNonZeroz(x, y, r: LongInt): LongInt;
+	function CountNonZeroz(x, y, r: LongInt): LongInt;
-var i: LongInt;
+	var i: LongInt;
-Result: LongInt;
+		Result: LongInt;
-begin
+	begin
-Result:= 0;
+	Result:= 0;
-if (y and $FFFFFC00) = 0 then
+	if (y and $FFFFFC00) = 0 then
-for i:= max(x - r, 0) to min(x + r, 2043) do
+		for i:= max(x - r, 0) to min(x + r, 2043) do
-if Land[y, i] <> 0 then inc(Result);
+			if Land[y, i] <> 0 then inc(Result);
-CountNonZeroz:= Result
+	CountNonZeroz:= Result
-end;
+	end;
 var x: LongInt;
-y, sy: LongInt;
+	y, sy: LongInt;
-ar: array[0..511] of TPoint;
+	ar: array[0..511] of TPoint;
-ar2: array[0..1023] of TPoint;
+	ar2: array[0..1023] of TPoint;
-cnt, cnt2: Longword;
+	cnt, cnt2: Longword;
-delta: LongInt;
+	delta: LongInt;
 begin
 delta:= 250;
 cnt2:= 0;
 repeat
-x:= Left + LongInt(GetRandom(Delta));
+	x:= Left + LongInt(GetRandom(Delta));
-repeat
+	repeat
-inc(x, Delta);
+		inc(x, Delta);
-cnt:= 0;
+		cnt:= 0;
-y:= -Gear^.Radius * 2;
+		y:= -Gear^.Radius * 2;
-while y < 1023 do
+		while y < 1023 do
-begin
+			begin
-repeat
+			repeat
-inc(y, 2);
+				inc(y, 2);
-until (y > 1023) or (CountNonZeroz(x, y, Gear^.Radius - 1) = 0);
+			until (y > 1023) or (CountNonZeroz(x, y, Gear^.Radius - 1) = 0);
-sy:= y;
-repeat
+			sy:= y;
-inc(y);
-until (y > 1023) or (CountNonZeroz(x, y, Gear^.Radius - 1) <> 0);
+			repeat
-if (y - sy > Gear^.Radius * 2)
+				inc(y);
-and (y < 1023)
+			until (y > 1023) or (CountNonZeroz(x, y, Gear^.Radius - 1) <> 0);
-and (CheckGearsNear(x, y - Gear^.Radius, [gtHedgehog, gtMine, gtCase], 110, 110) = nil) then
-begin
+			if (y - sy > Gear^.Radius * 2)
-ar[cnt].X:= x;
+				and (y < 1023)
-if withFall then ar[cnt].Y:= sy + Gear^.Radius
+				and (CheckGearsNear(x, y - Gear^.Radius, [gtHedgehog, gtMine, gtCase], 110, 110) = nil) then
-else ar[cnt].Y:= y - Gear^.Radius;
+				begin
-inc(cnt)
+				ar[cnt].X:= x;
-end;
+				if withFall then ar[cnt].Y:= sy + Gear^.Radius
-inc(y, 45)
+							else ar[cnt].Y:= y - Gear^.Radius;
-end;
+				inc(cnt)
-if cnt > 0 then
+				end;
-with ar[GetRandom(cnt)] do
-begin
+			inc(y, 45)
-ar2[cnt2].x:= x;
+			end;
-ar2[cnt2].y:= y;
-inc(cnt2)
+		if cnt > 0 then
-end
+			with ar[GetRandom(cnt)] do
-until (x + Delta > Right);
+				begin
-dec(Delta, 60)
+				ar2[cnt2].x:= x;
+				ar2[cnt2].y:= y;
+				inc(cnt2)
+				end
+	until (x + Delta > Right);
+	dec(Delta, 60)
 until (cnt2 > 0) or (Delta < 70);
 if cnt2 > 0 then
-with ar2[GetRandom(cnt2)] do
+	with ar2[GetRandom(cnt2)] do
-begin
+		begin
-Gear^.X:= int2hwFloat(x);
+		Gear^.X:= int2hwFloat(x);
-Gear^.Y:= int2hwFloat(y);
+		Gear^.Y:= int2hwFloat(y);
-{$IFDEF DEBUGFILE}
+		{$IFDEF DEBUGFILE}
-AddFileLog('Assigned Gear coordinates (' + inttostr(x) + ',' + inttostr(y) + ')');
+		AddFileLog('Assigned Gear coordinates (' + inttostr(x) + ',' + inttostr(y) + ')');
-{$ENDIF}
+		{$ENDIF}
-end
+		end
-else
+	else
-begin
+	begin
-OutError('Can''t find place for Gear', false);
+	OutError('Can''t find place for Gear', false);
-DeleteGear(Gear)
+	DeleteGear(Gear);
-end
+	Gear:= nil
+	end
 end;
 initialization
 finalization

changeset 1515	0cf2edcfdd8f
parent 1506	a4ab75470ce1
child 1528	3fee15104c1d