fers
Wednesday, 19 May 2004, 19:11
Кто знает pascal,посмотрите,pls почему прога не работает??? надо чтоб шарики летали...
Program balls;
Uses Graph,Crt;
Const
Xa=0;Ya=0;Xb=500;Yb=500;
Vmax=100;
r=20;
label 1,2,3;
Var
Gd,gm:Integer;
VX1,VX2,VY1,VY2,UX1,UY1,UX2,UY2:real;
X1,X2,Y1,Y2:integer;
A,dt:real;
Begin
Writeln('Enter initial coordinates.');
1: Write('Enter X1,Y1:');
Readln(X1,Y1);
Write('Enter X2,Y2:');
Readln(X2,Y2);
A:=sqrt(sqr(X1-X2)+sqr(Y1-Y2));
if (A<2*r) or (X1<Xa+r) or (X1>Xb-r) or (Y1<Ya+r) or (Y1>Yb-r) or (X2<Xa+r) or (X2>Xb-r) or (Y2<Ya+r) or (Y2>Yb-r)
then
Begin
Write('Enter initial coordinates again!');
Goto 1;
End;
Writeln('Enter initial velocities.');
2:Write('Enter VX1,VY1:');
Readln(VX1,VY1);
Write('Enter VX2,VY2:');
Readln(VX2,VY2);
if (abs(VX1)>Vmax) or (abs(VY1)>Vmax) or (abs(VX2)>Vmax) or (abs(VY2)>Vmax)
then
Begin
Write('Velocity exceed max. vol!');
Goto 2;
end;
Gd:=detect;
Initgraph(Gd,Gm,' ');
dt:=1/Vmax;
repeat
Rectangle(Xa,Ya,Xb,Yb);
circle(X1,Y1,r);
circle(X2,Y2,r);
X1:=round(X1+VX1*dt);
Y1:=round(Y1+VY1*dt);
X2:=round(X2+VX2*dt);
Y2:=round(Y2+VY2*dt);
3:A:=sqrt(sqr(X1-X2)+sqr(Y1-Y2));
if (X1<Xa+r) or (X1>Xb-r)
then
Begin
VX1:=-VX1;
X1:=round(X1+VX1*dt);
goto 3;
end;
Begin
VY2:=-VY2;
Y2:=round(Y2+VY2*dt);
goto 3;
end;
if (A<2*r) and ((VX1-VX2)*(X2-X1)+(VY1-VY2)*(Y2-Y1))>a
then
Begin
UX1:=(VX2*sqr(X2-X1)+VX1*sqr(Y2-Y1)+(VY2-VY1)*(X2-X1)*(Y2-Y1))/A;
UY1:=(VY1*sqr(X2-X1)+VY2*sqr(Y2-Y1)+(VX2-VX1)*(X2-X1)*(Y2-Y1))/A;
UX2:=(VX1*sqr(X2-X1)+VX2*sqr(Y2-Y1)+(VY1-VY2)*(X2-X1)*(Y2-Y1))/A;
UY2:=(VY2*sqr(X2-X1)+VY1*sqr(Y2-Y1)+(VX1-VX2)*(X2-X1)*(Y2-Y1))/A;
VX1:=UX1;
VY1:=UY1;
VX2:=UX2;
VY2:=UY2;
X1:=X1+VX1*dt;
Y1:=Y1+VY1*dt;
X2:=X2+VX2*dt;
Y2:=Y2+VY2*dt;
goto 3;
end;
CirScr;
until KeyPressed;
CloseGraph;
end.
gratis
Wednesday, 19 May 2004, 19:40
никогда не используй этот оператор
Был бы компилятор под рукой.....
Sijes
Wednesday, 19 May 2004, 23:04
QUOTE |
end; Begin VY2:=-VY2; Y2:=round(Y2+VY2*dt); goto 3; end; |
Здесь, по идее, между строками end и begin должно стоять
if (Y1<Ya+r) or (Y1>Yb-r). Без этого if'а программа всегда переходит по goto 3 и циклится.
И потом, где такие же проверки для X2 и Y1? (Или они не нужны? я в программе не особо копался).
Вот, ещё разобрался чуток... Метка 3 абсолютно не нужна!
А на месте шары стоят потому ещё, что dt слишком мала... 0.1*30=0.3, и round(X1+0.3)=X1, вот и не двигается нифига. (30 - скорость) Если скорость поставить 100 100, какое-то движение наблюдается, но и там ещё сотня глюков вылазит... лучше заново переписать...
fers
Thursday, 20 May 2004, 1:30
Спасибо за помощь,а у кого-нибуть не завалялись проги на pascal,где шарики летают????Просто надо сдавать,а ничего не получается......блин.
Sijes
Thursday, 20 May 2004, 20:19
Ой! Это ж надо так прогнать!
dt=0.01
Слегка переделал код, вот что получилось (выглядит, конечно, довольно убого, но всё-таки они летают!!!)
Program balls;
Uses Graph,Crt;
Const
Vmax=100;
MaxX=640;MaxY=480;MinX=0;MinY=0;
r=20;
Var
Gd,gm:Integer;
VX1,VX2,VY1,VY2:real;
X1,X2,Y1,Y2:real;
X11,X21,Y11,Y21:real;
aver,A,dt:real;
Begin
repeat
Writeln('Enter initial coordinates.');
Write('Enter X1,Y1:');
Readln(X1,Y1);
Write('Enter X2,Y2:');
Readln(X2,Y2);
a:=sqrt(sqr(X2-X1)+sqr(Y2-Y1));
until (a>2*r)and(X1>MinX)and(X2>MinX)and(Y1>MinY)and(Y2>MinY)and
(X1<MaxX-r)and(X2<MaxX-r)and(Y1<MaxY-r)and(Y2<MaxY-r);
repeat
Writeln('Enter initial velocities.');
Write('Enter VX1,VY1:');
Readln(VX1,VY1);
Write('Enter VX2,VY2:');
Readln(VX2,VY2);
until (abs(VX1)<Vmax)or(abs(VY1)<Vmax)or(abs(VX2)<Vmax)or(abs(VY2)<Vmax);
dt:=1/VMax;
Gd:=detect;
Initgraph(Gd,Gm,'d:\bp\bgi');
setfillstyle(0,0);
repeat
circle(round(X1),round(Y1),r);
circle(round(X2),round(Y2),r);
if (X1<r) or (X1>MaxX-r)then VX1:=-VX1;
if (X2<r) or (X2>MaxX-r)then VX2:=-VX2;
if (Y1<r) or (Y1>MaxY-r)then VY1:=-VY1;
if (Y2<r) or (Y2>MaxY-r)then VY2:=-VY2;
A:=sqrt(sqr(X2-X1)+sqr(Y2-Y1));
if A<2*r then
begin
if ((VX1>=0)and(VX2<=0))or((VX1<=0)and(VX2>=0))then
begin
aver:=(abs(VX1)+abs(VX2))/2;
if VX1>=0 then VX1:=-aver
else VX1:=aver;
if VX2>=0 then VX2:=-aver
else VX2:=aver;
end;
if ((VY1>=0)and(VY2<=0))or((VY1<=0)and(VY2>=0))then
begin
aver:=(abs(VY1)+abs(VY2))/2;
if VY1>=0 then VY1:=-aver
else VY1:=aver;
if VY2>=0 then VY2:=-aver
else VY2:=aver;
end;
end;
X11:=X1+VX1*dt;
Y11:=Y1+VY1*dt;
X21:=X2+VX2*dt;
Y21:=Y2+VY2*dt;
setcolor(15);
circle(round(X11),round(Y11),r);
circle(round(X21),round(Y21),r);
setcolor(0);
circle(round(X1),round(Y1),r);
circle(round(X2),round(Y2),r);
delay(40);
X1:=X11;X2:=X21;Y1:=Y11;Y2:=Y21;
until KeyPressed;
CloseGraph;
end.
fers
Friday, 21 May 2004, 1:06
Sijes Огромное тебе спасибо,я даже не знаю,как тебя отблагодарить.сенкс
p.s вот не перевелись же еще добрые люди на земле.
Sijes
Friday, 21 May 2004, 1:11
Да ладно, не за что... Просто заняться нечем было, вот и помог...
Верман
Wednesday, 29 December 2004, 20:24
И халявщики, которые сами ничего делать не пытаются, а только спрашивают не перевелись...