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