Определение точек пересечения фигур

program task05;
uses crt;
const a=23;
      b=38;
      r=30;
      e=0.001;
      p=1010;
type mas=array [1..p] of real;
var x:mas;
    yo,yoa,yob,yoc,xo:real;
    ye,xea,xeb,xec,xe:real;
    kl,bl:real;
    pixel1,pixel2:real;
    i:real;
    q:real;
    p1:string;
    n1,n2,n3:integer;
 
procedure x1x2(Var a1,b1,c1:real);{рассчитывает уравнение}
var x1,x2,d:real;                 {по виду ах^2+bх+с=0   }
begin
d:=b1*b1-4*a1*c1;
if (d>=0) and (a<>0)  then begin
                                x1:=(-b1+sqrt(d))/(2*a1);
                                x2:=(-b1-sqrt(d))/(2*a1) end
                                else
                                if (a=0) and (b<>0)  then begin
                                                               x1:=-c1/b1;
                                                               x2:=x1
                                                           end;
if d<0 then c1:=1
       else c1:=0;
a1:=x1;
b1:=x2;
if c1=1 then writeln('Корней нет');
end;
 
{Уравнение окружности (дуги 1)}
function f(i:integer):real;
begin
f:=sqrt(sqr(r)-sqr(-1*(x[i])-xo))+yo;
end;
 
{Уравнение окружности (дуги 2)}
function f1(i:integer):real;
begin
f1:=abs(-sqrt(sqr(r)-sqr(x[i]-xo))+yo);
end;
 
{Уравнение эллипса (дуги)}
function f2(i:integer):real;
begin
f2:=abs(-sqrt(sqr(b)*(1-sqr((x[i]-xe)/a)))+ye);
end;
 
{Уравнение прямой}
function fl(xl:real):real;
begin
fl:=kl*xl+bl;
end;
 
{Формула трапеции}
function trapecia(at:real;bt:real;n:integer;q:integer):real;
var i:integer;
    h,s,s1:real;
begin
if bt>at then begin h:=(bt-at)/n;
                    for i:=1 to n+1 do x[i]:=at+h*(i-1) end
                             else begin
                    h:=(at-bt)/n;
                    for i:=1 to n+1 do x[i]:=bt+h*(i-1) end;
s:=0;s1:=0;
if q=1 then begin
                  for i:=2 to n do s:=s+f(i);
                  s:=(s+(f(1)+f(n+1))/2)*h;
                  s1:=(abs(at-bt))*(fl(bt)+fl(at))/2 end;
if q=2 then begin
                  for i:=2 to n do s:=s+f1(i);
                  s:=(s+(f1(1)+f1(n+1))/2)*h;
                  h:=pixel1/n;
                  for i:=1 to n+1 do x[i]:=h*(i-1);
                  for i:=2 to n do s1:=s1+f2(i);
                  s1:=(s1+(f2(1)+f2(n+1))/2)*h+(32-pixel1)*abs(fl(pixel1))/2 end;
trapecia:=s-s1;
end;
 
{Формула Симпсона}
function simpson(as1:real;bs:real;n:integer;q:integer):real;
var i:integer;
    h,s,s1:real;
begin
if bs>as1 then begin h:=(bs-as1)/n;
                  for i:=1 to n+1 do x[i]:=as1+h*(i-1) end
                             else begin h:=(1-bs)/n;
                                  for i:=1 to n+1 do x[i]:=bs+h*(i-1) end;
s:=0;
if q=1 then begin
                  for i:=2 to n do
                  if (i mod 2)<>1 then s:=s+4*f(i)
                                  else s:=s+2*f(i);
                                              s:=(s+f(1)+f(n+1))*h/3;
                                              s1:=(abs(as1-bs))*(fl(bs)+fl(as1))/2 end;
