Столкновение шаров

← →
ЛехаШ (2002-11-04 09:05) [0]

Люди... Может кто подскажет алгоритм столкновения шаров (например бильярдных) ?

← →
pasha676 (2002-11-04 09:12) [1]

Леха, без обид. Ну неужели нельзя самому подумать. Вот шар. Его координаты в пространстве пусть будут - координаты его центра. Тогда столкновение шаров произойдет, если растояние между центрами шаров меньше суммы радиусов этих шаров. Помоему очень просто. Пожалуй шар - самая простая фигура на отслеживание столкновений.

← →
Константин Ловецкий (2002-11-13 22:32) [2]

http://www.gamasutra.com/features/20000516/lander_01.htm

Описывается collision between two billiard balls

Обсуждаются the application of force, the physics of collisions, and the influence of friction on objects in motion.

Для входа на сайт надо зарегистрироваться, далее проблем нет, доступ бесплатен.

Статьи на английском.

Константин.

← →
Gandalf (2002-11-14 09:21) [3]

Недавно на "Королевстве" выложили теорию бильярда+сорцы. Иди качай.

← →
Паша2 (2002-12-17 12:42) [4]

/////////////////////////////////////////////////////////
///Демка проверки столкновений - "Каучуковые шарики" ///
///Дема моделирует поведение шариков при столкновении,///
///она в 2D но ведь сути это не меняет... :) ///
///Автор - BoogeMan (BoogeSoft@yandex.ru) ///
/////////////////////////////////////////////////////////

unit frmMain;
interface

uses
Windows, Messages, SysUtils, Forms, opengl,texturegl,
Classes ,Graphics, Controls, StdCtrls, Menus;

type
Tfrmcube = class(TForm)
MainMenu1: TMainMenu;
Resetballs1: TMenuItem;
Exit1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure Exit1Click(Sender: TObject);
procedure Resetballs1Click(Sender: TObject);

private
DC: HDC;
hrc: HGLRC;
pfd: TPixelFormatDescriptor;
Palette: HPalette;
procedure SetDCPixelFormat;
protected
procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
end;

const
grv=-0.08; //коф. силы тяжести
kpr=0.5; //коф прыгучести
kot=50;
col=20; //колличество шаров

ot=25;
otd=10;

type
shar=record
rad:integer; //радиус круга
x,y:single; //координаты центра круга
nx,ny:single; //измерения вектора направления
per:boolean; //столкнулся ли наш круг
//с чем-нибуь в тек. кадр
end;

var
frmcube: Tfrmcube;

boll,fon:TTextureGl;
sh:array [1..col] of shar;
i:integer;

procedure nomalzd(var x,y:single);
function get_dl_line(x1,y1,x2,y2:single):single;
procedure reset_bolls;

implementation

{$R *.DFM}
function get_dl_line(x1,y1,x2,y2:single):single;
var x,y:single;
begin
x:=x2-x1;y:=y2-y1;
get_dl_line:=sqrt((x*x)+(y*y));
end;

procedure nomalzd(var x,y:single);
var d:single;
begin
d:=sqrt((x*x)+(y*y));
x:=x/d;y:=y/d;
end;

procedure reset_bolls;
var i,a:integer;
label m1;
begin
randomize;
for i:=1 to col do
begin
m1:
sh[i].rad:=random(ot)+otd;
sh[i].x:=sh[i].rad+random(frmcube.width - (sh[i].rad*2)); sh[i].nx:=0;
sh[i].y:=sh[i].rad+random(frmcube.height - (sh[i].rad*2)); sh[i].ny:=0;

for a:=1 to col do
if (a<>i)and(get_dl_line(sh[i].x,sh[i].y,sh[a].x,sh[a].y)<
(sh[i].rad+sh[a].rad)) then goto m1;
end;
end;

← →
паша2 (2002-12-17 13:08) [5]

{продолжение}

procedure Tfrmcube.WMPaint(var Msg: TWMPaint);
var
ps : TPaintStruct;
a,b:integer;
bu,zz,x1,y1:single;
begin

BeginPaint(Handle, ps);
glViewPort (0, 0, ClientWidth, ClientHeight);
glMatrixMode(GL_projection);
glLoadIdentity;
glortho(0,frmcube.ClientWidth,0,frmcube.Clientheight,-800,800);
gldisable(GL_depth_TEST);
glClear(GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT);

fon.Enable;
glBegin (GL_QUADS);
glTexCoord2d (0.0, 0.0); glVertex2f (0,0);
glTexCoord2d (1.0, 0.0); glVertex2f (clientwidth,0);
glTexCoord2d (1.0, 1.0); glVertex2f (clientwidth,clientheight);
glTexCoord2d (0.0, 1.0); glVertex2f (0,clientheight);
glEnd;

