PHP DM Gate v0.9 » Проверка пересечений множества прямоугольников. <span class="vd">[Delphi, Windows]</span>

IPranker © (13.04.11 02:57) [0]

Бонжорно.

Пишу игру чисто для себя.
2D. Что-то на вроде танчиков.
Вопрос в том, как находить столкновения между десятками объектов зараз.
Учитывая, что танчик это по сути прямоугольник.
Брут-форсом перебирать объекты (Каждый с Каждым) естественно очень медленно.

Как быть?

<Цитата>
MBo © (13.04.11 10:02) [1]

Например, так - прямоугольники сортируются по левой координате.
Идем по X-координате. Для очередного пр-ка проверяется пересечение с теми, Left которых меньше его Right.

<Цитата>
antonn © (13.04.11 23:23) [2]

> Брут-форсом перебирать объекты (Каждый с Каждым) естественно
> очень медленно.

Вовсе не так уж и напряжно, если там объектов штук 100 можно каждый к каждому перебирать.
Недавно было интересно и доработал какой-то "семпл" игровой, 1000 объектов летали и коллизились с выстреливаемыми пульками, тормозил уже вывод. 30 раз в секунду, множество снарядов (значительно больше чем самих кораблей).
Плюс можно проверять сначала пересечение описывающего Trect перед проверкой коллизий прямоугольников.

<Цитата>
IPranker © (14.04.11 07:04) [3]

Вот написал, для тестов.
Но не правильно почему-то прямоугольники окрашиваются.
Вся канва должна быть по сути красной, а это краснота только местечковая:

Подскажите где ошибка?

uses
Math;

type
TTank = packed record
R : TRect;
IsCollide: boolean;
end;

const
MAX_TANKS = 500;
MAX_SPEED = 2;
TANK_SIZE = 50;

var
FTanks: array [0..MAX_TANKS-1] of TTank; // В 0-вом элементе хранится наш танк.

// Пересекаются ли танки.
function IsTanksCDetect(var T1, T2: TTank): boolean;
var
R: TRect;
begin
Result:= InterSectRect(R, T1.R, T2.R);

T1.IsCollide:= Result;
T2.IsCollide:= Result;
end;

// Брут-Форс метод.
procedure TanksBrutCDetect(OnlyHero: boolean);
var
i, n: LongInt;
begin
// Проверяем только наш танк. (Для тестов)
If OnlyHero then
begin
For i:= 1 to MAX_TANKS - 1 do
IsTanksCDetect(FTanks[0], FTanks[i]);

end else

// Проверяем "каждый с каждым".
begin
For i:= 0 to MAX_TANKS - 1 do
For j:= 0 to MAX_TANKS - 1 do
If (i <> j) // С собой не проверяем.
then IsTanksCDetect(FTanks[i], FTanks[j]);

end;
end;

procedure TanksInit(W, H: LongWord);
var
i: LongWord;
begin
For i:= 0 to MAX_TANKS - 1 do
with FTanks[i] do
begin
SetRect(R, 0, 0, TANK_SIZE, TANK_SIZE);
OffSetRect(R, Random(W), Random(H));
end;
end;

procedure TanksMove;
var
i: LongWord;
begin
For i:= 0 to MAX_TANKS - 1 do
with FTanks[i] do
OffSetRect(R, Random(MAX_SPEED), Random(MAX_SPEED));
end;

procedure TanksDraw(ACanvas: TCanvas);
var
i: LongWord;
begin
For i:= 0 to MAX_TANKS - 1 do
with FTanks[i] do
begin
If (i = 0) // Наш танк.
then ACanvas.Brush.Color:= IfThen(IsCollide, clBlue, clYellow)
else ACanvas.Brush.Color:= IfThen(IsCollide, clRed, clLime);

ACanvas.Rectangle(R);
end;
end;

(******************************************************************************)

procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
DoubleBuffered:= True;

TanksInit(ClientWidth, ClientHeight);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Brush.Color:= clWhite;
Canvas.FillRect(Canvas.ClipRect);

TanksMove;
TanksBrutCDetect(False);
TanksDraw(Canvas);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Invalidate;
end;

<Цитата>
MBo © (14.04.11 08:43) [4]

T1.IsCollide:= T1.IsCollide or Result;

<Цитата>
Sapersky (15.04.11 13:31) [5]

For i:= 0 to MAX_TANKS - 1 do
For j:= i+1 to MAX_TANKS - 1 do

чтобы два раза каждый танк не проверять.

<Цитата>
IPranker © (15.04.11 14:24) [6]

Всем спасибо.
Пока работает. :)

<Цитата>
antonn © (15.04.11 16:03) [7]

я думал там танки смогут поворачиваться и нужно проверять коллизии прямоугольников под разными углами :)

<Цитата>
IPranker © (15.04.11 17:28) [8]

> antonn © (15.04.11 16:03) [7]

Как в классических: 90-180-90-ect. :)
Прямоугольники под разными углами, наверное, вашим дефенсом навеяно? :)

