[Shpingalet]

Помогите, пожалуйста, с проблемой, возникшей в процессе написания простого арканоида. Дело в том, что не правильно работает обработка столкновений шарика с блоками. Иногда шарик отскакивает правильно, а иногда пролетает сквозь блоки, подвешивая программу. Проверка столкновения происходит по 6 точкам (по двум слева - сверху и снизу спрайта, 2 сверху - слева и справа, 2 справа - сверху и снизу).

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, DXDraws, DXInput, DXClass, DXSprite, math;

type
  TForm1 = class(TDXForm)
    DXDraw1: TDXDraw;
    DXSpriteEngine1: TDXSpriteEngine;
    DXTimer1: TDXTimer;
    DXImageList1: TDXImageList;
    DXInput1: TDXInput;
    procedure DXTimer1Timer(Sender: TObject; LagCount: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  vector: integer;
  map: array[0..9,0..9] of byte;
  i,j,speed:byte;


implementation

{$R *.dfm}
type

TMapSprite = class(TImageSprite);

TBaseSprite = class(TImageSprite)
  protected
    procedure DoMove(MoveCount: Integer); override;
  end;

TBallSprite = class(TImageSprite)
  protected
    procedure DoCollision(Sprite: TSprite; var Done: Boolean); override;
    procedure DoMove(MoveCount: Integer); override;
  end;

Procedure TBallSprite.DoMove(MoveCount: Integer);
  Begin
    inherited DoMove(MoveCount);
    if  y>form1.DXDraw1.SurfaceHeight-image.Height then  //если шарик бьется о низ экрана, то прогирали
      halt;
    if  x>form1.DXDraw1.SurfaceWidth-image.Width  then   //отражение от правой стенки экрана
      if vector<=180 then
        begin
          vector:=180-vector;
          x:=form1.DXDraw1.SurfaceWidth-image.Width+cos(degtorad(vector))*speed;
        end else
        begin
          vector:=540-vector;
          x:=form1.DXDraw1.SurfaceWidth-image.Width+cos(degtorad(vector))*speed;
        end;
    if  y<0 then
      begin                                               //отражение от верха экрана
        vector:=360-vector;
        y:=-sin(degtorad(vector))*speed;
      end;
    if  x<0 then                                          //отражение от левой стенки экрана
      if vector<=180 then
        begin
          vector:=180-vector;
          x:=cos(degtorad(vector))*speed;
        end else
        begin
          vector:=540-vector;
          x:=cos(degtorad(vector))*speed;
        end;
    collision;
    x:=x+cos(degtorad(vector))*speed;                     //перемещение
    y:=y-sin(degtorad(vector))*speed;                      //шарика
  end;

procedure TBallSprite.DoCollision(Sprite: TSprite; var Done: Boolean);
  begin

    if Sprite is TBaseSprite then                        //столкновение с базой
      if isLeft in Form1.DXInput1.States then
        begin
          vector:=380-vector;                     {при движении базы к углу полета шарика добавляется 20 градусов в сторону движения базы}
          y:=y-sin(degtorad(vector))*speed;
        end else
      if isRight in Form1.DXInput1.States then
        begin
          vector:=340-vector;
          y:=y-sin(degtorad(vector))*speed;
        end else
        begin
          vector:=360-vector;
          y:=y-sin(degtorad(vector))*speed;
        end;

    if Sprite is TMapSprite then                           // проверка на столкновение шарика с блоком, если ДА, то идет проверка - с какой стороны
      if (form1.DXdraw1.Surface.canvas.Pixels[round(x-1),round(y)]<>57536)or(form1.DXdraw1.Surface.canvas.Pixels[round(x-1),round(y+10)]<>57536) then
        begin                                              //если столкновение с левой стороны (57536 - цвет фона)
          if vector<=180 then
            begin
              vector:=180-vector;
              x:=x+cos(degtorad(vector))*speed;
            end else
            begin
              vector:=540-vector;
              x:=x+cos(degtorad(vector))*speed;
            end;
        end else
      if (form1.DXdraw1.Surface.canvas.Pixels[round(x),round(y)-5]<>57536)or(form1.DXdraw1.Surface.canvas.Pixels[round(x)+10,round(y)-5]<>57536) then
        begin                                                 // если столкновение сверху
          vector:=360-vector;
          y:=y-sin(degtorad(vector))*speed;
        end else
      if (form1.DXdraw1.Surface.canvas.Pixels[round(x)+15,round(y)]<>57536)or(form1.DXdraw1.Surface.canvas.Pixels[round(x)+15,round(y)+10]<>57536) then
        begin                                                  //если столкновение справа
          if vector<=180 then
            begin
              vector:=180-vector;
              x:=x+cos(degtorad(vector))*speed;
            end else
            begin
              vector:=540-vector;
              x:=x+cos(degtorad(vector))*speed;
            end;
        end else
        begin                                               // если столкновение снизу
          if vector<=180 then
            begin
              vector:=180-vector;
              y:=y-sin(degtorad(vector))*speed;
            end else
            begin
              vector:=360-vector;
              y:=y-sin(degtorad(vector))*speed;
            end;
        end;

  end;

Procedure TBaseSprite.DoMove(MoveCount: Integer);
  Begin
    inherited DoMove(MoveCount);                        //движение базы
    if isLeft in Form1.DXInput1.States then x:=x-5;     //влево
    if isRight in Form1.DXInput1.States then x:=x+5;    //вправо
    if x>=form1.DXDraw1.SurfaceWidth-image.Width then   //ограничение движения экраном
      x:=form1.DXDraw1.SurfaceWidth-image.Width;
    if x<=0 then
      x:=0;
  end;

procedure TForm1.DXTimer1Timer(Sender: TObject; LagCount: Integer);
begin
if not DXDraw1.CanDraw then exit;
  DXInput1.Update;
  DXSpriteEngine1.Move(LagCount);
  DXSpriteEngine1.Dead;
  DXDraw1.Surface.Fill(0);
  DXSpriteEngine1.Draw;
  DXDraw1.Flip;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
speed:=1;                                                //скорость шарика
randomize;
vector:=random(120)+30;                                  //начальный угол полета шарика в градусах
for i:=0 to 9 do                                         //задание массива где будут стоять блоки
  for j:=0 to 9 do
    map[i,j]:=1;

for i:=0 to 9 do                                         //расстановка блоков согласно массива map
  for j:=0 to 9 do
    if map[i,j]=1 then
      with TMapSprite.Create(Dxspriteengine1.Engine) do
        begin
          PixelCheck:=True;
          Image:=form1.dxImageList1.Items.Find('Block');
          x:=20+60*i;
          y:=20+20*j;
          Width:=Image.Width;
          Height:=Image.Height;
        end;

with TBaseSprite.Create(Dxspriteengine1.Engine) do        //создание базы
begin
  PixelCheck:=True;
  Image:=form1.dxImageList1.Items.Find('Base');
  x:=280;
  y:=460;
  Width:=Image.Width;
  Height:=Image.Height;
end;

with TBallSprite.Create(Dxspriteengine1.Engine) do        //создание шарика
begin
  PixelCheck:=True;
  Image:=form1.dxImageList1.Items.Find('Ball');
  x:=320;
  y:=400;
  Width:=Image.Width+5;
  Height:=Image.Height+5;
end;

with TBackgroundSprite.Create(DXSpriteEngine1.Engine) do  // создание фона
  begin
    SetMapSize(1,1);
    Image:=dxImageList1.Items.Find('bkg');
    Z:=-2;
    Tile:=True;
  end;

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if Key=VK_ESCAPE then application.Terminate;                  //ESC - выход
end;

end.

[poli-smen]

Сообщение от Shpingalet

Помогите, пожалуйста, с проблемой, возникшей в процессе написания простого арканоида. Дело в том, что не правильно работает обработка столкновений шарика с блоками. Иногда шарик отскакивает правильно, а иногда пролетает сквозь блоки, подвешивая программу.

Когда программа зависнет посмотри в отладчике в каком месте.

[poli-smen]

Несколько раз позапускал - шарик ни разу от блока не отскочил, всё время проходит сквозь блоки и программа ни разу не зависла.
А какой версией DelphiX ты пользуешься?

p.s. А угол отскока что, менять нельзя?

[Shpingalet]

Шарик отскакивает! Правда один раз из 5 где-то Причем чем меньше скорость шарика тем чаще у него это получается. Начальный угол - рандом от 30 до 150 градусов, а меняется если отбивать его в движении. Скорость шарика лучше поставить 4 - 5.
DelphiX качал отсюда

[poli-smen]

Сообщение от Shpingalet

Шарик отскакивает! Правда один раз из 5 где-то

Ни разу не отскочил. Шарик будто и не замечает блоки

Сообщение от Shpingalet

Причем чем меньше скорость шарика тем чаще у него это получается. Начальный угол - рандом от 30 до 150 градусов, а меняется если отбивать его в движении. Скорость шарика лучше поставить 4 - 5.

Нелегко отбивать в движении... Лучше бы ракетка была выпуклой

Сообщение от Shpingalet

DelphiX качал отсюда

У меня стояла версия с torry.net, переставил у себя на твою версию - теперь действительно при столкновении всё зависает... Странно...

[Shpingalet]

Сообщение от poli-smen

Ни разу не отскочил. Шарик будто и не замечает блоки

Сейчас специально позапускал много раз на скорости шарика =5. Из 20-ти запусков в 7-ми случаях отскочило.

[poli-smen]

Сообщение от Shpingalet

Сейчас специально позапускал много раз на скорости шарика =5. Из 20-ти запусков в 7-ми случаях отскочило.

У тебя просто другая версия DelphiX. У меня тогда стояла версия с torry.net и никаких отскоков от блоков не было. А вот когда поставил ту версию что и у тебя, то иногда отскакивает, но в основном всё зависает (иногда на некоторое время - пока шарик якобы не пролетит сквозь блоки, а иногда и навсегда ).
p.s. Интересно в чём проблема, в DelphiX или в твоей программе...

[Shpingalet]

Я думаю, что ошибка закралась в обработке условия на 104 строке. Дело в том, что я пробовал дебагать разные места в программе (в архиве версия где много чего закомментировано с этой целью), так вот я там проверял отдельной переменной с какой стороны идет столкновение. И всегда оно мне выдавало что сталкивается слева, хотя должно быть сверху. Спрайт шарика 10х10 пикселов. Проверка идет по цвету точек левее, выше и правее этих размеров. Пробовал отдалять от шарика точки проверки на столкновение, увеличивать "рамку" шарика, но это ничего не меняет.

[poli-smen]

Сообщение от Shpingalet

Я думаю, что ошибка закралась в обработке условия на 104 строке.

Вряд-ли. Зависание происходит даже если получать цвет произвольной, фиксированной точки, в тот момент, когда шарик с чем-то сталкивается :

Код:

procedure TBallSprite.DoCollision(Sprite: TSprite; var Done: Boolean);
  begin
    if form1.DXdraw1.Surface.canvas.Pixels[10,10]<>57536 then Exit else Exit;
    Exit;

Ещё, что-бы исключить элемент случайности, я заменил Randomize, на

Код:

RandSeed := 987654;

[Shpingalet]

Возможно у Вас есть идеи как организовать проверку стороны с которой шарик ударяется по блоку?

[poli-smen]

Сообщение от Shpingalet

Возможно у Вас есть идеи как организовать проверку стороны с которой шарик ударяется по блоку?

Я думаю, что точно лучше обойтись без проверки пикселей. А вместо этого использовать геометрические формулы пересечений.

[Shpingalet]

Сообщение от poli-smen

Я думаю, что точно лучше обойтись без проверки пикселей. А вместо этого использовать геометрические формулы пересечений.

Спасибо, идея хорошая... Буду сравнивать положение границ спрайтов в момент их столкновений. Как сделаю - отпишусь.
UPD Сразу возник вопрос. Как определить о какой именно из блоков ударился шарик, если в моем примере они располагаются на экране через массив и никак не отличаются друг от друга? И вообще возможно ли откуда-нибудь взять координаты спрайта с которым столкнулся шарик?
UPD №2 Конечно, я думаю, можно запихнуть проверку на столкновение не в процедуру с шариком, а в процедуру с блоком, но как тогда будет проходить проверка и на сколько она замедлит работу программы? Ведь у меня получается 100 спрайтов, которые будут постоянно сравниваться на столкновения.

[poli-smen]

Сообщение от Shpingalet

Спасибо, идея хорошая... Буду сравнивать положение границ спрайтов в момент их столкновений. Как сделаю - отпишусь.

Ок

Сообщение от Shpingalet

UPD Сразу возник вопрос. Как определить о какой именно из блоков ударился шарик, если в моем примере они располагаются на экране через массив и никак не отличаются друг от друга? И вообще возможно ли откуда-нибудь взять координаты спрайта с которым столкнулся шарик?

Проверяй на столкновение со всеми объектами (в цикле по массиву).

Сообщение от Shpingalet

UPD №2 Конечно, я думаю, можно запихнуть проверку на столкновение не в процедуру с шариком, а в процедуру с блоком, но как тогда будет проходить проверка и на сколько она замедлит работу программы? Ведь у меня получается 100 спрайтов, которые будут постоянно сравниваться на столкновения.

Сомневаюсь что простенькие проверки повлияют на производительность.

p.s. Кстати DelphiX использует DirectDraw, который считается тормознутым и вообще устаревшим. Сейчас и 2D и 3D делают только через Direct3D (ну или OpenGL, но это другая история).

[Shpingalet]

Итак, я переделал условия для расчета столкновений и предыдущие проблемы сразу стали явными, хотя и повторяются вновь. Дело в том, что проверка идет по относительному положению спрайта блока и спрайта шарика в момент столкновения, но почему-то DelphiX рассчитывает этот момент ОЧЕНЬ неточно! Доходит до +/- 2 пикселов! Естественно что если по условию разница в координате должна быть 14, а она 12 (причем может и 16), то выполняется совершенно не то что надо.
В связи с этим такой вопрос: можно ли как-нибудь более точно отслеживать столкновения? Может быть что-нибудь впихнуть в таймер?
ЗЫ прикрепил обновленный вариант программы (при столкновении sleep 5 сек)

[Shpingalet]

Исправил все ошибки предыдущей версии программы, но добавилась другая . Полностью переделал расчет столкновений и привел его к той идее, что идет проверка на пересечение траектории полета шарика с границей блока в момент их столкновения. В принципе, уже можно играться, но когда шарик попадает между блоков (т.е. задевает сразу 2), то он не верно меняет вектор полета. В этом можно убедиться, поиграв хоть полминуты.
Если у кого-либо есть желание, просьба подсказать что в этом условии не так? (vector - угол полета шарика в градусах)

Код:

    if Sprite is TBallSprite then                              // шарик 10х10, блок 60х18
    if collisionline(x1+5,x2+5,x,x+60,y1,y2,y+18,y+18) then  //x1,y1 - положение спрайта шарика до столкновения
      vector:=360-vector else                         //x2,y2 - положение спрайта шарика после столкновения
    if collisionline(x1+5,x2+5,x,x+60,y1+10,y2+10,y,y) then
      begin
        if vector<=180 then
          vector:=180-vector else
          vector:=360-vector;
      end else
      begin
        if vector<=180 then
          vector:=180-vector else
          vector:=540-vector;
        end;
    dead;
end;

Функция проверки пересечения линий:

Код:

function CollisionLine(x1,x2,x3,x4,y1,y2,y3,y4:extended):boolean;
var v1,v2,v3,v4:double;
begin
  v1:=(x4-x3)*(y1-y3)-(y4-y3)*(x1-x3);
  v2:=(x4-x3)*(y2-y3)-(y4-y3)*(x2-x3);
  v3:=(x2-x1)*(y3-y1)-(y2-y1)*(x3-x1);
  v4:=(x2-x1)*(y4-y1)-(y2-y1)*(x4-x1);
  CollisionLine:=(v1*v2<0) and (v3*v4<0);
end;