doc/examples/geometria.log

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