Delphi custom animation - обнаружение столкновений

Question

Я работаю с пользовательским рисованием/2D-анимацией, и я пытаюсь выяснить, как обнаружить, когда движущийся объект сталкивается со стенкой на карте. Пользователь удерживает клавиши со стрелками на клавиатуре для перемещения объекта, а карта хранится как структура массива точек. Стены в карте могут быть под углом, но без изогнутых стен.

Использование структуры карты (FMap: TMap;) в моем коде ниже, в свойстве DoMove, как определить, сталкивается ли объект с какой-либо стеной на карте и не позволяет ему перемещаться? В DoMove мне нужно прочитать FMap (см. DrawMap, чтобы посмотреть, как работает FMap) и каким-то образом определить, подходит ли объект к любой стене и остановить его.

Я мог бы сделать двойной цикл X/Y, повторяя каждый возможный пиксель между каждыми двумя точками в каждой части каждой карты, но я уже знаю, что это будет тяжело, поскольку эта процедура будет вызвана быстро, пока объект перемещение.

Я думал о чтении цветов пикселей в направлении движения объекта, а если есть черный (из линий карты), считайте его стенкой. Но в конечном итоге будет больше пользовательского рисования фона, поэтому чтение пиксельных цветов не будет работать.

uMain.pas

unit uMain; 

interface 

uses 
    Winapi.Windows, Winapi.Messages, 
    System.SysUtils, System.Variants, System.Classes, 
    Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls; 

const 
    //Window client size 
    MAP_WIDTH = 500; 
    MAP_HEIGHT = 500; 

type 
    TKeyStates = Array[0..255] of Bool; 
    TPoints = Array of TPoint; 
    TMap = Array of TPoints; 

    TForm1 = class(TForm) 
    Tmr: TTimer; 
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 
    procedure TmrTimer(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure FormPaint(Sender: TObject); 
    private 
    FBMain: TBitmap; //Main rendering image 
    FBMap: TBitmap;  //Map image 
    FBObj: TBitmap;  //Object image 
    FKeys: TKeyStates; //Keyboard states 
    FPos: TPoint;  //Current object position 
    FMap: TMap;   //Map line structure 
    procedure Render; 
    procedure DrawObj; 
    procedure DoMove; 
    procedure DrawMap; 
    procedure LoadMap; 
    public 

    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

uses 
    Math, StrUtils; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
    FBMain:= TBitmap.Create; 
    FBMap:= TBitmap.Create; 
    FBObj:= TBitmap.Create; 
    ClientWidth:= MAP_WIDTH; 
    ClientHeight:= MAP_HEIGHT; 
    FBMain.Width:= MAP_WIDTH; 
    FBMain.Height:= MAP_HEIGHT; 
    FBMap.Width:= MAP_WIDTH; 
    FBMap.Height:= MAP_HEIGHT; 
    FBObj.Width:= MAP_WIDTH; 
    FBObj.Height:= MAP_HEIGHT; 
    FBObj.TransparentColor:= clWhite; 
    FBObj.Transparent:= True; 
    FPos:= Point(150, 150); 
    LoadMap; //Load map lines into array structure 
    DrawMap; //Draw map lines to map image only once 
    Tmr.Enabled:= True; 
end; 

procedure TForm1.FormDestroy(Sender: TObject); 
begin 
    Tmr.Enabled:= False; 
    FBMain.Free; 
    FBMap.Free; 
    FBObj.Free; 
end; 

procedure TForm1.LoadMap; 
begin 
    SetLength(FMap, 1);  //Just one object on map 
    //Triangle 
    SetLength(FMap[0], 4); //4 points total 
    FMap[0][0]:= Point(250, 100); 
    FMap[0][1]:= Point(250, 400); 
    FMap[0][2]:= Point(100, 400); 
    FMap[0][3]:= Point(250, 100); 
end; 

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; 
    Shift: TShiftState); 
begin 
    FKeys[Key]:= True; 
end; 

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 
begin 
    FKeys[Key]:= False; 
end; 

procedure TForm1.FormPaint(Sender: TObject); 
begin 
    Canvas.Draw(0, 0, FBMain); //Just draw rendered image to form 
end; 

procedure TForm1.DoMove; 
const 
    SPD = 3; //Speed (pixels per movement) 
var 
    X, Y: Integer; 
    P: TPoints; 
