examp/geometria.log

   1  PROGRAM Geometria;
   2   #include "classes/gui.inc"
   3 (*Program ma pokazac dzialanie algorytmow geometrycznych *)
   4 (* o ktorych mowilam na wykladzie*)
   5
   6   signal ERROR_exec;
   7   CONST
   8
   9       MinX = 0,
  10       MinY = 0,
  11       MaxX = 640,
  12       MaxY = 480,
  13       comX = 30,
  14       comY = 440,
  15       sz   = 30, (*szerokosc paska menu*)
  16        my_ecranMinX = MinX+5,
  17        my_ecranMinY = MinY+sz+3,
  18        my_ecranMaxX= MaxX-5,
  19        my_ecranMaxY= MaxY-(2*sz+1),
  20       exit_posX = 550,
  21       exit_posY = 420,
  22       help_posX = 20,
  23       help_posY = 50,
  24       grubosc = 2,
  25       maly = 1;
  26
  27
  28 (*------------------------------------------------------------------------*)
  29
  30 (*------------------------------------------------------------------------*)
  31 (*               klasa definiujaca procedury graficzne                    *)
  32 (*------------------------------------------------------------------------*)
  33    UNIT graphics : GUI CLASS;
  34
  35
  36       UNIT pauza : PROCEDURE(JakDlugo:integer);
  37       var i : integer;
  38       BEGIN
  39          for i :=1 to JakDlugo do i:=i od;
  40       END pauza;
  41
  42
  43       UNIT waitt : PROCEDURE;
  44       (* wait for a key *)
  45       BEGIN
  46          While GUI_KeyPressed=/= 0 DO OD;
  47       END waitt;
  48
  49       UNIT clear_all : procedure;
  50        begin
  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);
  55        end clear_all;
  56
  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;
  61       BEGIN
  62             x := (x1-x0) div 2;
  63             y := (y1-y0) div 2;
  64             i :=0; j :=0;
  65             while i<=x and j<=y  do
  66                  call GUI_Rect(x0+i,y0+j,x1-i,y1-j,c_black,c_lightGrey);
  67                  i := i+1; j := j+1;
  68             od;
  69             while i>=0 and j>=0  do
  70                  call GUI_Rect(x0+i,y0+j,x1-i,y1-j,c1,c2);
  71                  i := i-1; j :=j-1
  72             od;
  73        END clear;
  74
  75
  76 (**************************************************************************)
  77
  78     UNIT katy : procedure(col1,col2,x,y,u,v,grubosc: integer);
  79     var i : integer;
  80     BEGIN
  81              for i :=0 to grubosc
  82              do
  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)
  85              od;
  86              for i :=0 to grubosc
  87              do
  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);
  90              od;
  91     END katy;
  92
  93
  94     unit comment: procedure(ss:string);
  95        begin
  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);
  99     end comment;
 100
 101     unit YES : function : boolean;
 102     var  c : char;
 103     begin
 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
 109         fi;
 110     end YES;
 111
 112   END graphics;
 113 (*************************************************************************)
 114
 115  BEGIN
 116        pref GRAPHICS block
 117
 118
 119 (*-----------------------------------------------------------------------*)
 120
 121 (*                      M E N U                                          *)
 122 (*-----------------------------------------------------------------------*)
 123         unit option : class(nb : integer);
 124         var Nom : arrayof string;
 125         unit virtual action : procedure(j : integer);
 126         begin
 127         end action;
 128         begin
 129            array Nom dim (1:nb);
 130            inner;
 131         end option;
 132
 133         unit ikona : class(c,x,y,u,v,grubosc : integer, ss : string);
 134         var sub_menu : menu;
 135            unit write_i : procedure;
 136            var i: integer;
 137            begin
 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)
 141            end write_i;
 142
 143            unit wymaz : procedure;
 144            begin
 145                 call GUI_Rect(x,y,u,v,c_black,c_lightGrey);
 146            end wymaz;
 147
 148            unit push : procedure;
 149            (* nacisniecie wybranej ikony *)
 150            begin
 151              call katy(c_darkGrey,c_white,x,y,u,v,grubosc);
 152              call pauza(200);
 153              call katy (c_white,c_darkGrey,x,y,u,v,grubosc);
 154              call pauza(200);
 155            end push;
 156
 157            unit inactive : procedure;
 158            begin
 159              call katy(c_white,c_darkGrey,x,y,u,v,grubosc);
 160              call pauza(500);
 161              call katy (c_darkGrey,c_white,x,y,u,v,grubosc);
 162              call pauza(500);
 163            end inactive;
 164         end ikona;
 165
 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)
 170         end CZY;
 171
 172
 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,
 176             l,r,z,
 177             col,xx,yy   : integer,
 178             boo : boolean;
 179             (* dl and sz  - wymiary ikon w tym menu *)
 180
 181             unit instalation : procedure;
 182             (* rysowanie menu oraz jego ikon *)
 183             var i : integer;
 184             begin
 185                 call GUI_Rect(minX,minY,maxX,maxY,c_black,c_lightGrey);
 186                 (* duzy obszar szary *)
 187
 188                 call GUI_Rect(minX+4,maxY-(2*sz),maxX-4,maxY-4,c_black,c_darkGrey);
 189                 (*obszar dla komentarzy*)
 190                 for i := 1 to nb
 191                 do
 192                     call ICONES(i).write_i
 193                 od;
 194             end instalation;
 195
 196             unit INI : procedure;
 197             var x,y,u,v : integer;
 198             BEGIN
 199                nb := OPTIONS.nb;
 200                dl := (MaxX-Minx) div nb ;
 201
 202                array ICONES dim(1:nb);
 203                x := minX+2; y := minY+2;
 204                u := minX+dl-4;  v := minY+sz;
 205                for i := 1 to nb
 206                do
 207                   ICONES(i) := new ikona(c_lightGrey,x,y,u,v,2,OPTIONS.NOM(i));
 208                   x := x+dl; u := u+dl;
 209                od;
 210             end INI;
 211 handlers
 212    when ERROR_exec :
 213                   call comment(" error exec  ");
 214                   call YES_ikona.write_i;
 215                   call NO_ikona.write_i;
 216                   z :=0;
 217                   while not z=1 do  call GUI_MousePressed(xx,yy,z) od;
 218                   call comment("");
 219                   (* szukam gdzie zostal nacisniety lewy klawisz myszki*)
 220                   if CZY(xx,yy,YES_ikona)
 221                   then
 222                       call YES_ikona.push;
 223                       call clear(minX+5,minY+sz+3,maxX-5,maxY-2*sz-1,c_white,c_lightGrey);
 224                       wind
 225                   fi;
 226                   if CZY(xx,yy,NO_ikona)
 227                   then
 228                       call NO_ikona.push;
 229                       call clear(minX+5,minY+sz+3,maxX-5,maxY-2*sz-1,c_white,c_lightGrey);
 230                       call ENDRUN
 231                   fi;
 232
 233
 234    others         call comment(" ERROR press YES to continue or NO to stop?");
 235
 236                   call YES_ikona.write_i;
 237                   call NO_ikona.write_i;
 238                   z :=0;
 239                   while not z=1 do  call GUI_MousePressed(xx,yy,z) od;
 240                   call comment("");
 241                   (* szukam gdzie zostal nacisniety lewy klawisz myszki*)
 242                   if CZY(xx,yy,YES_ikona)
 243                   then
 244                       call YES_ikona.push;
 245                       call clear(minX+5,minY+sz+3,maxX-5,maxY-2*sz-1,c_white ,c_lightGrey);
 246                       wind
 247                   fi;
 248                   if CZY(xx,yy,NO_ikona)
 249                   then
 250                       call NO_ikona.push;
 251                       call clear(minX+5,minY+sz+3,maxX-5,maxY-2*sz-1,c_white ,c_lightGrey);
 252                       call ENDRUN
 253                   fi;
 254
 255 end handlers;
 256
 257         begin
 258            call INI;
 259            return;
 260            do  (* obsluga menu *)
 261                call instalation;    (* rysowanie ikon z tego menu *)
 262                do
 263                   xx, yy,i := 0;
 264
 265                   while i=0  do
 266                       call GUI_MousePressed(xx,yy,i) ;
 267                   od;
 268
 269                   (* szukam gdzie zostal nacisniety lewy klawisz myszki *)
 270                   for j :=1 to nb
 271                   do
 272                       if czy(xx,yy,ICONES(j))
 273                       then
 274                           call ICONES(j).push;exit;
 275                       fi;
 276                   od;
 277                   if j>0 and j<nb+1
 278                   then
 279                        call OPTIONS.Action(j);
 280                        if j=1 then detach;
 281                              exit
 282                        else
 283                           if ICONES(j).sub_menu<>none then
 284                              attach(ICONES(j).sub_menu);
 285                              exit;
 286                           fi;
 287                        fi;
 288                   fi;
 289                od;
 290            od;
 291         end menu;
 292
 293      unit OPTIONS_MAIN : option class;
 294      unit virtual Action : procedure(j : integer);
 295      begin               (* opcje glownego menu*)
 296
 297          case j
 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");
 302
 303             when 4 : call comment("Tu ma byc informacja o algorytmie");
 304
 305           esac;
 306       end action;
 307       begin
 308            Nom(1) := "EXIT";
 309            Nom(2) := "OTOCZKA";
 310            Nom(3) := "ODCINKI";
 311            Nom(4) := "HELP";
 312       end OPTIONS_MAIN;
 313
 314      unit OPTIONS_OTOCZKA : option class;
 315      unit virtual Action : procedure(j : integer);
 316      var x: integer, boo : boolean;
 317      begin
 318          case j
 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);
 323                      call clear_all;
 324           esac;
 325       end action;
 326       begin
 327            Nom(1) := "RETURN";
 328            Nom(2) := "GRAHAM";
 329            Nom(3) := "JARVIS";
 330            Nom(4) := "TROJKATY";
 331       end OPTIONS_OTOCZKA;
 332
 333
 334       unit OPTIONS_help : option class;
 335       var ch : char, i:integer;
 336       unit virtual Action : procedure(j : integer);
 337       begin
 338           case j
 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("");
 343          esac;
 344       end Action;
 345       begin
 346            NOM(1) := "RETURN";
 347            NOM(2) := "NEXT";
 348            NOM(3) := "PREV";
 349       end OPTIONS_help;
 350
 351  (*===================================================================*)
 352
 353     unit WczytajDane : procedure(inout il_punktow:integer,TAB : arrayof punkt);
 354     const pminX = 30, pminY =50, pmaxX= 400, pmaxY=200,
 355              il_ikon =5;
 356     var i ,xx, yy: integer, IK : arrayof IKONA;
 357     begin
 358
 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 = "),
 362                                      c_darkGrey,c_green);
 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 % = "),
 366                                             c_darkGrey,c_green);
 367
 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*)
 375             do
 376                   xx, yy,i := 0;
 377                   while i=0  do
 378                       call GUI_MousePressed(xx,yy,i) ;
 379                   od;
 380
 381                   (* szukam gdzie zostal nacisniety lewy klawisz myszki *)
 382                   for i :=1 to il_ikon do
 383                       if czy(xx,yy,IK(i))
 384                       then
 385                           call IK(i).push; exit
 386                       fi;
 387                   od;
 388                               case i
 389                                   when 1 : il_punktow := il_punktow+10;
 390
 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);
 396                                    when 3 : i := i+1;
 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);
 399                                   when 4 : i := i-1;
 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);
 402                                   when 5 :  exit;
 403                                esac;
 404              od;
 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);
 409             od;
 410             call comment("");
 411             call  clear_all;
 412     end WczytajDane;
 413
 414 (*-------------------------------------------------------------*)
 415    UNIT PokazPunkty : procedure(il_punktow:integer, TAB:arrayof punkt);
 416    var i : integer, pp : punkt;
 417    begin
 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);
 420               call pp.rysuj
 421       od;
 422    end PokazPunkty;
 423
 424    UNIT WylosujPunkty : procedure(il_punktow:integer; inout Tab:arrayof punkt);
 425     var pp : punkt;
 426     begin
 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);
 432                    TAB(i) := pp
 433             od;
 434            call comment("");
 435     end WylosujPunkty;
 436
 437     unit INFO : procedure(il,ilb : integer);
 438     begin
 439       call comment("");
 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);
 443
 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;
 448     end INFO;
 449 (*--------------------------------------------------------------*)
 450
 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 *)
 455           begin
 456                result := false;
 457                if q.naLewo(p0,p) then
 458                      result := true
 459                fi;
 460           end mniejsze;
 461
 462           unit pokaz : procedure(c,k:integer);
 463           var i : integer;
 464           begin
 465                 for i:=1 to 10 do
 466                  call GUI_Line (p0.x,p0.y, Tab(k).x,Tab(k).y, c_green ) ;
 467                 od;
 468                 call GUI_Line (p0.x,p0.y, Tab(k).x,Tab(k).y, c)
 469           end pokaz;
 470
 471           unit poprawHeap: procedure(k:integer);
 472           var i,j : integer, v : punkt;
 473           begin
 474                 v := Tab(k);
 475                 call pokaz(c_blue,k);
 476                  while(k<= kk div 2) do
 477                           j:= 2*k;
 478                           if j < kk then
 479                                  if mniejsze(Tab(j+1),Tab(j)) then j:=j+1 fi
 480                           fi;
 481                           if mniejsze(v,Tab(j)) then exit fi;
 482                           Tab(k) := Tab(j);
 483                            k := j
 484                   od;
 485                   Tab(k) := v;
 486                  call pokaz(c_blue,k);
 487           end poprawHeap;
 488           unit usun : procedure(ii:integer);
 489            var p : punkt;
 490           begin
 491                p:=Tab(ii); Tab(ii):=Tab(1); Tab(1):=p;
 492                call PoprawHeap(1);
 493           end usun;
 494         var i,j, k : integer;
 495      BEGIN
 496          call comment("sortowanie");
 497           for i := kk div 2 downto 1 do
 498               call poprawHeap(i)
 499           od;
 500           call comment(" teraz wynik ");
 501            j:= kk;
 502           for i :=1 to kk do
 503                 Wielokat(i) := Tab(1);
 504                 call pokaz(c_green,1) ;
 505                 call usun(j);
 506                 j:= j-1;
 507
 508                 k := 0;
 509                 call GUI_MousePressed(xx,yy,k);
 510           od;
 511      END SORTUJ;
 512
 513      var  c, kk,i, lewy,prawy,gora,dol : integer , pp : punkt,
 514             Wielokat : arrayof punkt;
 515      begin
 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 ");
 520         (* uproszczenie: *)
 521         (* znajdz punkty najbardziej wysuniete na lewo , na prawo itd*)
 522         (* usun punkty wewnetrzne czworokata : dol,gora,lewy, prawy*)
 523          dol:=1; gora:=1;
 524          lewy:=1; prawy :=1;
 525          call STOP_IKONA.write_i;
 526          call continue_IKONA.write_i;
 527
 528          for i :=2 to il_punktow do
 529               if TAB(i).y>Tab(dol).y then dol:=i
 530               else
 531                  if TAB(i).y<TAB(gora).y then gora :=i fi
 532               fi;
 533               if  TAB(i).x>Tab(prawy).x then prawy := i
 534               else
 535                      if TAB(i) .x< Tab(lewy).x then lewy := i fi
 536               fi;
 537          od;
 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);
 548                 i := 0;
 549                 call GUI_MousePressed(xx,yy,i);
 550                 if i=1 then
 551                   if CZY(xx, yy,STOP_IKONA) then
 552                     call STOP_IKONA.push;
 553                     exit
 554                    else if  CZY(xx,yy,CONTINUE_IKONA) then
 555                                call CONTINUE_IKONA.push fi
 556                    fi
 557                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 *)
 563
 564      end GRAHAM;
 565
 566
 567
 568      UNIT JARVIS : procedure(n:integer,TAB:arrayof punkt);
 569      BEGIN
 570      END JARVIS;
 571
 572      UNIT TROJKATY : procedure(n:integer,TAB:arrayof punkt);
 573      var Wielokat : arrayof punkt, i,j,k,x,kk :integer;
 574      BEGIN
 575          call comment ("ALGORYTM  - trojkaty  ");
 576          array WIELOKAT dim(1:n);
 577          call PokazPunkty(n,TAB);
 578          call comment(" Punkty do problemu otoczki ");
 579             for i := 1 to n do
 580                 WIELOKAT(1):= TAB(i);
 581                for j:= i +1 to n do
 582                    WIELOKAT(2):= TAB(j);
 583                    for k :=j+1 to n do
 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 *)
 589                        (*usun srodek*)
 590                        call narysujWielokat(c_blue,3,Wielokat);
 591                    od
 592                od
 593             od;
 594      END TROJKATY;
 595
 596      UNIT NarysujWielokat : procedure(c,n:integer,T: arrayof punkt);
 597      var i : integer;
 598      BEGIN
 599           for i :=2 to n do
 600              call GUI_Line(T(i-1).x,T(i-1).y,T(i).x,T(i).y,c);
 601       call pauza(500);
 602          od;
 603         call GUI_Line(T(1).x,T(1).y,T(n).x,T(n).y,c);
 604      END  NarysujWielokat;
 605
 606      UNIT WYPISZ_INFO : procedure(cz,b,il_cz,il_b, ocena : integer);
 607      BEGIN
 608
 609      END WYPISZ_INFO;
 610
 611      unit Insert: procedure(pp: punkt,Tab : arrayof punkt, il : integer);
 612      (* doloaczanie punktu pp do uporzadkowanej tablicy Tab  o il-elementach *)
 613      var j : integer;
 614      begin
 615            j := il -1;
 616            while  j>0 do
 617                if  pp.mniejsze (Tab(j)) then
 618                  Tab(j+1) := Tab(j);  j := j-1;
 619               else exit fi
 620            od;
 621            Tab(j+1) := pp;
 622      end Insert;
 623
 624      unit punkt : class(x,y,c: integer);
 625      var boo : boolean;
 626          unit mniejsze : function( p : punkt) : boolean;
 627          begin
 628                result := (y< p.y or (y=p.y and x< p.x))
 629          end mniejsze;
 630
 631          unit naLewo : function(p1,p2: punkt):boolean;
 632          (*(x,y) jest na lewo (na ekranie ) od odcinka p1,p2 *)
 633          begin
 634                if ( (x-p1.x)*(p2.y - p1.y) -(p2.x-p1.x)*(y-p1.y))>0  then
 635                    result := true
 636                else result := false fi
 637          end naLewo;
 638
 639          unit rysuj : procedure;
 640          begin
 641                call GUI_Ellipse(x,y,5,5,0,360,c,c)
 642          end rysuj;
 643     end punkt;
 644
 645     unit WYMAZ_KONIEC: procedure(L : arrayof punkt, nr : integer);
 646     begin
 647           call GUI_Line(L(nr-1).x, L(nr-1).y, L(nr).x, L(nr).y, c_blue);
 648     end WYMAZ_KONIEC;
 649
 650     UNIT WNETRZE : procedure(n: integer, WIELOKAT: arrayof punkt;output k:integer);
 651      var i, j : integer, boo : boolean, pp: punkt;
 652      begin
 653         for i := 1 to il_punktow do
 654             j := 2;
 655             boo:= true;
 656             while (j>1 and j<=n) and boo do
 657                if Tab(i).naLewo(WIELOKAT(j-1),WIELOKAT(j)) then j:= j+1
 658                 else boo := false fi
 659             od;
 660
 661             if boo and  Tab(i).naLewo(WIELOKAT(n),WIELOKAT(1)) then
 662                 TAB(i).boo := true;
 663                  Tab(i).c := c_white;
 664                 call TAB(i).rysuj;
 665             fi
 666         od ;
 667         (* przesun biale na koniec tablicy *)
 668         k:= il_punktow;
 669         for i := il_punktow downto 1 do
 670            if Tab(i).boo then
 671                   pp :=Tab(k); Tab(k) :=Tab(i); Tab(i) :=pp;
 672                   k :=k-1;
 673           fi
 674         od;
 675      end WNETRZE;
 676
 677      UNIT NaLewo : procedure(p1,p2:punkt; output cz,b : integer);
 678      var i : integer;
 679       begin
 680
 681       end NaLewo;
 682
 683      UNIT chromosom : class(x,y, u,w,ocena: integer);
 684      begin
 685      end chromosom;
 686
 687
 688 (*--------------------------------------------------------------*)
 689      UNIT ODCINKI : procedure;
 690      END Odcinki;
 691
 692      UNIT ALG_2 : procedure(ilCZ, ilB : integer);
 693      var POKOLENIE : arrayof chromosom,
 694           ch : chromosom,
 695           p1, p2 : punkt,
 696           il_pokolen, b, cz,ocena,
 697           ii, i, j,  mocP, il_prob, nrChromosomu : integer;
 698
 699      begin
 700
 701                i := 0;
 702                call GUI_MousePressed(xx,yy,i);
 703                if i=1 and CZY(xx, yy,STOP_IKONA) then call clear_all;exit fi;
 704
 705      end ALG_2;
 706
 707
 708
 709 (*--------------------------------------------------------------*)
 710
 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,
 715                  i ,xx,yy                                          : integer;
 716
 717     handlers
 718       when MEMERROR : call comment("Zabraklo pamieci");
 719                       call waitt;
 720       when ACCERROR : call comment("Reference to none PR GLOWNY");
 721                       call waitt;
 722       when LOGERROR : call comment("Niepoprawny Attach PR GLOWNY");
 723                       call waitt;
 724       when CONERROR : call comment(" Array-index error PR GLOWNY");
 725                       call waitt;
 726       when SYSERROR : call comment("input-output error");
 727                       call waitt;
 728       when NUMERROR : call comment("blad numeryczny");
 729                       call waitt;
 730       others : call comment("Jakis blad ");
 731                       call waitt;
 732     end handlers;
 733
 734
 735    BEGIN  (* tu musi sie wygenerowac menu  *)
 736
 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");
 740          CONTINUE_IKONA :=
 741                               new IKONA(c_green,450,430,550,460,3,"CONTINUE");
 742
 743           (* Strona tytulowa *)
 744            CALL GUI_Rect(minX+1,minY+1,maxX-2,maxY-2,c_black,c_lightGrey);
 745
 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);
 749
 750            call CONTINUE_IKONA.write_i;
 751             i := 0;
 752             while i<>1 or not CZY(xx,yy,CONTINUE_IKONA) do
 753                    call GUI_MousePressed(xx,yy,i);
 754             od;
 755              call CONTINUE_IKONA.push;
 756
 757
 758            (* creation of main menu *)
 759            menu_main := new menu(minX,maxX,minY,maxY,new OPTIONS_MAIN(4));
 760
 761            menu_main.ICONES(4).sub_menu :=
 762                    new menu(minX,maxX,minY,maxY,new OPTIONS_help(3));
 763
 764            menu_main.ICONES(2).sub_menu :=
 765                    new menu(minX,maxX,minY,maxY,new OPTIONS_OTOCZKA(4));
 766
 767
 768
 769            attach(menu_main);
 770
 771            call comment("THIS ENDS THE PROGRAM EXECUTION !!!!!");
 772                  call endRun;
 773          END;
 774
 775    END (* block od Grafiki *)
 776 END GEOMETRIA;
 777
 778
 779
 780  \0\0