program Pierw; const PI=3.14159; unit sgn:function(x:real):real; begin if x>0 then result:=1 else if x=0 then result:=0 else result:=-1 fi fi end sgn; unit sqr:function(x:real):real; begin result:=x*x end sqr; unit grafika:class(Xlewe,Xprawe,Ygorne,Ydolne:real); unit punkt:class(x,y:real); (* unit zaznacz:procedure; begin call ekran.krzyzyk(x,y) end zaznacz; unit opisz:procedure(zn:char); begin call ekran.opis(x,y,zn) end opisz;*) end punkt; (*=========================================================================*) unit prosta:class(a,b:punkt); var k1,k2:punkt; (* unit RysujProsta:procedure; var l:real; begin l:=(odleglosc(new punkt(Xlewe,Ydolne), new punkt(Xprawe,Ygorne))/odleglosc(a,b); k1:=new punkt(l*(a.x-b.x)+a.x,l*(a.y-b.y)+a.y); k2:=new punkt(l*(b.x-a.x)+b.x,l*(b.y-a.y)+b.y); call ekran.odcinek(k1.x,k1.y,k2.x,k2.y) end RysujProsta; unit RysujOdcinek:procedure(c:punkt); begin { ZAKLADAMY, ZE C JEST NA PROSTEJ } { JESLI K1=NONE, TO K2=NONE } if k1=none then k1,k2:=c; call ekran.odcineczek(a.x,a.y,b.x,b.y,k1.x,k1.y) else if lewy(k1,c)=c then call ekran.odcinek(c.x,c.y,k1.x,k1.y); k1:=c else if prawy(k2,c)=c then call ekran.odcinek(k2.x,k2.y,c.x,c.y); k2:=c fi fi fi end RysujOdcinek; unit RysujPolprPr(c:punkt); var l:real; begin l:=(odleglosc(new punkt(Xlewe,Ydolne), new punkt(Xprawe,Ygorne))/odleglosc(a,b); k2:=new punkt(l*(b.x-a.x)+b.x,l*(b.y-a.y)+b.y); call ekran.odcinek(c.x,c.y,k2.x,k2.y) end RysujPolprPr; unit RysujPolprLw(c:punkt); var l:real; begin l:=(odleglosc(new punkt(Xlewe,Ydolne), new punkt(Xprawe,Ygorne))/odleglosc(a,b); k1:=new punkt(l*(a.x-b.x)+a.x,l*(a.y-b.y)+a.y); call ekran.odcinek(k1.x,k1.y,c.x,c.y) end RysujPolprLw; *) unit lewy:function(c,d:punkt):punkt; begin if (sgn(b.x-a.x)=sgn(d.x-c.x)) orif (sgn(b.y-a.y)=sgn(d.y-c.y)) then result:=c else result:=d fi end lewy; unit prawy:function(c,d:punkt):punkt; begin if (sgn(b.x-a.x)=sgn(d.x-c.x)) orif (sgn(b.y-a.y)=sgn(d.y-c.y)) then result:=d else result:=c fi end prawy; end prosta; (*=========================================================================*) unit okrag:class(S:punkt,r:real); (* unit RysujOkrag:procedure; begin call ekran.okrag(S.x,S.y,r,0.0,2*PI) end RysujOkrag; unit RysLuk1:procedure(A:punkt); var alfa:real; begin alfa:=asin((A.y-S.y)/r) end RysLuk1; unit RysLuk2:procedure(A,B:punkt); begin call ekran.okrag(S.x,S.y,r,asin((A.y-S.y)/r)-0.18, asin((B.y-S.y)/r)+0.18) end;*) (* unit PrawoLewo:class(OdCzego,A,B:punkt); var alfa,beta,gamma:real; begin gamma:=asin((OdCzego.y-S.y)/r); alfa:=asin((A.y-S.y)/r)-gamma; beta:=asin((B.y-S.y)/r)-gamma; if alfa<0.0 then alfa:=alfa+2*PI fi; if beta<0.0 then beta:=beta+2*PI fi; end PrawoLewo; unit NaPrawo:PrawoLewo function :punkt; begin if alfa(O1.r+O2.r)) or (abs(O1.r-O2.r)>d) then return fi; (* Przesuwamy uklad wsp. o wektor O1.S *) S2x:=O2.S.x-O1.S.x; S2y:=O2.S.y-O1.S.y; (* Obracamy uklad wsp. o kat alfa pod jakim O1 O2 przecina os odcietych *) sin_alfa:=S2y/d; cos_alfa:=S2x/d; (* Obliczamy wsp jednego punktu przeciecia *) x:=(sqr(O1.r)-sqr(O2.r))/(2*d)+d/2; y:=sqrt(sqr(O1.r)-sqr(x)); (* Drugi punkt przeciecia jest symetryczny wzgledem os OX *) (* Wracamy do ukladu sprzed obrotu *) Q1:=new punkt (x*cos_alfa-y*sin_alfa,x*sin_alfa+y*cos_alfa); Q2:=new punkt(x*cos_alfa+y*sin_alfa,x*sin_alfa-y*cos_alfa); (* Wracamy do ukladu sprzed przesuniecia *) Q2.x:=Q2.x+O1.S.x; Q2.y:=Q2.y+O1.S.y; Q1.x:=Q1.x+O1.S.x; Q1.y:=Q1.y+O1.S.y end CzwOO; (*======================================================================*) unit CzwOP:procedure(O:okrag,P:prosta;output Q1,Q2:punkt); var A,B,C,x,y,pom,d,odl,wersorX,wersorY,ax,ay,bx,by:real; begin ax:=P.a.x-O.S.x; bx:=P.b.x-O.S.x; ay:=P.a.y-O.S.y; by:=P.b.y-O.S.y; A:=by-ay; B:=ax-bx; C:=bx*ay-ax*by; pom:=-C/(A*A+B*B); x:=A*pom; y:=B*pom; d:=odleglosc(P.a,P.b); wersorX:=(bx-ax)/d; wersorY:=(by-ay)/d; odl:=sqr(O.r)-(sqr(x)+(sqr(y))); if odl<0 then return fi; odl:=sqrt(odl); Q1:=new punkt(x+wersorX*odl+O.S.x,y+wersorY*odl+O.S.y); Q2:=new punkt(x-wersorX*odl+O.S.x,y-wersorY*odl+O.S.y) end CzwOP end grafika; begin pref grafika(-100,100,100,-100) block var punkty:array_of punkt, okregi:array_of okrag, proste:array_of prosta, konce1,konce2,srodki:array_of integer, i,j,k,l,m,n:integer, c,c1:char, x,y,z:real; unit piszwynik :procedure(i,j:integer); begin writeln("nrp x y"); write(i," "); if punkty(i)=none then writeln("none") else writeln(punkty(i).x,punkty(i).y) fi; write(j," "); if punkty(j)=none then writeln("none") else writeln(punkty(j).x,punkty(j).y) fi end piszwynik; begin writeln("Jakie n?"); readln(n); array punkty dim(1:n); array okregi dim(1:n); array proste dim(1:n); array srodki dim(1:n); array konce1 dim(1:n); array konce2 dim(1:n); do write(" Point Line Circle Intersection Quit :"); readln(c); case c when 'p': write("New List :"); readln(c1); case c1 when 'n': write("point: nr x y "); readln(i,x,y); punkty(i):=new punkt(x,y); when 'l': j:=1; for i:=1 to n do if (j mod 25)=1 then write("nr x y"); j:=j+1; readln fi; if punkty(i)<>none then writeln(i," ",punkty(i).x," ", punkty(i).y); j:=j+1 fi od; esac; when 'l': write("New List "); readln(c1); case c1 when 'n': write("nrl nrp nrp :"); readln(i,j,k); proste(i):=new prosta(punkty(j),punkty(k)); konce1(i):=j; konce2(i):=k; when 'l': j:=1; for i:=1 to n do if (j mod 25)=1 then write("nrl nrp nrp"); j:=j+1; readln fi; if proste(i)<>none then writeln(i," ",konce1(i)," ", konce2(i)); j:=j+1 fi od; esac; when 'c': write("New List "); readln(c1); case c1 when 'n': write("nrc nrp rad :"); readln(i,j,x); okregi(i):=new okrag(punkty(j),x); srodki(i):=j; when 'l': j:=1; for i:=1 to n do if (j mod 25)=1 then write("nrc nrp rad"); j:=j+1; readln fi; if okregi(i)<>none then writeln(i," ",srodki(i)," ", okregi(i).r); j:=j+1 fi od; esac; when 'i': write (" 1-LL 2-CL 3-CC "); readln(c1); case c1 when '1': write("nrp nrp nrl nrl "); readln(i,j,k,l); call CZwPP(proste(k),proste(l),punkty(i),punkty(j)); call piszwynik(i,j); when '2': write("nrp nrp nrc nrl "); readln(i,j,k,l); call CZwOP(okregi(k),proste(l),punkty(i),punkty(j)); call piszwynik(i,j); when '3': write("nrp nrp nrc nrc "); readln(i,j,k,l); call CZwOO(okregi(k),okregi(l),punkty(i),punkty(j)); call piszwynik(i,j); esac; when 'q': call endrun; esac; od end end.