begin 
    //How to keep object from passing through map walls? 
    if FKeys[VK_LEFT] then begin 
    //Check if there's a wall on the left 

    FPos.X:= FPos.X - SPD; 
    end; 
    if FKeys[VK_RIGHT] then begin 
    //Check if there's a wall on the right 

    FPos.X:= FPos.X + SPD; 
    end; 
    if FKeys[VK_UP] then begin 
    //Check if there's a wall on the top 

    FPos.Y:= FPos.Y - SPD; 
    end; 
    if FKeys[VK_DOWN] then begin 
    //Check if there's a wall on the bottom 

    FPos.Y:= FPos.Y + SPD; 
    end; 
end; 

procedure TForm1.DrawMap; 
var 
    C: TCanvas; 
    X, Y: Integer; 
    P: TPoints; 
begin 
    C:= FBMap.Canvas; 
    //Clear image first 
    C.Brush.Style:= bsSolid; 
    C.Pen.Style:= psClear; 
    C.Brush.Color:= clWhite; 
    C.FillRect(C.ClipRect); 
    //Draw map walls 
    C.Brush.Style:= bsClear; 
    C.Pen.Style:= psSolid; 
    C.Pen.Width:= 2; 
    C.Pen.Color:= clBlack; 
    for X := 0 to Length(FMap) - 1 do begin 
    P:= FMap[X]; //One single map object 
    for Y := 0 to Length(P) - 1 do begin 
     if Y = 0 then //First iteration only 
     C.MoveTo(P[Y].X, P[Y].Y) 
     else   //All remaining iterations 
     C.LineTo(P[Y].X, P[Y].Y); 
    end; 
    end; 
end; 

procedure TForm1.DrawObj; 
var 
    C: TCanvas; 
    R: TRect; 
begin 
    C:= FBObj.Canvas; 
    //Clear image first 
    C.Brush.Style:= bsSolid; 
    C.Pen.Style:= psClear; 
    C.Brush.Color:= clWhite; 
    C.FillRect(C.ClipRect); 
    //Draw object in current position 
    C.Brush.Style:= bsClear; 
    C.Pen.Style:= psSolid; 
    C.Pen.Width:= 2; 
    C.Pen.Color:= clRed; 
    R.Left:= FPos.X - 10; 
    R.Right:= FPos.X + 10; 
    R.Top:= FPos.Y - 10; 
    R.Bottom:= FPos.Y + 10; 
    C.Ellipse(R); 
end; 

procedure TForm1.Render; 
begin 
    //Combine map and object images into main image 
    FBMain.Canvas.Draw(0, 0, FBMap); 
    FBMain.Canvas.Draw(0, 0, FBObj); 
    Invalidate; //Repaint 
end; 

procedure TForm1.TmrTimer(Sender: TObject); 
begin 
    DoMove; //Control movement of object 
    DrawObj; //Draw object 
    Render; 
end; 

end. 

uMain.dfm

object Form1: TForm1 
    Left = 315 
    Top = 113 
    BorderIcons = [biSystemMenu] 
    BorderStyle = bsSingle 
    Caption = 'Form1' 
    ClientHeight = 104 
    ClientWidth = 207 
    Color = clBtnFace 
    DoubleBuffered = True 
    Font.Charset = DEFAULT_CHARSET 
    Font.Color = clWindowText 
    Font.Height = -11 
    Font.Name = 'Tahoma' 
    Font.Style = [] 
    OldCreateOrder = False 
    Position = poScreenCenter 
    OnCreate = FormCreate 
    OnDestroy = FormDestroy 
    OnKeyDown = FormKeyDown 
    OnKeyUp = FormKeyUp 
    OnPaint = FormPaint 
    PixelsPerInch = 96 
    TextHeight = 13 
    object Tmr: TTimer 
    Enabled = False 
    Interval = 50 
    OnTimer = TmrTimer 
    Left = 24 
    Top = 8 
    end 
end 

PS - Этот код просто раздели и dummied версию моего полного проекта, чтобы продемонстрировать как работают вещи.

---

EDIT

Я просто понял, что является важным фактором: Прямо сейчас, я реализован только один движущийся объект. Тем не менее, будет много движущихся объектов. Таким образом, столкновение может происходить как с картой, так и с другим объектом (в котором я буду иметь каждый объект в списке). Полный проект по-прежнему очень сырой, как этот образец, но гораздо больше кода, чем имеет значение для этого вопроса.

Answer 1

