IPB

> Пример: Мяч в кресте
Форум
Загрузка...
 
30 декабря премьера!
Учитель физики желает познакомиться
Час быка
Час быка
Карта Интернета
Internet Map
Яндекс.Метрика

На экране нарисован крест, внутри креста летает мяч, отражаясь от стенок креста, а также от вогнутых углов.

Скачать: BALLMIRR.PAS

Мяч отражается от стенок

Код

uses graph,crt;

const iter = 30;
      dly = 55;

var
 graphdriver,
 graphmode:integer;
 ErrorCode:integer;
 x,y,x1,y1,c1,c2:integer;
 xr,yr,xr2,yr2,vxr,vyr:real; {vxr, vyr -- пикселей в секунду}
 r,i:integer;
 wascollis:boolean;

procedure MyGraphInit;
begin
 GraphDriver:=Detect;
 InitGraph(GraphDriver,GraphMode, 'X:\BP');
 ErrorCode:=GraphResult;
if ErrorCode <> grOk then
begin
 writeln('InitGraph Error: ',GraphErrorMsg(ErrorCode));
 Writeln('Program is aborted!');
 Halt(1);
end;
end;

procedure dotreflect(dotx,doty:real);
var
  paral, orth, moveback : real;
  movedbackx, movedbacky : real;
  newvxr, newvyr : real;
  push : real;
begin
  paral := ((xr2 - dotx) * vxr + (yr2 - doty) * vyr) / sqrt(sqr(vxr) + sqr(vyr));
  orth := ((xr2 - dotx) * vyr - (yr2 - doty) * vxr) / sqrt(sqr(vxr) + sqr(vyr));
  moveback := paral + sqrt(sqr(r + 1) - sqr(orth));
   { дистанция, на которую надо отодвинуть назад, чтобы восстановить
      момент столкновения }


  movedbackx := xr2 - moveback * vxr / sqrt(sqr(vxr) + sqr(vyr));
  movedbacky := yr2 - moveback * vyr / sqrt(sqr(vxr) + sqr(vyr));

  push := (vxr * (movedbackx - dotx) + vyr * (movedbacky - doty)) /
          (sqr(movedbackx - dotx) + sqr(movedbacky - doty));

  newvxr := vxr - 2 * push * (movedbackx - dotx);
  newvyr := vyr - 2 * push * (movedbacky - doty);

  vxr := newvxr;
  vyr := newvyr;

  xr2 := movedbackx + moveback * vxr / sqrt(sqr(vxr) + sqr(vyr));
  yr2 := movedbacky + moveback * vyr / sqrt(sqr(vxr) + sqr(vyr));

end;

begin
 clrscr;
 MyGraphInit;
{--------Вывод креста----------}
 line(220,70,300,70);
 line(220,70,220,150);
 line(220,150,140,150);
 line(140,220,140,150);
 line(220,220,140,220);
 line(220,220,220,300);
 line(220,300,300,300);
 line(300,300,300,220);
 line(300,220,380,220);
 line(380,220,380,150);
 line(380,150,300,150);
 line(300,150,300,70);
readln;
  x:=260; xr:=x;
  y:=185; yr:=y;
  vxr:=130; vyr:=150;
  r:=16;
  c1:=0;c2:=12;
 while not KeyPressed do
 begin
    x1:=x;
    y1:=y;

   for i := 1 to iter do
   begin
      xr2 := xr + vxr * dly / iter / 1000;
      yr2 := yr + vyr * dly / iter / 1000;

     repeat
        wascollis := false;
       if xr2 - r <= 141.0 then
       begin
          xr2 := 2 * (141.0 + r) - xr2;
          vxr := abs(vxr);
          wascollis := true;
       end;
       if xr2 + r >= 379.0 then
       begin
          xr2 := 2 * (379.0 - r) - xr2;
          vxr := -abs(vxr);
          wascollis := true;
       end;

       if yr2 - r <= 71.0 then
       begin
          yr2 := 2 * (71.0 + r) - yr2;
          vyr := abs(vyr);
          wascollis := true;
       end;
       if yr2 + r >= 299.0 then
       begin
          yr2 := 2 * (299.0 - r) - yr2;
          vyr := -abs(vyr);
          wascollis := true;
       end;

       if sqr(xr2 - 220.0) + sqr(yr2 - 150.0) < sqr(r + 1) then
       begin
          dotreflect(220.0, 150.0);
          wascollis := true;
       end;
       if sqr(xr2 - 220.0) + sqr(yr2 - 220.0) < sqr(r + 1) then
       begin
          dotreflect(220.0, 220.0);
          wascollis := true;
       end;
       if sqr(xr2 - 300.0) + sqr(yr2 - 150.0) < sqr(r + 1) then
       begin
          dotreflect(300.0, 150.0);
          wascollis := true;
       end;
       if sqr(xr2 - 300.0) + sqr(yr2 - 220.0) < sqr(r + 1) then
       begin
          dotreflect(300.0, 220.0);
          wascollis := true;
       end;


       if ((yr2 >= 70.0) and (yr2 <= 150.0)) or
           ((yr2 >= 220.0) and (yr2 <= 300.0)) then
       begin
         if (xr2 - r <= 221.0) then
         begin
            xr2 := 2 * (221.0 + r) - xr2;
            vxr := abs(vxr);
            wascollis := true;
         end;

         if xr2 + r >= 299.0 then
         begin
            xr2 := 2 * (299.0 - r) - xr2;
            vxr := -abs(vxr);
            wascollis := true;
         end;
       end;

       if ((xr2 >= 140.0) and (xr2 <= 220.0)) or
           ((xr2 >= 300.0) and (xr2 <= 380.0)) then
       begin
         if yr2 - r <= 151.0 then
         begin
            yr2 := 2 * (151.0 + r) - yr2;
            vyr := abs(vyr);
            wascollis := true;
         end;
         if yr2 + r >= 219.0 then
         begin
            yr2 := 2 * (219.0 - r) - yr2;
            vyr := -abs(vyr);
            wascollis := true;
         end;
       end;

     until keypressed or not wascollis;
      xr := xr2;
      yr := yr2;

   end;

   {x:=x+random(8)-4;
    y:=y+random(8)-4;}


    x := round(xr);
    y := round(yr);
  {круг}
   Setcolor(c1);{тоже, но черным(стираем)}
   Circle(x1,y1,r);
   Setfillstyle(1,c1);
   Fillellipse(x1,y1,r,r);
   Setcolor(c2);{цвет красный}
   Circle(x,y,r);{граница круга}
   Setfillstyle(1,c2);{сплошная закраска красным}
   Fillellipse(x,y,r,r);
   Delay(dly);
 end;
 readln;
  CloseGraph;
end.
 
 К началу страницы 
 

Код для вставки: :: :: :: ГОСТ ::
Поделиться: //
 


-
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"