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
  
 
   И халявщики, которые сами ничего делать не пытаются, а только спрашивают не перевелись...