3 (*Program znajduje najmniejszy wypukly wielokat zawierajacy zadany zbior*)
\r
5 (* autor: Joanna Hybel *)
\r
6 (*program nr 5 jest przedmiotem zal. PP II *)
\r
8 VAR i,j,k,licz,ix:integer,
\r
10 punkty:arrayof punkt; (*zbior punktow*)
\r
20 pref iiuwgraph block
\r
22 UNIT hframe:procedure(x,y,length,width:integer);
\r
23 (*---------------------------------------------*)
\r
26 call draw(x+width,y);
\r
27 call draw(x+width,y+length);
\r
28 call draw(x,y+length);
\r
32 UNIT hwrite:procedure(tekst:string;x,y:integer);
\r
33 (*---------------------------------------------*)
\r
39 for i:=lower(tab) to upper(tab)
\r
41 call hascii(ord(tab(i)));
\r
45 UNIT inchar:function:integer;
\r
46 (*---------------------------------------------*)
\r
51 if ii<>0 then exit fi;
\r
56 UNIT zmaz :procedure(x,y,dl,sz:integer);
\r
57 (*---------------------------------------------*)
\r
63 call move(x+(j-1)*8,y+(i-1)*8);
\r
69 UNIT wpisz_theta:procedure;
\r
70 (*---------------------------------------------*)
\r
72 UNIT uzup_theta:function(p:punkt):real;
\r
76 dx:=p.x-punkty(1).x;
\r
77 dy:=p.y-punkty(1).y;
\r
78 if dx=0 and dy=0 then th:=0
\r
80 th:=dy/(abs(dx)+abs(dy));
\r
82 if dx<0 then th:=2-th
\r
84 if dy<0 then th:=th+4 fi;
\r
90 punkty(i).theta:=uzup_theta(punkty(i));
\r
94 UNIT rys_otocz:procedure;
\r
95 (*---------------------------------------------*)
\r
96 UNIT czysc:procedure(p1,p2:punkt);
\r
98 call move(p2.x,p2.y);
\r
100 call draw(p1.x,p1.y);
\r
102 call cirb(p2.x,p2.y,2,3,3,1,1,2,2);
\r
103 call cirb(p1.x,p1.y,2,3,3,1,1,2,2);
\r
106 UNIT rys:procedure(p1,p2:punkt);
\r
109 call move(p2.x,p2.y);
\r
110 call draw(p1.x,p1.y);
\r
113 UNIT po_tej_samej_str: function(p1,p2,p3:punkt):boolean;
\r
114 (*Czy punkty punkty(1),p3 leza po tej samej stronie prostej p1,p2?*)
\r
115 var dx1,dx2,dx3,dy1,dy2,dy3,k,l:real;
\r
121 dx3:=punkty(1).x-p1.x;
\r
122 dy3:=punkty(1).y-p1.y;
\r
123 k:=(dy2*dx1-dy1*dx2);
\r
124 l:=(dy3*dx1-dy1*dx3);
\r
125 if k=0 orif l=0 then result:=true;
\r
127 if k>0 then result:=(l>0);
\r
128 else result:=(l<0);
\r
131 end po_tej_samej_str;
\r
133 call hwrite("press any key to draw a CONVEX HULL",24,316);
\r
135 call rys(punkty(1),punkty(2));
\r
141 if po_tej_samej_str(punkty(i-1),punkty(i),punkty(k)) then
\r
144 call czysc(punkty(i-1),punkty(i));
\r
149 punkty(i):=punkty(k);
\r
151 call rys(punkty(i-1),punkty(i));
\r
153 call rys(punkty(i),punkty(1));
\r
154 call zmaz(24,304,32,580);
\r
157 UNIT dane :procedure;
\r
158 (*---------------------------------------------*)
\r
159 UNIT los_gen:procedure;
\r
162 for i:=1 to licz do
\r
164 x1:=random*400+100;
\r
165 if x1>5 andif x1<614 then
\r
172 if y1>35 andif y1<300 then
\r
177 call cirb(x1,y1,2,3,3,11,1,2,2);
\r
181 UNIT uzyt_gen :procedure;
\r
183 call hwrite("USE ARROWS TO MOVE THE CURSOR",24,308);
\r
184 call hwrite("END - finishes",24,320);
\r
186 call track(300,150);
\r
189 if inxpos>5 andif inxpos<514 then
\r
190 if inypos>35 andif inypos<287 then
\r
192 punkty(k).x:=inxpos;
\r
193 punkty(k).y:=inypos;
\r
194 call cirb(inxpos,inypos,2,3,3,11,1,2,2);
\r
197 if k=licz then exit fi;
\r
198 call track(inxpos+3,inypos)
\r
200 call zmaz(24,304,32,580);
\r
203 call zmaz(24,304,32,580);
\r
204 call hwrite("the number of points 3",20,291);
\r
205 call hwrite("1 - if you would like less points ",20,303);
\r
206 call hwrite("2 - if you would like more points ",20,315);
\r
207 call hwrite("ENTER - to continue execution",20,327);
\r
212 when 50 : if licz<99 then licz:=licz+1 ;
\r
213 call move(252,291);
\r
215 call move(260,291);
\r
217 call move(252,291);
\r
218 if licz>9 then call hascii(licz div 10+48) fi;
\r
219 call hascii(licz mod 10 +48);
\r
221 when 49 : if licz>3 then licz:=licz-1 ;
\r
222 call move(252,291);
\r
224 call move(260,291);
\r
226 call move(252,291);
\r
227 if licz>9 then call hascii(licz div 10+48) fi;
\r
228 call hascii(licz mod 10 +48);
\r
235 array punkty dim (1:licz);
\r
236 for i:=1 to licz do
\r
237 punkty(i):=new punkt;
\r
239 call zmaz(20,291,48,580);
\r
240 call hwrite("M E N U :",20,291);
\r
241 call hwrite("1 - random generation of points",20,303);
\r
242 call hwrite("2 - points given by user",20,315);
\r
245 if ix=49 orif ix=50 then exit fi;
\r
247 call zmaz(20,291,48,580);
\r
249 when 49:call los_gen;
\r
250 when 50:call uzyt_gen;
\r
255 UNIT znajdz_max_y:procedure;
\r
256 (*---------------------------------------------*)
\r
260 for i:=1 to licz do
\r
261 if pom.y> punkty(i).y then(*bylo <*)
\r
265 if pom.y=punkty(i).y then
\r
266 if pom.x> punkty(i).x then
\r
274 punkty(1):=punkty(j);
\r
278 (*funkcje okreslajace wzgl. czego sortujemy : *)
\r
280 unit l1 :function(p1,p2:punkt):boolean;
\r
282 result:=(p1.theta<p2.theta);
\r
284 unit l2:function(p1,p2:punkt):boolean;
\r
286 result:=(p1.y<p2.y);
\r
288 unit l3:function(p1,p2:punkt):boolean;
\r
290 result:=(p1.x <p2.x);
\r
294 UNIT posortuj:procedure;
\r
295 (*---------------------------------------------*)
\r
297 (* Sortowanie punktow wzgledem kata jaki tworza z prosta pozioma, *)
\r
298 (* przechodzaca przez punkt o najmniejszej wspolrz.y i x *)
\r
299 var kon,pocz:integer,
\r
302 UNIT sort:procedure (function log(p1,p2:punkt):boolean);
\r
304 unit quicksort:procedure(l,p:integer);
\r
309 x:=punkty((l+p) div 2);
\r
311 while log(punkty(i),x) do
\r
313 while log(x,punkty(j)) do
\r
316 w:=punkty(i); punkty(i):=punkty(j); punkty(j):=w;
\r
320 if i>j then exit fi;
\r
322 if l<j then call quicksort(l,j) fi;
\r
323 if i<p then call quicksort(i,p) fi;
\r
329 call quicksort(pocz,kon);
\r
340 if punkty(i).theta=0 then lg1:=true fi;
\r
342 lg:=(punkty(i).theta=punkty(i+1).theta);
\r
343 if lg then i:=i+1 ;
\r
347 if i=licz then exit fi;
\r
349 if lg1 and i=j then lg1:=false fi;
\r
353 if lg1 then lg1:=false;
\r
354 (*porzadkowanie punktow lezacych na prostej poziomej,przechodzacych przez*)
\r
355 (*punkt zaczepienia - punkty(1) ;tj.tworza kat zerowy z punktem zaczepienia *)
\r
358 (*porzadkowanie punktow tworzacych ten sam kat rozny od zerowego*)
\r
365 (*---------------------------------------------------------------------------*)
\r
366 begin (*PROGRAM GLOWNY*)
\r
369 call hframe(5,3,342,610);
\r
370 call hframe(4,2,340,612);
\r
371 call hframe(5,287,54,610);
\r
372 call hframe(5,7,28,610);
\r
374 call hwrite("CONVEX HULL by Joanna Hybel",185,17);
\r
381 call hwrite("ESC - end of program execution",24,308);
\r
382 call hwrite("ENTER - continue ",24,320);
\r
386 when 13:call zmaz(6,37,246,608);
\r