Я уже на полпути ответил на собственный вопрос в вопросе о себе. Одна вещь, о которой я думал, - это считывать пиксели изображения в направлении движения и проверять, есть ли там линия или нет. Теперь я понимаю, что у меня может быть дополнительный слой под слоем FBMap для фона, и оставим слой карты так, как он есть, только нарисованные стены.

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

Кроме того, если на заднем плане изображения есть изображение, представляющее стены, а не прямые простые линии, то этот слой даже не нужно рисовать вообще. Этот слой можно явно использовать только для сканирования нескольких пикселей перед движением для областей столкновения. На самом деле, так как мне также необходимо распознать столкновение с другими движущимися объектами, я могу также нарисовать все объекты здесь (в черно-белом).

несколько итераций пикселей через холст, например, 20, ничто по сравнению с обширными итераций по карте линий, например, 2000.

Answer 2

Каждый раз, когда нажата клавиша, вы вычисляете новую координату объекта после выполнения перемещения. Затем вы можете проверить пересечения между траекторией объекта и линией на карте.

Поскольку вашу карту можно рассматривать как набор отрезков линии, и учитывая, что ваш путь объекта linear, вы можете найти все возможные столкновения, найдя пересечения между траекторией объекта и линиями, на которых сегменты вашего карта лежит. У вас будет только два наклона для пути объекта: нуль и бесконечность. Поэтому для каждого сегмента карты:

1. Вычислите его склон. Если наклон сегмента карты совпадает с наклоном траектории объекта, они не будут пересекаться.
2. Compute пересечение между линиями, что сегмент карты и путь объекта являются одним (см here например)
3. Проверьте, если сегмент карты заканчивается до точки столкновения: если да, то нет столкновения
4. Проверьте путь объекта заканчивается до точки столкновения: если да, то нет столкновения

Answer 3

этот блок найден в сети (не помню, где, ни один автор не упоминал, возможно, кто-то может предоставить ссылку) даст вам возможность расчетных столкновений и углов отражения.

unit Vector; 

interface 

type 
    TPoint = record 
    X, Y: Double; 
    end; 

    TVector = record 
    X, Y: Double; 
    end; 

    TLine = record 
    P1, P2: TPoint; 
    end; 

function Dist(P1, P2: TPoint): Double; overload; 
function ScalarProd(P1, P2: TVector): Double; 
function ScalarMult(P: TVector; V: Double): TVector; 
function Subtract(V1, V2: TVector): TVector; overload; 
function Subtract(V1, V2: TPoint): TVector; overload; 
function MinDistPoint(Point: TPoint; Line: TLine): TPoint; 
function Mirror(W, V: TVector): TVector; 
function Dist(Point: TPoint; Line: TLine): Double; overload; 

implementation 

function Dist(P1, P2: TPoint): Double; overload; 
begin 
    Result := Sqrt(Sqr(P1.X - P2.X) + Sqr(P1.Y - P2.Y)); 
end; 

function ScalarProd(P1, P2: TVector): Double; 
begin 
    Result := P1.X * P2.X + P1.Y * P2.Y; 
end; 

function ScalarMult(P: TVector; V: Double): TVector; 
begin 
    Result.X := P.X * V; 
    Result.Y := P.Y * V; 
end; 

function Subtract(V1, V2: TVector): TVector; overload; 
begin 
    Result.X := V2.X - V1.X; 
    Result.Y := V2.Y - V1.Y; 
end; 

function Subtract(V1, V2: TPoint): TVector; overload; 
begin 
    Result.X := V2.X - V1.X; 
    Result.Y := V2.Y - V1.Y; 
end; 

function MinDistPoint(Point: TPoint; Line: TLine): TPoint; 
var 
    U: Double; 
    P: TPoint; 
begin 
    U := ((Point.X - Line.P1.X) * (Line.P2.X - Line.P1.X) + 
     (Point.Y - Line.P1.Y) * (Line.P2.Y - Line.P1.Y))/
    (Sqr(Line.P1.X - Line.P2.X) + Sqr(Line.P1.Y - Line.P2.Y)); 
    if U <= 0 then 
    Exit(Line.P1); 
    if U >= 1 then 
    Exit(Line.P2); 
    P.X := Line.P1.X + U * (Line.P2.X - Line.P1.X); 
    P.Y := Line.P1.Y + U * (Line.P2.Y - Line.P1.Y); 
    Exit(P); 
end; 

function Mirror(W, V: TVector): TVector; 
begin 
    Result := Subtract(ScalarMult(V, 2*ScalarProd(v,w)/ScalarProd(v,v)), W); 
