2 #include "classes/gui.inc"
3 (*Program ma pokazac dzialanie algorytmow geometrycznych *)
4 (* o ktorych mowilam na wykladzie*)
15 sz = 30, (*szerokosc paska menu*)
16 my_ecranMinX = MinX+5,
17 my_ecranMinY = MinY+sz+3,
19 my_ecranMaxY= MaxY-(2*sz+1),
28 (*------------------------------------------------------------------------*)
30 (*------------------------------------------------------------------------*)
31 (* klasa definiujaca procedury graficzne *)
32 (*------------------------------------------------------------------------*)
33 UNIT graphics : GUI CLASS;
36 UNIT pauza : PROCEDURE(JakDlugo:integer);
39 for i :=1 to JakDlugo do i:=i od;
43 UNIT waitt : PROCEDURE;
46 While GUI_KeyPressed=/= 0 DO OD;
49 UNIT clear_all : procedure;
51 call GUI_Rect(my_ecranMinX, my_ecranMinY, my_ecranMaxX,
52 my_EcranMaxY,c_DarkGrey,c_LightGrey);
53 call GUI_Rect(my_EcranMinX, MaxY-2*sz,
54 my_EcranMaxX,MaxY-5,c_DarkGrey,c_DarkGrey);
57 UNIT clear : PROCEDURE(x0,y0,x1,y1,c1,c2: integer);
58 (* wymaz wszystko w prostokacie (x0,y0)-(y1,y1) *)
59 (* Zostaw ekran w kolorze c2*)
60 var i,j,x,y : integer;
65 while i<=x and j<=y do
66 call GUI_Rect(x0+i,y0+j,x1-i,y1-j,c_black,c_lightGrey);
69 while i>=0 and j>=0 do
70 call GUI_Rect(x0+i,y0+j,x1-i,y1-j,c1,c2);
76 (**************************************************************************)
78 UNIT katy : procedure(col1,col2,x,y,u,v,grubosc: integer);
83 call GUI_Line(x+i,y+i,u-i,y+i, col1);
84 call GUI_Line(x+i,y+i,x+i,v-i, col1)
88 call GUI_Line(u-i,v-i,x+i,v-i,col2);
89 call GUI_Line(u-i,v-i,u-i,y+i, col2);
94 unit comment: procedure(ss:string);
96 call GUI_Rect(minX+4,maxY-2*sz,maxX-4,maxY-10,c_darkGrey,c_darkGrey);
97 (* wymazanie obszaru pod komentarze *)
98 call GUI_writeText(comX+10,comY,unpack(ss),c_white,c_darkGrey);
101 unit YES : function : boolean;
104 while (c <> 'y' and c<> 'Y' and c <> 'n' and c<> 'N' ) do
105 call GUI_move(comX,comY);
106 c:= GUI_ReadChar(comX,comY,c_turq,c_lightGrey) od;
107 if (c= 'y' or c='Y') then
108 result := true else result := false
113 (*************************************************************************)
119 (*-----------------------------------------------------------------------*)
122 (*-----------------------------------------------------------------------*)
123 unit option : class(nb : integer);
124 var Nom : arrayof string;
125 unit virtual action : procedure(j : integer);
129 array Nom dim (1:nb);
133 unit ikona : class(c,x,y,u,v,grubosc : integer, ss : string);
135 unit write_i : procedure;
138 call GUI_Rect(x,y,u,v,c_black,c);
139 call katy(c_white,c_darkGrey,x,y,u,v,grubosc);
140 call GUI_writeText(x+grubosc+3,y+(v-y)div 2 - 5 ,unpack(ss),c_black,c)
143 unit wymaz : procedure;
145 call GUI_Rect(x,y,u,v,c_black,c_lightGrey);
148 unit push : procedure;
149 (* nacisniecie wybranej ikony *)
151 call katy(c_darkGrey,c_white,x,y,u,v,grubosc);
153 call katy (c_white,c_darkGrey,x,y,u,v,grubosc);
157 unit inactive : procedure;
159 call katy(c_white,c_darkGrey,x,y,u,v,grubosc);
161 call katy (c_darkGrey,c_white,x,y,u,v,grubosc);
166 unit CZY : function(xx,yy:integer,IC:Ikona): boolean;
167 begin (* czy mysz nacisnieta w polozeniu ikony IC *)
168 result := (IC.x<xx and xx<IC.u
169 and IC.y<yy and yy<IC.v)
173 unit menu : coroutine(minX,maxX,MinY,MaxY :integer, OPTIONS :option);
174 (* sz szerokosc paska ikon *)
175 var ICONES: arrayof IKONA, i,j,nb, x1, y1, dl : integer,
179 (* dl and sz - wymiary ikon w tym menu *)
181 unit instalation : procedure;
182 (* rysowanie menu oraz jego ikon *)
185 call GUI_Rect(minX,minY,maxX,maxY,c_black,c_lightGrey);
186 (* duzy obszar szary *)
188 call GUI_Rect(minX+4,maxY-(2*sz),maxX-4,maxY-4,c_black,c_darkGrey);
189 (*obszar dla komentarzy*)
192 call ICONES(i).write_i
196 unit INI : procedure;
197 var x,y,u,v : integer;
200 dl := (MaxX-Minx) div nb ;
202 array ICONES dim(1:nb);
203 x := minX+2; y := minY+2;
204 u := minX+dl-4; v := minY+sz;
207 ICONES(i) := new ikona(c_lightGrey,x,y,u,v,2,OPTIONS.NOM(i));
208 x := x+dl; u := u+dl;
213 call comment(" error exec ");
214 call YES_ikona.write_i;
215 call NO_ikona.write_i;
217 while not z=1 do call GUI_MousePressed(xx,yy,z) od;
219 (* szukam gdzie zostal nacisniety lewy klawisz myszki*)
220 if CZY(xx,yy,YES_ikona)
223 call clear(minX+5,minY+sz+3,maxX-5,maxY-2*sz-1,c_white,c_lightGrey);
226 if CZY(xx,yy,NO_ikona)
229 call clear(minX+5,minY+sz+3,maxX-5,maxY-2*sz-1,c_white,c_lightGrey);
234 others call comment(" ERROR press YES to continue or NO to stop?");
236 call YES_ikona.write_i;
237 call NO_ikona.write_i;
239 while not z=1 do call GUI_MousePressed(xx,yy,z) od;
241 (* szukam gdzie zostal nacisniety lewy klawisz myszki*)
242 if CZY(xx,yy,YES_ikona)
245 call clear(minX+5,minY+sz+3,maxX-5,maxY-2*sz-1,c_white ,c_lightGrey);
248 if CZY(xx,yy,NO_ikona)
251 call clear(minX+5,minY+sz+3,maxX-5,maxY-2*sz-1,c_white ,c_lightGrey);
260 do (* obsluga menu *)
261 call instalation; (* rysowanie ikon z tego menu *)
266 call GUI_MousePressed(xx,yy,i) ;
269 (* szukam gdzie zostal nacisniety lewy klawisz myszki *)
272 if czy(xx,yy,ICONES(j))
274 call ICONES(j).push;exit;
279 call OPTIONS.Action(j);
283 if ICONES(j).sub_menu<>none then
284 attach(ICONES(j).sub_menu);
293 unit OPTIONS_MAIN : option class;
294 unit virtual Action : procedure(j : integer);
295 begin (* opcje glownego menu*)
298 when 1 : call comment("Exit ");
299 when 2 : call comment("Wczytanie danych do problemu otoczki.");
300 call WczytajDane(il_punktow,TAB);
301 when 3 : call comment("Dane do problemu przeciec odcinkow");
303 when 4 : call comment("Tu ma byc informacja o algorytmie");
314 unit OPTIONS_OTOCZKA : option class;
315 unit virtual Action : procedure(j : integer);
316 var x: integer, boo : boolean;
319 when 1 : call comment("RETURN ");
320 when 2 : call GRAHAM(il_punktow,TAB);
321 when 3 : call JARVIS(il_punktow,TAB);
322 when 4 : call TROJKATY(il_punktow,TAB);
330 Nom(4) := "TROJKATY";
334 unit OPTIONS_help : option class;
335 var ch : char, i:integer;
336 unit virtual Action : procedure(j : integer);
339 when 1 : call comment(" ");
340 when 2 : call comment("NACISNIJ Y lub N");
341 if YES then call comment("") fi;
342 when 3 : call comment("");
351 (*===================================================================*)
353 unit WczytajDane : procedure(inout il_punktow:integer,TAB : arrayof punkt);
354 const pminX = 30, pminY =50, pmaxX= 400, pmaxY=200,
356 var i ,xx, yy: integer, IK : arrayof IKONA;
359 array IK dim(1 : il_ikon);
360 call GUI_Rect(pminX,pminY,pmaxX,pmaxY,c_darkGrey,c_green);
361 call GUI_WriteText(pminX+10, pminY+10,unpack("Ilosc punktow = "),
363 call GUI_writeInt(pminX+150,pminY+10,
364 il_punktow, c_darkGrey,c_green);
365 call GUI_WriteText(pminX+10, pminY+45,unpack("Jakosc w % = "),
368 IK(1) :=new IKONA (6,pminX+200,pminY+10,pminX+250,pminY+35,3,"PLUS");
369 IK(2) :=new IKONA (6,pminX+260,pminY+10,pminX+310,pminY+35,3,"MINUS");
370 IK(3) :=new IKONA (6,pminX+200,pminY+45,pminX+250,pminY+70,3,"PLUS");
371 IK(4) :=new IKONA (6,pminX+260,pminY+45,pminX+310,pminY+70,3,"MINUS");
372 IK(5) := new IKONA (6,pminX+200,pminY+120,pminX+250,pminY+145,3,"EXIT");
373 for i:=1 to il_ikon do call IK(i).write_i; od;
374 (*badanie ktora ikona zostala nacisnieta*)
378 call GUI_MousePressed(xx,yy,i) ;
381 (* szukam gdzie zostal nacisniety lewy klawisz myszki *)
382 for i :=1 to il_ikon do
385 call IK(i).push; exit
389 when 1 : il_punktow := il_punktow+10;
391 call GUI_Rect(pminX+150,pminY+10,pminX+180,pminY+25, c_green,c_green);
392 call GUI_writeInt(pminX+150,pminY+10,il_punktow, c_darkGrey,c_green);
393 when 2 : il_punktow := il_punktow-10;
394 call GUI_Rect(pminX+150,pminY+10, pminX+180,pminY+25, c_green,c_green);
395 call GUI_writeInt(pminX+150,pminY+10, il_punktow, c_darkGrey,c_green);
397 call GUI_Rect(pminX+150,pminY+45, pminX+180,pminY+60, c_green,c_green);
398 call GUI_writeInt(pminX+150,pminY+45, i, c_darkGrey,c_green);
400 call GUI_Rect(pminX+150,pminY+45, pminX+180,pminY+60, c_green,c_green);
401 call GUI_writeInt(pminX+150,pminY+45, i, c_darkGrey,c_green);
405 call comment("Losowanie punktow.");
406 array Tab dim(1: il_punktow);
407 for i :=1 to il_punktow do
408 TAB(i) := new punkt(20+random*600,40+random*360,c_red);
414 (*-------------------------------------------------------------*)
415 UNIT PokazPunkty : procedure(il_punktow:integer, TAB:arrayof punkt);
416 var i : integer, pp : punkt;
418 call clear(minX+5,minY+sz+3,maxX-5,maxY-(2*sz+1),c_yellow,c_blue);
419 for i := 1 to il_punktow do pp:= TAB(i);
424 UNIT WylosujPunkty : procedure(il_punktow:integer; inout Tab:arrayof punkt);
427 call clear(minX+5,minY+sz+3,maxX-5,maxY-(2*sz+1),c_yellow,c_blue);
428 call comment("Losowanie punktow.");
429 array Tab dim(1: il_punktow);
430 for i :=1 to il_punktow do
431 pp:= new punkt(20+random*600,40+random*360,c_red);
437 unit INFO : procedure(il,ilb : integer);
440 call GUI_WriteText( MinX+10, MaxY -50,
441 unpack("ilosc punktow : "), c_red,c_darkGrey);
442 call GUI_WriteInt(MinX+200, MaxY-50,il,c_red,c_darkGrey);
444 call GUI_WriteText(MinX+10,MaxY-30,
445 unpack("ilosc bialych"),c_white,c_darkGrey);
446 call GUI_WriteInt(MinX+200, MaxY-30,ilb,c_white,c_darkGrey);
447 call STOP_IKONA.write_i;
449 (*--------------------------------------------------------------*)
451 Unit GRAHAM : procedure(il_punktow: integer, TAB : arrayof punkt);
452 UNIT SORTUJ : procedure(p0:punkt);
453 unit mniejsze : function(p,q:punkt) : boolean;
454 (* q jest na lewo od p0,p *)
457 if q.naLewo(p0,p) then
462 unit pokaz : procedure(c,k:integer);
466 call GUI_Line (p0.x,p0.y, Tab(k).x,Tab(k).y, c_green ) ;
468 call GUI_Line (p0.x,p0.y, Tab(k).x,Tab(k).y, c)
471 unit poprawHeap: procedure(k:integer);
472 var i,j : integer, v : punkt;
475 call pokaz(c_blue,k);
476 while(k<= kk div 2) do
479 if mniejsze(Tab(j+1),Tab(j)) then j:=j+1 fi
481 if mniejsze(v,Tab(j)) then exit fi;
486 call pokaz(c_blue,k);
488 unit usun : procedure(ii:integer);
491 p:=Tab(ii); Tab(ii):=Tab(1); Tab(1):=p;
494 var i,j, k : integer;
496 call comment("sortowanie");
497 for i := kk div 2 downto 1 do
500 call comment(" teraz wynik ");
503 Wielokat(i) := Tab(1);
504 call pokaz(c_green,1) ;
509 call GUI_MousePressed(xx,yy,k);
513 var c, kk,i, lewy,prawy,gora,dol : integer , pp : punkt,
514 Wielokat : arrayof punkt;
516 call comment ("ALGORYTM GRAHAMA ");
517 array WIELOKAT dim(1:il_punktow);
518 call PokazPunkty(il_punktow,TAB);
519 call comment(" Punkty do problemu otoczki ");
521 (* znajdz punkty najbardziej wysuniete na lewo , na prawo itd*)
522 (* usun punkty wewnetrzne czworokata : dol,gora,lewy, prawy*)
525 call STOP_IKONA.write_i;
526 call continue_IKONA.write_i;
528 for i :=2 to il_punktow do
529 if TAB(i).y>Tab(dol).y then dol:=i
531 if TAB(i).y<TAB(gora).y then gora :=i fi
533 if TAB(i).x>Tab(prawy).x then prawy := i
535 if TAB(i) .x< Tab(lewy).x then lewy := i fi
538 Wielokat(1) := TAB(dol);
539 Wielokat(2) := TAB(prawy);
540 Wielokat(3) := TAB(gora);
541 Wielokat(4) := TAB(lewy);
542 (* narysuj czworokat o ekstrmalnych wierzcholkach*)
543 call NarysujWielokat(c_yellow,4,Wielokat);
544 (* usun wszystkie punkty, ktore sa wewnatrz tego wielokata*)
545 call Wnetrze(4,Wielokat,kk);
546 (* kk= il punktow ktore zostaly po usunieciu wnetrza*)
547 call INFO(kk,il_punktow-kk);
549 call GUI_MousePressed(xx,yy,i);
551 if CZY(xx, yy,STOP_IKONA) then
552 call STOP_IKONA.push;
554 else if CZY(xx,yy,CONTINUE_IKONA) then
555 call CONTINUE_IKONA.push fi
558 (*wymazanie wielokata *)
559 call NarysujWielokat(c_blue,4,Wielokat);
560 (*posortuj tablice Tab ze wzgledu na katy *)
561 call SORTUJ(WIELOKAT(1));
562 (* Rysuj boki otoczki *)
568 UNIT JARVIS : procedure(n:integer,TAB:arrayof punkt);
572 UNIT TROJKATY : procedure(n:integer,TAB:arrayof punkt);
573 var Wielokat : arrayof punkt, i,j,k,x,kk :integer;
575 call comment ("ALGORYTM - trojkaty ");
576 array WIELOKAT dim(1:n);
577 call PokazPunkty(n,TAB);
578 call comment(" Punkty do problemu otoczki ");
580 WIELOKAT(1):= TAB(i);
582 WIELOKAT(2):= TAB(j);
584 WIELOKAT(3):= TAB(k);
585 call narysujWielokat(c_red,3,Wielokat);
586 (* narysuj trojkat *)
587 for x:=1 to n do call Wnetrze(3,Wielokat,kk); od;
588 (* sprawdz co jest w srodku *)
590 call narysujWielokat(c_blue,3,Wielokat);
596 UNIT NarysujWielokat : procedure(c,n:integer,T: arrayof punkt);
600 call GUI_Line(T(i-1).x,T(i-1).y,T(i).x,T(i).y,c);
603 call GUI_Line(T(1).x,T(1).y,T(n).x,T(n).y,c);
606 UNIT WYPISZ_INFO : procedure(cz,b,il_cz,il_b, ocena : integer);
611 unit Insert: procedure(pp: punkt,Tab : arrayof punkt, il : integer);
612 (* doloaczanie punktu pp do uporzadkowanej tablicy Tab o il-elementach *)
617 if pp.mniejsze (Tab(j)) then
618 Tab(j+1) := Tab(j); j := j-1;
624 unit punkt : class(x,y,c: integer);
626 unit mniejsze : function( p : punkt) : boolean;
628 result := (y< p.y or (y=p.y and x< p.x))
631 unit naLewo : function(p1,p2: punkt):boolean;
632 (*(x,y) jest na lewo (na ekranie ) od odcinka p1,p2 *)
634 if ( (x-p1.x)*(p2.y - p1.y) -(p2.x-p1.x)*(y-p1.y))>0 then
636 else result := false fi
639 unit rysuj : procedure;
641 call GUI_Ellipse(x,y,5,5,0,360,c,c)
645 unit WYMAZ_KONIEC: procedure(L : arrayof punkt, nr : integer);
647 call GUI_Line(L(nr-1).x, L(nr-1).y, L(nr).x, L(nr).y, c_blue);
650 UNIT WNETRZE : procedure(n: integer, WIELOKAT: arrayof punkt;output k:integer);
651 var i, j : integer, boo : boolean, pp: punkt;
653 for i := 1 to il_punktow do
656 while (j>1 and j<=n) and boo do
657 if Tab(i).naLewo(WIELOKAT(j-1),WIELOKAT(j)) then j:= j+1
661 if boo and Tab(i).naLewo(WIELOKAT(n),WIELOKAT(1)) then
667 (* przesun biale na koniec tablicy *)
669 for i := il_punktow downto 1 do
671 pp :=Tab(k); Tab(k) :=Tab(i); Tab(i) :=pp;
677 UNIT NaLewo : procedure(p1,p2:punkt; output cz,b : integer);
683 UNIT chromosom : class(x,y, u,w,ocena: integer);
688 (*--------------------------------------------------------------*)
689 UNIT ODCINKI : procedure;
692 UNIT ALG_2 : procedure(ilCZ, ilB : integer);
693 var POKOLENIE : arrayof chromosom,
696 il_pokolen, b, cz,ocena,
697 ii, i, j, mocP, il_prob, nrChromosomu : integer;
702 call GUI_MousePressed(xx,yy,i);
703 if i=1 and CZY(xx, yy,STOP_IKONA) then call clear_all;exit fi;
709 (*--------------------------------------------------------------*)
711 VAR TAB : arrayof punkt, il_punktow, il_porownan: integer,
712 OK_ikona,YES_ikona,NO_ikona, STOP_IKONA,
713 EXIT_IKONA, CONTINUE_IKONA : IKONA,
714 menu_main, menu_START : menu,
718 when MEMERROR : call comment("Zabraklo pamieci");
720 when ACCERROR : call comment("Reference to none PR GLOWNY");
722 when LOGERROR : call comment("Niepoprawny Attach PR GLOWNY");
724 when CONERROR : call comment(" Array-index error PR GLOWNY");
726 when SYSERROR : call comment("input-output error");
728 when NUMERROR : call comment("blad numeryczny");
730 others : call comment("Jakis blad ");
735 BEGIN (* tu musi sie wygenerowac menu *)
737 YES_ikona := new IKONA(6,450,360,500,385,3,"YES");
738 NO_ikona := new IKONA(6,505,360,555,385,3,"NO");
739 STOP_IKONA := new IKONA(c_green,590,430,635,460,3,"STOP");
741 new IKONA(c_green,450,430,550,460,3,"CONTINUE");
743 (* Strona tytulowa *)
744 CALL GUI_Rect(minX+1,minY+1,maxX-2,maxY-2,c_black,c_lightGrey);
746 CALL GUI_writeText(250,100,unpack("PROJEKT"), c_black,c_lightGrey);
747 CALL GUI_writeText(250,200,unpack(
748 "ALGORYTMY W GEOMETRII"), c_black,c_lightGrey);
750 call CONTINUE_IKONA.write_i;
752 while i<>1 or not CZY(xx,yy,CONTINUE_IKONA) do
753 call GUI_MousePressed(xx,yy,i);
755 call CONTINUE_IKONA.push;
758 (* creation of main menu *)
759 menu_main := new menu(minX,maxX,minY,maxY,new OPTIONS_MAIN(4));
761 menu_main.ICONES(4).sub_menu :=
762 new menu(minX,maxX,minY,maxY,new OPTIONS_help(3));
764 menu_main.ICONES(2).sub_menu :=
765 new menu(minX,maxX,minY,maxY,new OPTIONS_OTOCZKA(4));
771 call comment("THIS ENDS THE PROGRAM EXECUTION !!!!!");
775 END (* block od Grafiki *)