Кривые в полярных координатах

Программа строит кривые в полярной системе координат: улитку Паскаля, спираль Архимеда, эллипс, гиперболу, параболу.
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.

Оставить комментарий

Вы должны быть авторизованы , чтобы оставить или оценить комментарий.

Онлайн всего: 3
Гостей: 3
Пользователей: 0

STUDLAB Сообщить про опечатку на сайте