end; 

function Dist(Point: TPoint; Line: TLine): Double; overload; 
begin 
    Result := Dist(Point, MinDistPoint(Point, Line)); 
end; 

end. 

Пример реализации будет

unit BSP; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls, Vector, ExtCtrls; 

type 
    TForm2 = class(TForm) 
    Timer1: TTimer; 
    procedure FormPaint(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure Timer1Timer(Sender: TObject); 
    private 
    { Private-Deklarationen } 
    FLines: array of TLine; 
    FP: TPoint; 
    FV: TVector; 
    FBallRadius: Integer; 
    FBallTopLeft: Windows.TPoint; 
    public 
    { Public-Deklarationen } 
    end; 

var 
    Form2: TForm2; 

implementation 

{$R *.dfm} 

procedure TForm2.FormCreate(Sender: TObject); 
const 
    N = 5; 

var 
    I: Integer; 
begin 
    Randomize; 

    SetLength(FLines, 4 + N); 
    FBallRadius := 15; 
    // Walls 
    FLines[0].P1.X := 0; 
    FLines[0].P1.Y := 0; 
    FLines[0].P2.X := Width - 1; 
    FLines[0].P2.Y := 0; 

    FLines[1].P1.X := Width - 1; 
    FLines[1].P1.Y := 0; 
    FLines[1].P2.X := Width - 1; 
    FLines[1].P2.Y := Height - 1; 

    FLines[2].P1.X := Width - 1; 
    FLines[2].P1.Y := Height - 1; 
    FLines[2].P2.X := 0; 
    FLines[2].P2.Y := Height - 1; 

    FLines[3].P1.X := 0; 
    FLines[3].P1.Y := 0; 
    FLines[3].P2.X := 0; 
    FLines[3].P2.Y := Height - 1; 
    for I := 0 to N - 1 do 
    begin 
    FLines[I + 4].P1.X := 50 + Random(Width - 100); 
    FLines[I + 4].P1.Y := 50 + Random(Height - 100); 
    FLines[(I + 1) mod N + 4].P2 := FLines[I + 4].P1; 
    end; 

    FP.X := 50; 
    FP.Y := 50; 

    FV.X := 10; 
    FV.Y := 10; 
end; 

procedure TForm2.FormPaint(Sender: TObject); 
const 
    Iterations = 100; 
var 
    I, MinIndex, J: Integer; 
    MinDist, DP, DH: Double; 
    MP: TPoint; 
    H: TPoint; 
begin 


    for I := 0 to Length(FLines) - 1 do 
    begin 
    Canvas.MoveTo(Round(FLines[I].P1.X), Round(FLines[I].P1.Y)); 
    Canvas.LineTo(Round(FLines[I].P2.X), Round(FLines[I].P2.Y)); 
    end; 

    for I := 0 to Iterations do 
    begin 
    H := FP; 
    FP.X := FP.X + FV.X/Iterations; 
    FP.Y := FP.Y + FV.Y/Iterations; 
    MinDist := Infinite; 
    MinIndex := -1; 
    for J := 0 to Length(FLines) - 1 do 
    begin 
     DP := Dist(FP, FLines[J]); 
     DH := Dist(H, FLines[J]); 
     if (DP < MinDist) and (DP < DH) then 
     begin 
     MinDist := DP; 
     MinIndex := J; 
     end; 
    end; 

    if MinIndex >= 0 then 
     if Sqr(MinDist) < 2*Sqr(FBallRadius * 0.7/2) 
     then 
     begin 
     MP := MinDistPoint(FP, FLines[MinIndex]); 
     FV := Mirror(FV, Subtract(MP, FP)); 
     end; 
    end; 

    FBallTopLeft.X := Round(FP.X - FBallRadius); 
    FBallTopLeft.Y := Round(FP.Y - FBallRadius); 
    Canvas.Brush.Color := clBlue; 
    Canvas.Ellipse(FBallTopLeft.X, FBallTopLeft.Y, 
    FBallTopLeft.X + FBallRadius * 2, FBallTopLeft.Y + FBallRadius * 2); 

end; 

procedure TForm2.Timer1Timer(Sender: TObject); 
begin 
    invalidate; 
end; 

end. 

Answer 4

Если не делать это самостоятельно в порядке, вы можете использовать готовую библиотеку для выполнения этой задачи. Box2D имеет версию Delphi here