3 unit sgn:function(x:real):real;
\r
14 unit sqr:function(x:real):real;
\r
18 unit grafika:class(Xlewe,Xprawe,Ygorne,Ydolne:real);
\r
20 unit punkt:class(x,y:real);
\r
21 (* unit zaznacz:procedure;
\r
23 call ekran.krzyzyk(x,y)
\r
26 unit opisz:procedure(zn:char);
\r
28 call ekran.opis(x,y,zn)
\r
32 (*=========================================================================*)
\r
34 unit prosta:class(a,b:punkt);
\r
37 (* unit RysujProsta:procedure;
\r
40 l:=(odleglosc(new punkt(Xlewe,Ydolne),
\r
41 new punkt(Xprawe,Ygorne))/odleglosc(a,b);
\r
42 k1:=new punkt(l*(a.x-b.x)+a.x,l*(a.y-b.y)+a.y);
\r
43 k2:=new punkt(l*(b.x-a.x)+b.x,l*(b.y-a.y)+b.y);
\r
44 call ekran.odcinek(k1.x,k1.y,k2.x,k2.y)
\r
47 unit RysujOdcinek:procedure(c:punkt);
\r
49 { ZAKLADAMY, ZE C JEST NA PROSTEJ }
\r
50 { JESLI K1=NONE, TO K2=NONE }
\r
55 call ekran.odcineczek(a.x,a.y,b.x,b.y,k1.x,k1.y)
\r
59 call ekran.odcinek(c.x,c.y,k1.x,k1.y);
\r
64 call ekran.odcinek(k2.x,k2.y,c.x,c.y);
\r
71 unit RysujPolprPr(c:punkt);
\r
74 l:=(odleglosc(new punkt(Xlewe,Ydolne),
\r
75 new punkt(Xprawe,Ygorne))/odleglosc(a,b);
\r
76 k2:=new punkt(l*(b.x-a.x)+b.x,l*(b.y-a.y)+b.y);
\r
77 call ekran.odcinek(c.x,c.y,k2.x,k2.y)
\r
80 unit RysujPolprLw(c:punkt);
\r
83 l:=(odleglosc(new punkt(Xlewe,Ydolne),
\r
84 new punkt(Xprawe,Ygorne))/odleglosc(a,b);
\r
85 k1:=new punkt(l*(a.x-b.x)+a.x,l*(a.y-b.y)+a.y);
\r
86 call ekran.odcinek(k1.x,k1.y,c.x,c.y)
\r
87 end RysujPolprLw; *)
\r
89 unit lewy:function(c,d:punkt):punkt;
\r
91 if (sgn(b.x-a.x)=sgn(d.x-c.x)) orif
\r
92 (sgn(b.y-a.y)=sgn(d.y-c.y))
\r
98 unit prawy:function(c,d:punkt):punkt;
\r
100 if (sgn(b.x-a.x)=sgn(d.x-c.x)) orif
\r
101 (sgn(b.y-a.y)=sgn(d.y-c.y))
\r
109 (*=========================================================================*)
\r
111 unit okrag:class(S:punkt,r:real);
\r
113 (* unit RysujOkrag:procedure;
\r
115 call ekran.okrag(S.x,S.y,r,0.0,2*PI)
\r
118 unit RysLuk1:procedure(A:punkt);
\r
121 alfa:=asin((A.y-S.y)/r)
\r
124 unit RysLuk2:procedure(A,B:punkt);
\r
126 call ekran.okrag(S.x,S.y,r,asin((A.y-S.y)/r)-0.18,
\r
127 asin((B.y-S.y)/r)+0.18)
\r
130 (* unit PrawoLewo:class(OdCzego,A,B:punkt);
\r
131 var alfa,beta,gamma:real;
\r
133 gamma:=asin((OdCzego.y-S.y)/r);
\r
134 alfa:=asin((A.y-S.y)/r)-gamma;
\r
135 beta:=asin((B.y-S.y)/r)-gamma;
\r
137 if alfa<0.0 then alfa:=alfa+2*PI fi;
\r
138 if beta<0.0 then beta:=beta+2*PI fi;
\r
141 unit NaPrawo:PrawoLewo function :punkt;
\r
143 if alfa<beta then result:=A
\r
148 unit NaLewo:PrawoLewo function :punkt;
\r
150 if alfa<beta then result:=B
\r
157 (*=========================================================================*)
\r
159 unit odleglosc:function(A,B:punkt):real;
\r
161 result:=sqrt(sqr(a.x-b.x)+sqr(a.y-b.y))
\r
164 (*========================================================================*)
\r
166 unit CzWPP:procedure(P1,P2:prosta;output Q1,Q2:punkt);
\r
167 var W,W1,W2,teta1,delta_x,delta_y,deltaP1x,
\r
168 deltaP2x,deltaP1y,deltaP2y:real;
\r
169 const epsilon=0.0000001192;
\r
171 deltaP1x:=P1.b.x-P1.a.x;
\r
172 deltaP2x:=P2.b.x-P2.a.x;
\r
173 deltaP1y:=P1.b.y-P1.a.y;
\r
174 deltaP2y:=P2.b.y-P2.a.y;
\r
175 delta_x:=P2.a.x-P1.a.x;
\r
176 delta_y:=P2.a.y-P1.a.y;
\r
178 W:=-deltaP1x*deltaP2y+deltaP1y*deltaP2x;
\r
179 W1:=deltaP2x*delta_y-deltaP2y*delta_x;
\r
180 W2:=deltaP1x*delta_y-deltaP1y*delta_x;
\r
184 if (abs(W1)<=epsilon) or (abs(W2)<=epsilon)
\r
185 then (* continuum rozwiazan *)
\r
188 else (* brak rozwiazan *)
\r
193 Q1:=new punkt(P1.a.x+teta1*deltaP1x,P1.a.y+teta1*deltaP1y);
\r
198 (*======================================================================*)
\r
200 unit CzwOO: procedure(O1,O2:okrag;output Q1,Q2:punkt);
\r
201 var d,S2x,S2y,x,y,sin_alfa,cos_alfa:real;
\r
203 d:=odleglosc(O1.S,O2.S);
\r
204 if (d>(O1.r+O2.r)) or (abs(O1.r-O2.r)>d) then return fi;
\r
206 (* Przesuwamy uklad wsp. o wektor O1.S *)
\r
207 S2x:=O2.S.x-O1.S.x;
\r
208 S2y:=O2.S.y-O1.S.y;
\r
210 (* Obracamy uklad wsp. o kat alfa pod jakim O1 O2 przecina
\r
215 (* Obliczamy wsp jednego punktu przeciecia *)
\r
216 x:=(sqr(O1.r)-sqr(O2.r))/(2*d)+d/2;
\r
217 y:=sqrt(sqr(O1.r)-sqr(x));
\r
218 (* Drugi punkt przeciecia jest symetryczny wzgledem os OX *)
\r
220 (* Wracamy do ukladu sprzed obrotu *)
\r
221 Q1:=new punkt (x*cos_alfa-y*sin_alfa,x*sin_alfa+y*cos_alfa);
\r
222 Q2:=new punkt(x*cos_alfa+y*sin_alfa,x*sin_alfa-y*cos_alfa);
\r
224 (* Wracamy do ukladu sprzed przesuniecia *)
\r
231 (*======================================================================*)
\r
233 unit CzwOP:procedure(O:okrag,P:prosta;output Q1,Q2:punkt);
\r
234 var A,B,C,x,y,pom,d,odl,wersorX,wersorY,ax,ay,bx,by:real;
\r
249 d:=odleglosc(P.a,P.b);
\r
250 wersorX:=(bx-ax)/d;
\r
251 wersorY:=(by-ay)/d;
\r
253 odl:=sqr(O.r)-(sqr(x)+(sqr(y)));
\r
254 if odl<0 then return fi;
\r
257 Q1:=new punkt(x+wersorX*odl+O.S.x,y+wersorY*odl+O.S.y);
\r
258 Q2:=new punkt(x-wersorX*odl+O.S.x,y-wersorY*odl+O.S.y)
\r
263 pref grafika(-100,100,100,-100) block
\r
264 var punkty:array_of punkt,
\r
265 okregi:array_of okrag,
\r
266 proste:array_of prosta,
\r
267 konce1,konce2,srodki:array_of integer,
\r
268 i,j,k,l,m,n:integer,
\r
271 unit piszwynik :procedure(i,j:integer);
\r
273 writeln("nrp x y");
\r
275 if punkty(i)=none then writeln("none")
\r
276 else writeln(punkty(i).x,punkty(i).y)
\r
279 if punkty(j)=none then writeln("none")
\r
280 else writeln(punkty(j).x,punkty(j).y)
\r
285 writeln("Jakie n?");
\r
287 array punkty dim(1:n);
\r
288 array okregi dim(1:n);
\r
289 array proste dim(1:n);
\r
290 array srodki dim(1:n);
\r
291 array konce1 dim(1:n);
\r
292 array konce2 dim(1:n);
\r
295 write(" Point Line Circle Intersection Quit :");
\r
299 write("New List :");
\r
303 write("point: nr x y ");
\r
305 punkty(i):=new punkt(x,y);
\r
309 if (j mod 25)=1 then
\r
314 if punkty(i)<>none then
\r
315 writeln(i," ",punkty(i).x," ",
\r
322 write("New List ");
\r
326 write("nrl nrp nrp :");
\r
328 proste(i):=new prosta(punkty(j),punkty(k));
\r
334 if (j mod 25)=1 then
\r
335 write("nrl nrp nrp");
\r
339 if proste(i)<>none then
\r
340 writeln(i," ",konce1(i)," ",
\r
347 write("New List ");
\r
351 write("nrc nrp rad :");
\r
353 okregi(i):=new okrag(punkty(j),x);
\r
358 if (j mod 25)=1 then
\r
359 write("nrc nrp rad");
\r
363 if okregi(i)<>none then
\r
364 writeln(i," ",srodki(i)," ",
\r
371 write (" 1-LL 2-CL 3-CC ");
\r
375 write("nrp nrp nrl nrl ");
\r
377 call CZwPP(proste(k),proste(l),punkty(i),punkty(j));
\r
378 call piszwynik(i,j);
\r
380 write("nrp nrp nrc nrl ");
\r
382 call CZwOP(okregi(k),proste(l),punkty(i),punkty(j));
\r
383 call piszwynik(i,j);
\r
385 write("nrp nrp nrc nrc ");
\r
387 call CZwOO(okregi(k),okregi(l),punkty(i),punkty(j));
\r
388 call piszwynik(i,j);
\r
390 when 'q': call endrun;
\r