for i:=1 to col do
begin

//Самое главное во всей проге!!! - коллизия шаров :)
for a:=1 to col-1 do
for b:=a+1 to col do
begin
bu:=get_dl_line(sh[a].x,sh[a].y,sh[b].x,sh[b].y);
if bu<(sh[a].rad+sh[b].rad) then
begin
bu:=(sh[a].rad+sh[b].rad)-bu;

x1:=sh[a].x-sh[b].x;
y1:=sh[a].y-sh[b].y; nomalzd(x1,y1);
x1:=x1*bu; y1:=y1*bu;
sh[a].nx:=sh[a].nx+(x1/kot);
sh[a].ny:=sh[a].ny+(y1/kot);

x1:=sh[b].x-sh[a].x;
y1:=sh[b].y-sh[a].y; nomalzd(x1,y1);
x1:=x1*bu; y1:=y1*bu;
sh[b].nx:=sh[b].nx+(x1/kot);
sh[b].ny:=sh[b].ny+(y1/kot);
end;
end;

sh[i].per:=false;

if (sh[i].y>clientheight-sh[i].rad) then
begin
sh[i].ny:=sh[i].ny+((clientheight-sh[i].rad)-sh[i].y)*kpr;
sh[i].nx:=(sh[i].nx*kpr); sh[i].per:=true;
end;

if (sh[i].y<sh[i].rad) then
begin
sh[i].nx:=(sh[i].nx*kpr); sh[i].per:=true;
sh[i].ny:=sh[i].ny+((sh[i].rad-sh[i].y))*kpr;
end;

if (sh[i].x>clientwidth -sh[i].rad) then
begin
sh[i].ny:=(sh[i].ny*kpr); sh[i].per:=true;
sh[i].nx:=sh[i].nx+((clientwidth-sh[i].rad)-sh[i].x)*kpr;
end;

if (sh[i].x<sh[i].rad) then
begin
sh[i].ny:=(sh[i].ny*kpr); sh[i].per:=true;
sh[i].nx:=sh[i].nx+((sh[i].rad-sh[i].x))*kpr;
end;

sh[i].x:=sh[i].x+sh[i].nx;
sh[i].y:=sh[i].y+sh[i].ny; sh[i].ny:=sh[i].ny+grv; //смещаем круг
boll.enable;
glBegin (GL_QUADS);
glTexCoord2d (0.0, 0.0);
glVertex2f (sh[i].x-sh[i].rad,sh[i].y-sh[i].rad);
glTexCoord2d (1.0, 0.0);
glVertex2f (sh[i].x+sh[i].rad,sh[i].y-sh[i].rad);
glTexCoord2d (1.0, 1.0);
glVertex2f (sh[i].x+sh[i].rad,sh[i].y+sh[i].rad);
glTexCoord2d (0.0, 1.0);
glVertex2f (sh[i].x-sh[i].rad,sh[i].y+sh[i].rad);
glEnd;
end;

SwapBuffers(DC);
EndPaint(Handle, ps);

InvalidateRect(Handle, nil, False);
end;

procedure Tfrmcube.FormCreate(Sender: TObject);
begin
DC := GetDC(Handle);
SetDCPixelFormat;
hrc := wglCreateContext(DC);
wglMakeCurrent(DC, hrc);

glEnable(GL_TEXTURE_2D);

glenable (GL_COLOR_MATERIAL);
gldisable(GL_NORMALIZE);
gldisable(GL_DEPTH_TEST);
glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA);
glEnable(GL_BLEND);

boll:=TTextureGl.Create;
boll.LoadFrom_bmp_File_vsa("font.bmp",9729,9985,true);
fon:=TTextureGl.Create;
fon.LoadFrom_bmp_File_vsa("fon.bmp",9729,9985,false);
reset_bolls;
end;

procedure Tfrmcube.FormDestroy(Sender: TObject);
begin
wglMakeCurrent(0, 0);
wglDeleteContext(hrc);
ReleaseDC(Handle, DC);
end;

{=======================================================================
Устанавливаем формат пикселей}
procedure Tfrmcube.SetDCPixelFormat;
var
nPixelFormat: Integer;
begin
FillChar(pfd, SizeOf(pfd), 0);

pfd.dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or
PFD_DOUBLEBUFFER;
nPixelFormat := ChoosePixelFormat(DC, @pfd);
SetPixelFormat(DC, nPixelFormat, @pfd);
end;

procedure Tfrmcube.FormKeyPress(Sender: TObject; var Key: Char);
begin
if key=" " then reset_bolls;
end;

procedure Tfrmcube.Exit1Click(Sender: TObject);
begin
close;
end;

procedure Tfrmcube.Resetballs1Click(Sender: TObject);
begin
reset_bolls;
end;

end.

Столкновение шаров Найти похожие ветки