20 апреля 2024, 05:12:24

Новости:

Узнай первым о новых темах и ответах в Telegram канале:  @gratis_forum


avatar_fers

Програмирование на pascal

Автор fers, 19 мая 2004, 19:11:25

0 Пользователей и 1 гость просматривают эту тему.

fers

Кто знает 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.  
Завтра будет.Лучше......[/size]

gratis

19 мая 2004, 19:40:41 #1 Последнее редактирование: 19 мая 2004, 19:41:36 от gratis
никогда не используй этот оператор  :)
Цитироватьgoto



Был бы компилятор под рукой.....  :unsure:
Узнай первым!!! о новых темах и ответах в Telegram канале:  @gratis_forum https://t.me/gratis_forum

Sijes

19 мая 2004, 23:04:53 #2 Последнее редактирование: 19 мая 2004, 23:44:08 от Sijes
Цитировать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

Спасибо за помощь,а у кого-нибуть не завалялись проги на pascal,где  шарики летают????Просто надо сдавать,а ничего не получается......блин. :(  
Завтра будет.Лучше......[/size]

Sijes

Цитировать0.1*30=0.3

Ой! Это ж надо так прогнать!   :ph34r:
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

21 мая 2004, 01:06:43 #5 Последнее редактирование: 29 мая 2004, 01:45:50 от fers
Sijes
Огромное тебе спасибо,я даже не знаю,как тебя отблагодарить.сенкс  :)

p.s вот не перевелись же еще добрые люди на земле.
Завтра будет.Лучше......[/size]

Sijes

Да ладно, не за что... Просто заняться нечем было, вот и помог...
Травить детей -- это жестоко. Но что-нибудь ведь надо же с ними делать!

В мире столько безумия, что извинить Бога может лишь то, что он не существует.

Верман

И халявщики, которые сами ничего делать не пытаются, а только спрашивают не перевелись...
Темперамент: Холерик, "Гексли", Chaotic-Good
Личностная акцентуация по СМИЛ: Сомневающийся
Фракция на Планах: Society of Sensation
Основная репрезентативная система: Кинестетик
Культура: Хиппи, Готика, Толкиеизм.
Религия: начинающий Воин Света, шаман-теоретик.
Профессия: программист.



По всем вопросам пишите по адресу gratispp@mail.ru