IPB

> Пример: Мяч в кресте
Чат
Форум
Загрузка...
 

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

Скачать: 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.
 
 К началу страницы 
 

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



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