2 (* Program zaliczeniowy Joanny Chromiec. Rysowanie otoczki wypuklej. *)
\r
7 (* procedury i funkcje EKPAKU i funkcja wsp - pomagajace organizowac ekran *)
\r
9 unit inchar: function:integer;
\r
14 if ii<>0 then exit fi;
\r
19 unit NewPage : procedure;
\r
21 write( chr(27), "[2J")
\r
24 unit SetCursor : procedure(row, column : integer);
\r
36 write( chr(27), "[", c, d, ";", e, f, "H")
\r
39 unit wsp:function(arg:real;czy_x:boolean):integer;
\r
47 (* rysowanie strony tytulowej *)
\r
49 unit tytul:procedure;
\r
52 call setcursor(5,20);
\r
53 writeln(" C O N V E X H U L L ");
\r
54 call setcursor(10,10);
\r
55 writeln(" written by JOANNA CHROMIEC ");
\r
56 call setcursor(11,10);
\r
57 WRITELN(" in LOGLAN programming language");
\r
58 call setcursor(25,26);
\r
59 WRITE ("press any key ");
\r
63 (* wczytanie ilosci punktow, wylosowanie ich inarysowanie na ekranie *)
\r
65 unit menu:procedure;
\r
66 unit ramka : procedure;
\r
69 call gron(0); call move(0,0); call draw(0,347);
\r
70 call draw(719,347); call draw(719,0); call draw(0,0);
\r
71 call move(0,310); call draw(719,310); call move(9,6);
\r
72 call draw(11,6); call move(8,7); call draw(12,7);
\r
73 call move(7,8); call draw(13,8); call move(10,5);
\r
74 call draw(10,305); call draw(710,305); call move(709,304);
\r
75 call draw(709,306); call move(708,304); call draw(708,306);
\r
76 call move(707,303); call draw(707,307); call move(706,303);
\r
77 call draw(706,307); call move(8,105); call draw(12,105);
\r
78 call move(8,205); call draw(12,205); call move(109,304);
\r
79 call draw(109,306); call move(110,304); call draw(110,306);
\r
80 call move(209,304); call draw(209,306); call move(210,304);
\r
81 call draw(210,306); call move(309,304); call draw(309,306);
\r
82 call move(310,304); call draw(310,306); call move(409,304);
\r
83 call draw(409,306); call move(410,304); call draw(410,306);
\r
84 call move(509,304); call draw(509,306); call move(510,304);
\r
85 call draw(510,306); call move(609,304); call draw(609,306);
\r
86 call move(610,304); call draw(610,306);
\r
89 unit losowo:procedure;
\r
93 punkty(i):=new punkt;
\r
94 punkty(i).y:=(entier(random*1000)) mod 300;
\r
95 punkty(i).x:=(entier(random*1000)+350) mod 700;
\r
99 call cirb(wsp(punkty(i).x,true),wsp(punkty(i).y,false),2,2,2,1,1,5,5)
\r
105 CAll setcursor(5,5);
\r
106 write("give a number of points : ");
\r
108 array punkty dim(1:n);
\r
114 (* wybor punktu poczatkowego, wyliczenie thety dla reszty i posortowanie ich *)
\r
116 unit przygotowanie : procedure;
\r
118 unit poy : function(p1,p2:punkt):boolean;
\r
120 result:=(p1.y>p2.y);
\r
123 unit poth : function(p1,p2:punkt):boolean;
\r
125 result:=(p1.theta<p2.theta);
\r
128 unit pox : function(p1,p2:punkt):boolean;
\r
130 result:=(p1.x<p2.x);
\r
133 unit sort : procedure(poc,kon:integer;function porzadek(p1,p2:punkt):boolean);
\r
135 unit quicksort:procedure(l,p:integer);
\r
140 sr:=punkty((l+p) div 2);
\r
142 while porzadek(punkty(i),sr) do i:=i+1 od;
\r
143 while porzadek(sr,punkty(j)) do j:=j-1 od;
\r
146 punkty(i):=punkty(j);
\r
151 if i>j then exit fi;
\r
153 if l<j then call quicksort(l,j) fi;
\r
154 if i<p then call quicksort(i,p) fi;
\r
158 call quicksort(poc,kon);
\r
161 unit wpisztheta : procedure;
\r
162 unit licztheta : function (p:punkt):real;
\r
163 var a, b, dx,dy:integer,
\r
166 dx:=p.x-punkty(1).x;
\r
167 dy:=p.y-punkty(1).y;
\r
170 if dx=0 and dy=0 then th:=0
\r
174 if dx<0 then th:=2-th
\r
176 if dy<0 then th:=th+4 fi;
\r
186 punkty(i).theta:=licztheta(punkty(i));
\r
190 unit znajdzdobry : procedure;
\r
197 if punkty(tu).y<punkty(i).y then
\r
200 if punkty(tu).y=punkty(i).y then
\r
201 if punkty(tu).x>punkty(i).x then tu:=i fi
\r
206 punkty(tu):=punkty(1);
\r
210 var i1, j1 :integer;
\r
212 begin (* przygotowanie *)
\r
215 call sort(2,n,poth);
\r
218 if punkty(i1+1).theta=0 then i1:=i1+1 else exit fi;
\r
219 if i1=n then exit fi;
\r
221 call sort(1,i1,pox);
\r
227 if punkty(i1+1).theta=punkty(j1).theta then i1:=i1+1 else exit fi;
\r
228 if i1=n then exit fi;
\r
230 call sort(j1,i1,poy);
\r
236 (* procedura, szukajaca punktow otoczki za pomoca stosu *)
\r
238 unit dzialaj:procedure;
\r
243 unit dobrze:function:boolean;
\r
244 var dx,dx1,dx2,dy,dy1,dy2:real;
\r
246 dx:=stos.topd qua punkt.x-stos.topg qua punkt.x;
\r
247 dy:=stos.topd qua punkt.y-stos.topg qua punkt.y;
\r
248 dx1:=punkty(1).x-stos.topg qua punkt.x;
\r
249 dy1:=punkty(1).y-stos.topg qua punkt.y;
\r
250 dx2:=punkty(ind+1).x-stos.topd qua punkt.x;
\r
251 dy2:=punkty(ind+1).y-stos.topd qua punkt.y;
\r
252 result:=(dx*dy1-dy*dx1)*(dx*dy2-dy*dx2)>=0
\r
255 unit rysodc: procedure;
\r
257 call move(wsp(stos.topg qua punkt.x,true),wsp(stos.topg qua punkt.y,false));
\r
258 call draw(wsp(stos.topd qua punkt.x,true),wsp(stos.topd qua punkt.y,false));
\r
261 unit zmazodc: procedure;
\r
264 call move(wsp(stos.topg qua punkt.x,true),wsp(stos.topg qua punkt.y,false));
\r
265 call draw(wsp(stos.topd qua punkt.x,true),wsp(stos.topd qua punkt.y,false));
\r
269 unit typstos:class;
\r
271 var szczytg, szczytd : elstosu;
\r
273 unit topg : function : elstosu;
\r
278 unit topd : function : elstosu;
\r
283 unit usun:procedure;
\r
285 if szczytg<> none then
\r
287 if szczytd<>none then szczytd:=szczytd.dowiazanie fi;
\r
291 unit wloz : procedure (el:elstosu);
\r
293 el.dowiazanie:=szczytg;
\r
306 pom:=copy(punkty(i));
\r
307 call stos.wloz(pom);
\r
310 for j:=1 to 200 do od;
\r
313 pom:=copy(punkty(ind));
\r
314 call stos.wloz(pom);
\r
316 for j:=1 to 200 do od;
\r
320 for j:=1 to 200 do od;
\r
325 pom:=copy(punkty(n));
\r
326 call stos.wloz(pom) ;
\r
328 for j:=1 to 200 do od;
\r
329 pom:=copy(punkty(1));
\r
330 call stos.wloz(pom);
\r
332 for j:=1 to 200 do od;
\r
333 (* tutaj rysowanie napisu czy chcesz dzialac dalej *)
\r
335 call hascii(ord('r')); call hascii(ord('e'));
\r
336 call hascii(ord('p')); call hascii(ord('e')); call hascii(ord('a'));
\r
337 call hascii(ord('t')); call hascii(ord('?')); call hascii(ord('('));
\r
338 call hascii(ord('y')); call hascii(ord('/'));
\r
339 call hascii(ord('n'));
\r
340 call hascii(ord(')'));
\r
347 unit elstosu:class;
\r
348 var dowiazanie:elstosu;
\r
352 unit punkt : elstosu class;
\r
358 var punkty:arrayof punkt;
\r
360 var n,control,i,j:integer;
\r
365 while control=ord('y')
\r
368 call przygotowanie;
\r