На экране нарисован крест, внутри креста летает мяч, отражаясь от стенок креста, а также от вогнутых углов.
Скачать: 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.
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.