if q=2 then begin
                  for i:=2 to n do
                  if (i mod 2)<>1 then s:=s+4*f1(i)
                                  else s:=s+2*f1(i);
                                              s:=(s+f1(1)+f1(n+1))*h/3;
                                  h:=pixel1/n;
                                  for i:=1 to n+1 do x[i]:=h*(i-1);
                  for i:=2 to n do
                  if (i mod 2)<>1 then s1:=s1+4*f2(i)
                                  else s1:=s1+2*f2(i);
                                              s1:=(s1+f2(1)+f2(n+1))*h/3;
                                  s1:=s1+(32-pixel1)*abs(fl(pixel1))/2 end;
simpson:=s-s1;
end;
 
{Формула прямоугольников}
function pr(ap:real;bp:real;n:integer;q:integer):real;
var i:integer;
    h,s,s1:real;
begin
if bp>ap then begin h:=(bp-ap)/n;
                  for i:=1 to n+1 do x[i]:=ap+h*(i-1) end
                             else begin h:=(ap-bp)/n;
                                  for i:=1 to n+1 do x[i]:=bp+h*(i-1) end;
s:=0;s1:=0;
if q=1 then begin
                  for i:=1 to n do s:=s+f(i);
                  s:=s*h;
                  s1:=(abs(ap-bp))*(fl(bp)+fl(ap))/2 end;
if q=2 then begin
                  for i:=1 to n do s:=s+f1(i);
                  s:=s*h;
                  h:=pixel1/n;
                  for i:=1 to n+1 do x[i]:=h*(i-1);
                  for i:=1 to n do s1:=s1+f2(i);
                  s1:=s1*h+(32-pixel1)*abs(fl(pixel1))/2 end;
pr:=s-s1;
end;
 
{Расчет точки пересечения прямой, эллипса и оси координат}
{Метод простых итераций}
procedure itera(Var xi:real);
Var xs,xp:real;
begin
xp:=0;xs:=25;
while abs(xs-xp)>e do begin xp:=xs;
                            xs:=a*sqrt(1-sqr((kl*xp+bl)/b))+xe;
                            end;
xi:=xs;
end;
 
{Метод половинного деления}
procedure scan(var xscan:real);
Var x1,x2,y1,y2,yi,xi:real;
begin
x1:=-36;x2:=-8;
while abs(x2-x1)>e do begin xi:=(x1+x2)/2;
                            y1:=sqrt(sqr(r)-sqr(x1-xo))+yo-kl*x1-bl;
                            y2:=sqrt(sqr(r)-sqr(x2-xo))+yo-kl*x2-bl;
                            yi:=sqrt(sqr(r)-sqr(xi-xo))+yo-kl*xi-bl;
if (y1*yi>0) then x1:=xi else x2:=xi
                                  end;
xscan:=x1;
end;
 
