Кривые в полярных координатах
Программа строит кривые в полярной системе координат: улитку Паскаля, спираль Архимеда, эллипс, гиперболу, параболу.
program polyar_syst_koord;
uses crt,graph;
const s=0.0001;{шаг изменения угла в цикле построения кривой}
var
x,y,fi,eps,p,ro:real;
driver,mode, cx,cy,mx,my,ex,ey:integer;
procedure Op;
begin
cx:=trunc(GetMaxX/2);cy:=trunc(GetMaxY/2);
line(cx,cy,630,cy);line(620,cy-5,630,cy); line(620,cy+5,630,cy);
outtextxy(GetMaxX-20,cy+10,'p'); outtextxy(cx-20,cy+10,'O');
end;
procedure KonichSech(p,e:real);
{Эксцентриситет e<1 - эллипс,е=1 - парабола, e>1 - гипербола}
begin
Op; outtextxy(50,30,'Коническое сечение:');
if e<1 then outtextxy(210,30,'эллипс') else
if e=1 then outtextxy(210,30,'парабола') else
if e>1 then outtextxy(210,30,'гипербола');
fi:=0;
repeat
if abs(1-e*cos(fi))>1e-5 then ro:=p/(1-e*cos(fi));
x:=ro*cos(fi); y:=ro*sin(fi);
ex:=trunc(cx+x*mx); ey:=trunc(cy-y*my);
putpixel(ex,ey,red); fi:=fi+s;
until fi>2*pi;
end;
procedure rosetka(R,a,b:real);
begin
Op; outtextxy(10,10,' Розетка'); fi:=0;
repeat
ro:=R*abs(sin(a*fi)+b);
x:=ro*cos(fi); y:=ro*sin(fi);
ex:=trunc(cx+x*mx); ey:=trunc(cy-y*my);
putpixel(ex,ey,red); fi:=fi+s;
until fi>2*pi;
end;
procedure SpiralArhimeda(R,k:real);
{R определяет расстояние межджу витками,
k - количество полных оборотов}
begin
Op; outtextxy(10,10,'Спираль Архимеда'); fi:=0;
repeat
ro:=abs(R*fi);
x:=ro*cos(fi); y:=ro*sin(fi);
ex:=trunc(cx+x*mx); ey:=trunc(cy-y*my);
putpixel(ex,ey,red); fi:=fi+s
until fi>k*2*pi;
end;
procedure rose(a,k:real);
begin
Op; outtextxy(10,10,' Роза'); fi:=0;
repeat
ro:=abs(a*cos(k*fi)*cos(k*fi)*sin(k*fi));
x:=ro*cos(fi); y:=ro*sin(fi);
ex:=trunc(cx+x*mx); ey:=trunc(cy-y*my);
putpixel(ex,ey,red); fi:=fi+s;
until fi>2*pi;
end;
procedure Ulitka_Paskalya(a,k,absyes:real);
begin
fi:=0; cx:=trunc(GetMaxX/3);cy:=trunc(GetMaxY/2);
line(cx,cy,630,cy);line(620,cy-5,630,cy); line(620,cy+5,630,cy);
outtextxy(GetMaxX-20,cy+10,'p'); outtextxy(cx-20,cy+10,'O');
outtextxy(cx-20,cy+10,'O');
if absyes=1 then
outtextxy(200,10,'Вариант улитки Паскаля')
else
begin
outtextxy(200,10,'Улитка Паскаля (Этьена - отца Блеза Паскаля)');
outtextxy(200,20,'или конхоида окружности')
end;
repeat
if absyes=1 then
ro:=abs(a*cos(fi)+k)
else
ro:=a*cos(fi)+k;
x:=ro*cos(fi); y:=ro*sin(fi);
ex:=trunc(cx+x*mx); ey:=trunc(cy-y*my);
putpixel(ex,ey,red); fi:=fi+s;
until fi>2*pi;
end;
BEGIN
driver:=detect; initgraph(driver,mode,'d:\tp\bgi');
setcolor (blue); setbkcolor(white);
mx:=trunc((getmaxx-20)/20); my:=trunc((getmaxy-20)/20);
KonichSech(0.8,1.2); {гипербола}
{KonichSech(8,0.1);} {эллипс}
{KonichSech(2,1);} {парабола}
readln; cleardevice;
SpiralArhimeda(0.3, 5); readln; cleardevice;
rosetka(3.5,3,2); readln; cleardevice;
rose(25,2); readln;cleardevice;
ulitka_Paskalya(8,5,0); readln; cleardevice;
{вариант формулы:ro:=abs(a*cos(fi)+k)}
ulitka_Paskalya(8,5,1); readln; cleardevice;
END.