<Цитата>
antonn © (15.04.11 19:07) [9]

Тогда вообще можно было не париться насчет нагрузки :)
у меня вроде нигде небыло коллизий с поворачивающимися прямоугольниками...

<Цитата>
IPranker © (17.04.11 11:20) [10]

Привет всем! :)

Возникло 2 вопроса:
1) Как останавливать танк при коллизии с другим танком?
Т.е. чтобы танки не проходили друг через друга, а упирались в корпус.
2) Проверка пересечений как-то не правильно работает. (См. IsCollide у танков)
В ниже приведённом коде, все танки обездвижены кроме нашего.
Когда происходит коллайд с зелёным танком (Т.е. пока ещё не коллайденный), то он переходит в состояние "Коллайденый".
Стоит только отъехать танчиком, как флаг IsCollide остаётся всегда True.
Хотя проверяем на пересечение несколько раз в секунду.

uses
Math;

type
TTank = packed record
X, Y : LongInt; // Позиция.
W, H : LongInt; // Ширина и высота.
Speed : LongWord; // Скорость.
IsCollide: boolean;
end;

const
MAX_TANKS = 50;
TANK_SIZE = 50;

var
FTanks: array [0..MAX_TANKS-1] of TTank; // В 0-вом элементе хранится наш танк.

// Пересекаются ли танки.
function IsTanksCDetect(var T1, T2: TTank): boolean;
var
R: TRect;
begin
Result:= InterSectRect(R, Rect(T1.X, T1.Y, T1.X + T1.W, T1.Y + T1.H),
Rect(T2.X, T2.Y, T2.X + T2.W, T2.Y + T2.H));

T1.IsCollide:= T1.IsCollide or Result;
T2.IsCollide:= T2.IsCollide or Result;

// T1.IsCollide:= Result; // По идее должно работать, но это увы не так.
// T2.IsCollide:= Result;
end;

// Брут-Форс метод.
procedure TanksBrutCDetect;
var
i, j: LongWord;
begin
For i:= 0 to MAX_TANKS - 1 do
For j:= (i + 1) to MAX_TANKS - 1 do
If (i <> j) // С собой не проверяем.
then IsTanksCDetect(FTanks[i], FTanks[j]);
end;

procedure TanksInit(XW, XH: LongWord);
var
i: LongWord;
begin
For i:= 0 to MAX_TANKS - 1 do
with FTanks[i] do
begin
W := TANK_SIZE;
H := TANK_SIZE;
X := Random(XW);
Y := Random(XH);
Speed:= 1;
end;

FTanks[0].Speed:= 10;
end;

procedure TanksMove;
var
i: LongWord;
begin
For i:= 1 to MAX_TANKS - 1 do
with FTanks[i] do
begin
//

end;
end;

procedure TanksDraw(ACanvas: TCanvas);
var
i: LongWord;
begin
For i:= 0 to MAX_TANKS - 1 do
with FTanks[i] do
begin
If (i = 0) // Наш танк.
then ACanvas.Brush.Color:= IfThen(IsCollide, clBlue, clYellow)
else ACanvas.Brush.Color:= IfThen(IsCollide, clRed, clLime);

ACanvas.Rectangle(Rect(X, Y, X + W, Y + H));
end;
end;

(******************************************************************************)

procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
DoubleBuffered:= True;

TanksInit(ClientWidth, ClientHeight);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Brush.Color:= clWhite;
Canvas.FillRect(Canvas.ClipRect);

// TanksMove;
TanksBrutCDetect;

TanksDraw(Canvas);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
with FTanks[0] do
Case Key of
VK_UP : Dec(Y, Speed);
VK_DOWN : Inc(Y, Speed);
VK_RIGHT: Inc(X, Speed);
VK_LEFT : Dec(X, Speed);
end;
end;

procedure TForm1.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
begin
Invalidate;
end;

<Цитата>
antonn © (18.04.11 00:24) [11]

> // Пересекаются ли танки.
> function IsTanksCDetect(var T1, T2: TTank): boolean;
> var
> R: TRect;
> begin
> Result:= InterSectRect(R, Rect(T1.X, T1.Y, T1.X + T1.W,
> T1.Y + T1.H),
> Rect(T2.X, T2.Y, T2.X + T2.W,
> T2.Y + T2.H));
>
> T1.IsCollide:= T1.IsCollide or Result;
> T2.IsCollide:= T2.IsCollide or Result;
>
> // T1.IsCollide:= Result; // По идее должно работать, но
> это увы не так.
> // T2.IsCollide:= Result;
> end;

вот так побыстрее наверное будет:
function InRectangle(const r1,r2: Trect): Boolean;
begin
result := (r1.left<r2.right) and (r2.left<r1.right) and (r1.top<r2.bottom) and (r2.top<r1.bottom)
end;

я бы ввел несколько флагов коллизий по направлению движения, и от них отталкивался куда можно двигаться, а куда нет

<Цитата>