begin
p1:='y';
while p1='y' do begin
clrscr;
{Разработка параметров объектов:}
{окружность (x+x0)^2+(y+y0)^2=R^2}
xo:=-8;
yoa:=1;         //(y+y0)^2
yob:=20;        //(y+y0)^2
yoc:=99.99999999;       // y^2+20y+100
x1x2(yoa,yob,yoc);
yo:=yoa;{получили хо и уо - координаты центра окружности}
{эллипс (x-xэ)^2/a^2+(y-yэ)/b^2=0}
ye:=2;
xea:=1;
xeb:=-26;
xec:=168.999; //(sqr(10)-sqr(4.345351/19)*360); //169
x1x2(xea,xeb,xec);
xe:=xea;{получили хе и уе - координаты центра эллипса}
{прямая}
kl:=-0.809784;
bl:=15.4;
{Координата по методу итераций}
itera(pixel1);
{Координата по методу сканирования}
scan(pixel2);
writeln(' _____________________________________________________________________');
writeln('|    Объект         | Параметры объектов                              |');
writeln('|___________________|_________________________________________________|');
writeln('|    Окружность     |                                                 |');
writeln('|                   | x0=',xo,'                    y0=',yo,'   |');
writeln('|                   | r=',r,'                                            |');
writeln('|___________________|_________________________________________________|');
writeln('|    Эллипс         |                                                 | ');
writeln('|                   | x0=',xe,'      y0=',ye,'                   |');
writeln('|                   | a=',a,'                     b=',b,'                   |');
writeln('|___________________|_________________________________________________|');
writeln('|    Прямая         |                                                 |');
writeln('|                   | x1=',pixel1,'      y1=',fl(pixel1),'   |');
writeln('|                   | x2=',pixel2,'      y2=',fl(pixel2),'    |');
writeln('|___________________|_________________________________________________|');
writeln('|    Точность       | eps=',e,'                                       |');
writeln('|___________________|_________________________________________________|');
writeln(' ');
writeln('Нажмите любую клавишу для продолжения');
readkey;
clrscr;
writeln('Введите количество разбиений для фигуры А (от 100 до 999)');
readln(n1);
readln(n2);
readln(n3);
clrscr;
writeln(' ________________________________________________________________________');
writeln('|                                Фигура А                                |');
writeln('|________________________________________________________________________|');
writeln('|Число разбиений |                      Результат                        |');
writeln('|________________|_______________________________________________________|');
writeln('|  n             |   А          |        В          |       С            |');
writeln('|________________|______________|___________________|____________________|');
{Площадь (прямоугольник)}
q:=pr(pixel2,0,n1,1);
write('   ',n1,'          ',q);
{Площадь (трапеция)}
q:=trapecia(pixel2,0,n1,1);
write('   ',q);
{Площадь (Симпсон)}
q:=simpson(pixel2,0,n1,1);
write('   ',q,'       ');
{Площадь (прямоугольник)}
q:=pr(pixel2,0,n2,1);
write('   ',n2,'          ',q);
{Площадь (трапеция)}
q:=trapecia(pixel2,0,n2,1);
write('   ',q);
{Площадь (Симпсон)}
q:=simpson(pixel2,0,n2,1);
write('   ',q,'       ');
{Площадь (прямоугольник)}
q:=pr(pixel2,0,n3,1);
write('   ',n3,'          ',q);
{Площадь (трапеция)}
q:=trapecia(pixel2,0,n3,1);
write('   ',q);
{Площадь (Симпсон)}
q:=simpson(pixel2,0,n3,1);
writeln('   ',q,'       ');
writeln('________________________________________________________________________');
readkey;
//clrscr;
writeln('Введите количество разбиений для фигуры В (от 100 до 999)');
readln(n1);
readln(n2);
readln(n3);
clrscr;
writeln(' ________________________________________________________________________');
writeln('|                                Фигура B                                |');
writeln('|________________________________________________________________________|');
writeln('|Число разбиений |                      Результат                        |');
writeln('|________________|_______________________________________________________|');
writeln('|  n             |   А          |        В          |       С            |');
writeln('|________________|______________|___________________|____________________|');
{Площадь (прямоугольник)}
q:=pr(pixel1,0,n1,1);
write('|  ',n1,'          ',q);
{Площадь (трапеция)}
q:=trapecia(pixel1,0,n1,1);
write('|  ',q);
{Площадь (Симпсон)}
q:=simpson(pixel1,0,n1,1);
writeln('|  ',q,'       ');
{Площадь (прямоугольник)}
q:=pr(pixel1,0,n2,1);
write('|  ',n2,'          ',q);
{Площадь (трапеция)}
q:=trapecia(pixel1,0,n2,1);
write('|  ',q);
{Площадь (Симпсон)}
q:=simpson(pixel1,0,n2,1);
write('|  ',q,'           ');
{Площадь (прямоугольник)}
q:=pr(pixel1,0,n3,1);
write('| ',n3,'          |',q);
{Площадь (трапеция)}
q:=trapecia(pixel1,0,n3,1);
write('| |',q);
{Площадь (Симпсон)}
q:=simpson(pixel1,0,n3,1);
writeln('| |',q,'|   |');
writeln('|________________________________________________________________________|');
writeln(' ');
readkey;
repeat
writeln('Continue...?(y/n)');
readln(p1);
clrscr
until (p1='y') or (p1='n');
end;
end.