examp/lift4.log

   1
   2
   3  PROGRAM LIFT;
   4  signal signal1;
   5
   6 (* symulacja windy    wersja 5, 1 kwietnia 2000  *)
   7 (*------------------------------------------------------------------------*)
   8 (*               klasa definiujaca procedury graficzne                    *)
   9 (*------------------------------------------------------------------------*)
  10    UNIT graph : IIUWGRAPH CLASS;
  11    CONST
  12
  13         MinX = 0,   MinY = 0,
  14         MaxX = 640, MaxY = 480,
  15         minDx = 50,minDy=10,maxDx= 600,maxDy=450,
  16
  17         czarny = 0,
  18         czerwony = 4,
  19         szary = 7,
  20         cyklamen = 13,
  21         bialy = 15;
  22
  23
  24       UNIT waitt : PROCEDURE;
  25       (* wait for a key *)
  26       BEGIN
  27         DO
  28            IF INKEY =/= 0 THEN exit FI;
  29         OD;
  30       END waitt;
  31
  32   unit ludzik : procedure(x,y,k:integer);
  33   begin
  34        call color(k);
  35        call move(x,y);
  36        call draw(x,y+6);
  37        call draw(x-2,y+10);
  38        call move(x,y+6);
  39        call draw(x+2,y+10);       call move(x-2,y+2);
  40        call draw(x+2,y+2);
  41        call move(x-2,y+2);
  42        call draw(x-4,y+4);
  43        call move(x+2,y+2);
  44        call draw(x+4,y+4)
  45    end ludzik;
  46
  47    unit COMMENT : procedure(ss: string);
  48    begin
  49         call outstring(250,460,ss,cyklamen,15)
  50    end COMMENT;
  51
  52   END graph;
  53
  54 (*----------------------------------------------------------------------*)
  55
  56
  57   UNIT EcRAN : graph process(node :integer);
  58   const
  59         H = 30,(* odleglosc miedzy pietrami*)
  60         xMAXw = 400, xMINw =200, yMaxW =400,
  61         xpp = 405, xpl = 195, (* poczatkowe pozycje ludzikow*)
  62         yp = 400;
  63     var i : integer,
  64         PIETRA : arrayof etage,
  65         MAP : arrayof integer;
  66
  67      UNIT etage : class;
  68      var GORA, DOL : arrayof boolean;
  69      begin
  70         array GORA dim(1:20); (* 20 maksymalna liczba pasazerow na pietrze*)
  71         array DOL dim(1:20);
  72      end etage;
  73
  74
  75      UNIT obrazWindy : procedure(pietro : integer);
  76      begin
  77            call move(XminW,YmaxW-(pietro+1)*H);
  78            MAP := getmap(XmaxW,YmaxW-pietro*H);
  79      end ObrazWindy;
  80
  81      UNIT RysujWinde : procedure(Y,kolor: integer);
  82      begin
  83         if kolor= bialy then
  84            CALL patern (XminW,Y,XmaxW,Y+H,bialy,1)
  85         else
  86            call move(XminW,Y);
  87            call putmap(MAP)
  88         fi;
  89         (* i wszystkich jej pasazerow *)
  90      end RysujWinde;
  91
  92      UNIT DOM : procedure(kolor,ile_pieter:integer);
  93      (*  szyb windy i pietra *)
  94      var i :integer;
  95      begin
  96         call patern(minDX,minDY,maxDX,maxDY,szary,1);
  97         CALL patern (xMINw-2,yMaxW-(ile_pieter+1)*H,xMAXw+2,yMAXw,czarny,1);
  98         call color(2);
  99         for i := 0 to ile_pieter  do
 100                 call move(minDX,yMaxW-i*H); call draw(maxDX,yMAXw-i*H);
 101              (*   call Guzik(true,szary,i);*)
 102              (*   call Guzik(false,szary,i);*)
 103         od;
 104         i := ile_pieter+1;
 105         call move(minDX,yMAXw-i*H); call draw(maxDX,yMAXw-i*H);
 106
 107         CALL patern (xMINw,yMAXw-i*H,xMAXw,yMAXw,bialy,1);
 108
 109      end DOM;
 110
 111       unit JESTEM : procedure(gora:boolean,k,z:integer;output i:integer);
 112       var j : integer;
 113       begin
 114           if gora then
 115              for j:=1 to 20 do
 116                 if not PIETRA(z).gora(j) then
 117                    PIETRA(z).gora(j):= true;
 118                    call ludzik(xpp+10*j,yp-z*H-12,k);
 119                    i:=j; return
 120                 fi
 121             od
 122           else
 123              for j:=1 to 20 do
 124                 if not PIETRA(z).dol(j) then
 125                    PIETRA(z).dol(j):= true;
 126                    call ludzik(xpl-10*j,yp-z*H-12,k);
 127                    i:=j; return
 128                 fi
 129
 130             od
 131          fi;
 132       end JESTEM;
 133
 134       unit usunZpietra: procedure(gora: boolean,pietro,i : integer);
 135       begin
 136           if gora then
 137                 PIETRA(pietro).gora(i) := false;
 138                 call ludzik(xpp+10*i,yp-pietro*H-12,szary);
 139           else
 140                 PIETRA(pietro).dol(i):= false;
 141                 call ludzik(xpl-10*i,yp-pietro*H-12,szary);
 142            fi;
 143       end usunZpietra;
 144
 145       unit Guzik : procedure(gora:boolean,k,i : integer);
 146       begin
 147          if gora then
 148             call track(MaxDx-20,yMAXw-i*H-20,k,czarny,i)
 149          else
 150             call track(MinDx+20,yMAXw-i*H-20,k,czarny,i)
 151          fi;
 152       end Guzik;
 153
 154       unit otworz : procedure(gora: boolean,i: integer);
 155       begin
 156         if gora then
 157            call patern(xMAXw,yMAXw-(i+1)*H,xMAXw+2,yMAXw-(i)*H,szary,1)
 158         else
 159            call patern(xMINw,yMAXw-(i+1)*H,xMINw-2,yMAXw-(i)*H,szary,1)
 160         fi;
 161       end otworz;
 162
 163       unit zamknij : procedure(gora:boolean,i: integer);
 164       begin
 165         if gora then
 166            call patern(xMAXw,yMAXw-(i+1)*H,xMAXw+2,yMAXw-(i)*H,czarny,1);
 167         else
 168            call patern(xMINw,yMAXw-(i+1)*H,xMINw-2,yMAXw-(i)*H,czarny,1)
 169         fi;
 170       end zamknij;
 171
 172
 173       unit Koniec:  procedure;
 174       var i : integer;
 175       begin
 176              for i:=1 to 2000 do i:=i od;
 177              CALL GROFF; call ENDRUN
 178       end Koniec;
 179
 180   handlers
 181    others       call comment("handler  EKRAN ");
 182                 call KONIEC;
 183   end handlers;
 184   begin
 185       call GRON(0);
 186       array PIETRA dim(0:10);
 187       for i := 0 to 10 do PIETRA(i) := new etage od;
 188       CALL patern (xminW,yMaxW-H,xmaxW,yMaxW,szary,1);
 189       call ObrazWindy(0); (* obraz windy pustej na parterze *)
 190       return;
 191       do
 192          accept RysujWinde, JESTEM, DOM, COMMENT,LUDZIK,
 193                 obrazWindy, GUZIK, usunZpietra, OTWORZ, ZAMKNIJ, KONIEC;
 194       od;
 195
 196   end ECRAN;
 197
 198
 199 (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
 200
 201
 202   UNIT  LIFT :  process(node,n,MAXp : integer, EKRAN : ecran);
 203   (* n = ilosc pieter, MAXp = maxymalna ilosc pasazerow w windzie *)
 204   (* ile = ilosc pasazerow aktualnie w windzie *)
 205   CONST
 206         minX =200, maxY = 400, maxX=400, H=30,
 207         xMINw =200, xMAXw =400, yMAXw = 400,
 208         kolor = 7,
 209         szary = 7,
 210         czerwony = 5,
 211         czarny = 0,
 212         gora = true,
 213         dol = false;
 214   VAR   i,j,p,jedzNa, NaPietrze,ile : integer,
 215         booo, kierunek, stoj        : boolean,
 216         PIETRA      : arrayof guzik,
 217         PRZYCISKI   : arrayof boolean,
 218         WWindzie    : arrayof boolean;
 219
 220      UNIT opis : class( k,x,y : integer); (* opis pasazera*)
 221      (* x,y odpowiada pozycji na pietrze lub w windzie *)
 222      end opis;
 223
 224      UNIT guzik : class;
 225      var   WGORE, Wdol : boolean;
 226      end guzik;
 227
 228      UNIT pauza : PROCEDURE(JakDlugo : integer);
 229      var i : integer;
 230      BEGIN
 231          for i :=1 to JakDlugo do i:=i od;
 232      END pauza;
 233
 234
 235      UNIT Wolam : procedure(Gora : boolean, pietro : integer);
 236      begin
 237            if  gora then
 238                 PIETRA(pietro).wgore := true else PIETRA(pietro).wdol := true
 239            fi;
 240           call EKRAN.guzik(gora,czerwony,pietro)
 241      end Wolam;
 242
 243       UNIT PasazerWysiada : procedure(j : integer);
 244       var y : integer;
 245       begin
 246            (* Wymazac go z windy    *)
 247            Wwindzie(j):= false;
 248            y := yMaxW - naPietrze*H;
 249            call EKRAN.ludzik(xMINw+10*j,y-12,szary);
 250            ile := ile -1;
 251            PRZYCISKI(naPietrze):= false;
 252            call Ekran.ObrazWindy(naPietrze)
 253       end PasazerWysiada;
 254
 255       UNIT PasazerWsiada : procedure(z,na,k,poz:integer; output p:integer);
 256       var i,j,y : integer;
 257       begin
 258
 259           if not (naPietrze=z and kierunek=(z<na) and ile< maxP) then
 260                p:= 0; return
 261           fi;
 262           (* Wymaz pasazera z pietra z=naPietrze*)
 263           call EKRAN.UsunZpietra(z<na,naPIETRZE,poz);
 264           y := yMaxw- naPietrze*H;
 265
 266           (* Wpisz go do windy *)
 267            for j:=1 to 20 do
 268                 if not Wwindzie(j) then
 269                    Wwindzie(j):= true;
 270                    (*  ludzik idzie  *)
 271                    p := j;
 272
 273                    for i:= 1 to j-1  do
 274                      call EKRAN.ludzik(xMAXw-10*i,y-12,k);
 275                      call pauza(200);
 276                      call EKRAN.ludzik(xMAXw-10*i,y-12,7);
 277                      call pauza(200)
 278                    od;
 279                    call EKRAN.ludzik(xMINw+10*j,y-12,k);
 280                    call pauza(300);
 281                    exit
 282                 fi
 283             od;
 284            ile := ile+1;
 285            call Ekran.RysujWinde(yMaxW-(naPietrze+1)*H,k);
 286            call Ekran.Ludzik(xMinW+10*j,y-12,k);
 287            PRZYCISKI(na):= true;
 288            call Ekran.ObrazWindy(naPietrze)
 289       end PasazerWsiada;
 290
 291
 292       UNIT PRZYJECHALA : function(p:integer) : boolean;
 293       begin
 294             result := (naPietrze=p)
 295       end PRZYJECHALA;
 296
 297       unit CZEKAM : procedure(i: integer);
 298       begin
 299              call Ekran.Otworz(gora,i);
 300              call Ekran.Otworz(dol,i);
 301              enable PRZYJECHALA,PASAZERWSIADA, PASAZERWYSIADA;
 302
 303              call Ekran.Guzik(gora,czerwony,i);
 304              call Ekran.Guzik(dol,czerwony,i);
 305 (*      return   enable WOLAM,PRZYJECHALA,PASAZERWSIADA, PASAZERWYSIADA;*)
 306
 307       end CZEKAM;
 308
 309       UNIT OtwieramDrzwi :  procedure( i: integer);
 310       begin
 311            call Ekran.Otworz(kierunek,i);
 312            enable PRZYJECHALA,PASAZERWSIADA, PASAZERWYSIADA;
 313            call Ekran.Guzik(kierunek,czerwony,i);
 314       end  OtwieramDrzwi;
 315
 316       UNIT ZamykamDrzwi :  procedure(gora:boolean, i: integer);
 317       begin
 318            disable WOLAM;
 319            if  gora then
 320                 PIETRA(i).wgore := false else PIETRA(i).wdol := false
 321            fi;
 322            enable WOLAM;
 323
 324            call Ekran.Zamknij(gora,i);
 325            call Ekran.Guzik(gora,szary,i);
 326            disable PRZYJECHALA,PASAZERwsIADA, PASAZERwySIADA;
 327       end  ZamykamDrzwi;
 328
 329       UNIT KierunekJazdy : procedure;
 330       var i : integer;
 331       begin
 332          JEDZna := naPietrze;
 333
 334          if (kierunek= gora) then
 335              for i := naPIETRZE+1 to n
 336              do
 337                 if (PRZYCISKI(i) or PIETRA(i).wgore or PIETRA(i).wdol) then
 338                 JedzNa := i; exit fi
 339              od;
 340              if JedzNa=naPietrze then
 341                 for i := naPIETRZE-1 downto 0
 342                 do
 343                   if (PRZYCISKI(i) or PIETRA(i).wdol or PIETRA(i).wgore) then
 344                          JedzNa := i; exit fi
 345                 od;
 346              fi;
 347          else (*if kierunek= dol then *)
 348              for i := naPIETRZE downto 0
 349              do
 350                 if (PRZYCISKI(i) or PIETRA(i).wdol or PIETRA(i).wgore) then
 351                 JedzNa := i; exit fi
 352              od;
 353              if JedzNa= naPietrze then
 354                 for i := naPIETRZE+1 to n
 355                 do
 356                    if (PRZYCISKI(i) or PIETRA(i).wgore or PIETRA(i).wdol) then
 357                      JedzNa := i; exit fi
 358                 od;
 359              fi;
 360         fi;
 361         stoj := (naPIETRZE=JEDZna);
 362         if stoj then kierunek := not kierunek else
 363               kierunek := naPietrze < JedzNa
 364         fi;
 365
 366       END KierunekJazdy;
 367
 368       unit JEDZ : procedure(gora:boolean);
 369       var j : integer;
 370       begin
 371           call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H,7);
 372           if gora then
 373              for j := 0 to H-1 do
 374                 call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H -j,7);
 375                 call pauza(2);
 376                 call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H -j,15);
 377                 call pauza(2)
 378              od;
 379              call EKRAN.RysujWinde(YmaxW-(naPietrze+2)*H,7)
 380           else
 381               for j:= 0 to H-1 do
 382                  call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H +j,7);
 383                  call pauza(2);
 384                  call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H +j,15);
 385                  call pauza(2);
 386               od;
 387               call EKRAN.RysujWinde(YmaxW-(naPietrze)*H,7);
 388            fi;
 389       end jedz;
 390
 391   handlers
 392    others    call EKRAN.comment("handler  LIFT");
 393              call pauza(500);
 394              call EKRAN.KONIEC
 395   end handlers;
 396
 397   BEGIN
 398      array PIETRA dim(0:n);
 399      for i:= 0 to n do PIETRA(i):= new guzik od;
 400      array PRZYCISKI dim (0:n);
 401      jedzNa := 0;   naPietrze:=0;
 402      array WWindzie dim(1: MAXp); (* 20 = max ilosc pasazerow *)
 403
 404      enable  Wolam;
 405      kierunek := gora;
 406
 407      return;
 408      call EKRAN.RysujWinde(YmaxW-H, szary);
 409
 410      DO
 411         stoj:= true;
 412         while stoj
 413         do
 414                 call CZEKAM(naPIETRZE);
 415                 for j := 1 to 10 do j := j od;
 416                 call KIERUNEKjazdy;
 417         od;
 418         call ZamykamDrzwi(gora,naPIETRZE);
 419         call ZamykamDrzwi(dol,naPIETRZE);
 420
 421         if kierunek = gora then
 422              for i:= naPIETRZE+1 to JEDZna  DO
 423                (*  jade na nastepne pietro *)
 424                call JEDZ(gora);
 425                naPietrze:= i;
 426                (*jezeli ktos czeka lub wysiada to zatrzymaj*)
 427                if (PIETRA(i).wgore or PRZYCISKI(i)) then
 428                   call pauza(500);
 429                   call OtwieramDrzwi(i);
 430                   (* pasazerowie wsiadaja lub wysiadaja *)
 431                   for j := 1 to 1000 do j := j od;
 432                   call ZamykamDRZWI(gora,i);
 433                fi;
 434              od(* jedzNA*)
 435         else
 436         (*if kierunek = dol*)
 437
 438              for i := naPIETRZE-1 downto jedzNA   do
 439                 (* zjezdzam w dol *)
 440                 call JEDZ(dol);
 441                 naPietrze:= i;
 442                 if ( PIETRA(i).wdol or PRZYCISKI(i)) then
 443                    call pauza(500);
 444                    call OtwieramDrzwi(i);
 445                    (* pasazerowie wsiadaja/ wysiadaja*)
 446                    call pauza(500);
 447                    call ZamykamDrzwi(dol,i);
 448                 fi;
 449
 450              od (* jedz w dol NA*);
 451         fi;
 452
 453       OD (* zachowania windy *);
 454   END LIFT;
 455
 456
 457 (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
 458
 459
 460   UNIT PASAZER : process(node:integer,ss: string,z,na,kolor : integer,
 461                         winda: lift,EKRAN : ecran);
 462   const szary = 7;
 463   var    i,j     : integer,
 464          jest,przyjechala,Wgore,wsiadlem : boolean;
 465
 466      handlers
 467         others
 468               call EKRAN.comment("handler  PASAZER");
 469               call EKRAN.KONIEC;
 470      end handlers;
 471
 472   BEGIN  (***  opis zachowania  pasazera  ***)
 473
 474      return;
 475      Wgore := na>z;
 476      call EKRAN.JESTEM(Wgore,kolor,z,i);
 477      (*powinien otrzymac inormacje o swojej aktualnej pozycji na pietrze*)
 478      wsiadlem := false; przyjechala:= false;
 479
 480      while not wsiadlem do
 481         call Winda.Wolam(Wgore,z);
 482         call WINDA.PasazerWsiada(z,na,kolor,i,j);
 483         (*  otrzymal od windy numerek j m lub 0 gdy nie wsiadl*)
 484         wsiadlem :=(j<>0)
 485      od;
 486      while not przyjechala do
 487         przyjechala := WINDA.PRZYJECHALA(na)
 488      od;
 489      call WINDA.PasazerWysiada(j);
 490    END pasazer;
 491 (*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
 492
 493   UNIT irandom : FUNCTION(a,b:INTEGER):INTEGER;
 494   begin
 495        result := entier((b-a)*random + a)
 496   end irandom;
 497
 498
 499
 500
 501  (*===================================================================*)
 502 VAR   EKRAN  : ecran, Winda : LIFT,
 503       P      : arrayof PASAZER,pp :PASAZER,
 504       i,n,m,z,na,k : integer;
 505      handlers
 506      when   signal1  : call EKRAN.comment("K O N I E C");
 507                      call EKRAN.KONIEC;
 508      others          call EKRAN.comment("handler   PROGRAM GLOWNY ");
 509                      call EKRAN.KONIEC
 510      end handlers;
 511
 512 BEGIN
 513            EKRAN := new Ecran(0);
 514            resume(EKRAN);
 515            n :=10;  m := 1;(* calkowita ilosc pasazerow*)
 516
 517            call Ekran.DOM(7,n);
 518  readln;
 519            array P dim(1:m);
 520            Winda := new LIFT(0,n,10,EKRAN);
 521
 522            resume(Winda);
 523
 524 readln;
 525           DO       (*  generowanie pasazerow *)
 526
 527             for i := 1 to m
 528             do
 529                na,z := irandom (0,n);
 530                while z=na do na := irandom(0,n) od;
 531                k := 7;
 532                while k=7 do k := irandom (0,14) od;
 533
 534                pp:= new pasazer(0,"aa",z,na,k,winda,EKRAN);
 535                resume(pp);
 536             od;
 537
 538             pref IIUWGRAPH  block
 539             var boo : boolean, x,y,i,l,r,z : integer;
 540             begin
 541              (*   call init(1,1); call ShowCursor;*)
 542                 call EKRAN.comment("CONTINUE? (y/n)");
 543
 544             (*    z:=0;boo:= false; i:=0;l:=0;r:=0;
 545                 while not  (l= ord('y') or l= ord('n')) do
 546                   boo := getpress(x,y,i,l,r,z);
 547                 od;
 548              *)
 549                    while not (l=ord('y') or l=ord('n')) do
 550                      l:=inkey;
 551                    od;
 552                 call EKRAN.comment("                ");
 553
 554                 if l= ord('n') then raise signal1 fi;
 555
 556             end;
 557          OD;
 558
 559
 560 END LIFT;
 561
 562 (***********************************************************************)
 563
 564
 565
 566
 567
 568
 569
 570
 571
 572
 573
 574
 575
 576
 577
 578
 579
 580
 581
 582
 583
 584     unit zegar: process;
 585       var i,j:integer;
 586
 587       begin
 588         do
 589           call ramka(420,310,480,335);
 590           call ramka(422,312,478,333);
 591           call ramka(421,311,479,334);
 592           call move(433,320);
 593           call wypisz(i);
 594           call outstring(":");
 595           call wypisz(j);
 596           j:=j+1;
 597           if j=60 then j:=0;i:=i+1 fi;
 598           call hold(1)
 599         od
 600       end zegar;
 601
 602
 603
 604
 605
 606  unit ramka:iiuwgraph procedure(x1,y1,x2,y2:integer);
 607    begin
 608      call move(x1,y1);
 609      call draw(x2,y1);
 610      call draw(x2,y2);
 611      call draw(x1,y2);
 612      call draw(x1,y1)
 613    end ramka;
 614
 615
 616    unit elem : class;
 617       unit virtual affichage : procedure;
 618       end affichage;
 619    end elem;
 620
 621    unit box : class;
 622    var e: elem, next : box;
 623    end box;
 624
 625    unit queue : class;
 626    var premier, dernier : box;
 627
 628       unit virtual first :  function : elem;
 629       begin
 630           if not empty
 631           then
 632               result := premier.e;
 633           fi;
 634       end first;
 635
 636       unit virtual insert :  procedure( e: elem);
 637       var aux : box;
 638       begin
 639           aux := new box;
 640           aux.e := e;
 641           if premier=none
 642           then
 643               premier := aux;
 644               dernier := aux;
 645           else
 646               dernier.next := aux;
 647               dernier := aux
 648             fi;
 649        end insert;
 650
 651        unit virtual delete :  procedure;
 652        begin
 653             if not empty
 654             then
 655                 premier := premier.next;
 656             fi;
 657         end delete;
 658
 659         unit virtual empty :  function : boolean;
 660         begin
 661              result := (premier=none)
 662         end empty;
 663     end queue;
 664
 665 END STRUC_QUEUE;
 666
 667
 668
 669    unit wstep:procedure;
 670      begin
 671         call gron(0);
 672         call ramka(230,120,480,220);
 673         call ramka(228,118,482,222);
 674         call ramka(226,116,484,224);
 675         call move(250,160);
 676         call outstring("Symulacja windy przy pomocy procesow");
 677         call move(250,180);
 678         call outstring("GM");
 679         call move(250,200);
 680         call outstring(" Dabrowa kwiecien 2000");
 681         WHILE INKEY=0 DO OD;
 682         call groff
 683       end wstep;
 684
 685
 686            (* Strona tytulowa *)
 687            CONTINUE_IKONA := new IKONA(szary,400,400,550,430,3,"   CONTINUE");
 688            CALL ramka (1,5,0,0,638,478,ciemnoszary,szary,bialy,czarny);
 689            CALL ramka (3,3,230,30,390,80,niebieski,szary,bialy,granatowy);
 690            CALL Tytul (1,270,50,czarny,szary,"  LIFT  SIMULATION  ");
 691
 692            call CONTINUE_IKONA.write_i;
 693
 694            do
 695               boo := getpress(xx,yy,i,l,r,z);
 696               if z=1 and CZY(xx,yy,CONTINUE_IKONA) then  exit fi
 697            od;
 698            call CONTINUE_IKONA.push;
 699
 700
 701
 702     handlers
 703       when MEMERROR : call comment("Zabraklo pamieci");
 704                       call waitt; call GROFF;
 705       when ACCERROR : call comment("Reference to none ");
 706                       call waitt; call GROFF;
 707       when LOGERROR : call comment("Niepoprawny Attach");
 708                       call waitt;call GROFF;
 709       when CONERROR : call comment(" Array-index error ");
 710                       call waitt; call GROFF;
 711       when SYSERROR : call comment("input-output error");
 712                       call waitt; call GROFF;
 713       when NUMERROR : call comment("blad numeryczny");
 714                       call waitt; call GROFF;
 715       others : call comment("Jakis blad ");
 716                       call waitt; call GROFF;
 717     end handlers;
 718
 719
 720
 721
 722
 723
 724
 725
 726
 727            unit restore : procedure;
 728           (* odnawia kolory wierzcholkow na ekanie *)
 729            var i : integer;
 730            begin
 731                 delta := 0;
 732                 for i := 1 to nr
 733                 do
 734                     lista(i).kolor := zolty;
 735                 od;
 736            end restore;
 737
 738            UNIT strzalka : procedure(A,B : node);
 739            var r : real, cx,cy,dx,dy,ex,ey,delt,del : integer;
 740            BEGIN
 741                 del := 15; delt:=7;
 742                 call color(zolty);
 743                 call move(A.x,A.y);
 744                 call draw(B.x,B.y);
 745
 746                 call color(noir);
 747                 r := sqrt((b.y-a.y)*(b.y-a.y)+(b.x-a.x)*(b.x-a.x));
 748                 cx := b.x- entier((b.x-a.x)*del/r );
 749                 cy := b.y- entier((b.y-a.y)*del/r );
 750                 dx := b.x- entier((b.x-a.x)*(del+delt)/r + (b.y-a.y)*delt/r);
 751                 dy := b.y- entier((b.y-a.y)*(del+delt)/r - (b.x-a.x)*delt/r);
 752                 ex := b.x- entier((b.x-a.x)*(del+delt)/r - (b.y-a.y)*delt/r);
 753                 ey := b.y- entier((b.y-a.y)*(del+delt)/r + (b.x-a.x)*delt/r);
 754                 call move(dx,dy); call draw(cx,cy);
 755                 call move(ex,ey); call draw(cx,cy);
 756            END strzalka;
 757
 758
 759            unit print : procedure;
 760            var aux, aux1 : node, i : integer;
 761            begin
 762                    call patern(MinX,MinY+40,MaxX,MaxY,7,1);
 763                    for i :=1 to nr
 764                    do
 765                       aux := lista(i);
 766                         call aux.affichage(zolty);
 767                         if not aux.lista.empty
 768                         then
 769                             aux1 := aux.lista.first;
 770                             while not aux1= none
 771                             do
 772                                 call strzalka(aux,aux1);
 773                                 aux1 := aux.lista.next;
 774                             od
 775                         fi;
 776                    od;
 777                    call comment("")
 778            end print;
 779
 780        begin
 781            array lista dim(1:10);
 782            nr := 0;
 783        end graph;
 784
 785 (*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
 786 (*    NODE - wierzcholek grafu                                          *)
 787 (*  x,y pozycja na ekranie, nr  numer wierzcholka                       *)
 788 (*  lista - lista wierzcholkow incydentnych                             *)
 789 (*----------------------------------------------------------------------*)
 790        unit node : elem class(x,y,nr: integer);
 791        var lista : liste,
 792            kolor : integer;
 793
 794           unit affichage : procedure(c: integer);
 795           begin
 796             call cirb(x+3,y+3,5,5,0,3600,c,1);
 797             call track(x+5,y+5,nr,gris,noir);
 798           end affichage;
 799
 800           unit wypisz : procedure(i: integer);
 801          (*  wypisz kolejnosc odwiedzania wierzcholkow *)
 802           var j, k : integer;
 803           begin
 804              for j := 0 to 160 do j:=j; call affichage(j mod 16 ) od;
 805              k := (i+9) mod 16;
 806              if  k = gris then  k := noir fi;
 807              call affichage(k);
 808              call track(piszX+delta,piszY,nr,gris,k);
 809              if nr>9 then
 810                 delta := delta+2*10
 811              else
 812                 delta := delta+10
 813              fi;
 814           end wypisz;
 815
 816           unit visite : function : boolean;
 817           (* Czy wierzcholek byl juz odwiedzony  *)
 818           (* Wierzcholek odwiedzony dostaje kolor czarny*)
 819           begin
 820                 if kolor=noir then result := true;
 821                 else result := false; kolor := noir
 822                 fi;
 823           end visite;
 824
 825        begin
 826            lista := new liste; kolor := zolty;
 827        end node;
 828
 829        unit clear : procedure(col, minX,minY,maxX,maxY : integer);
 830        var i, j, sr : integer;
 831        begin
 832             call color(col);
 833             sr := (minX+maxX) div 2;
 834             for i := 0 to (maxX - minX) div 2
 835             do
 836                 call move( sr, maxY);
 837                 call draw(sr +i, minY);
 838                 call move(sr, maxY);
 839                 call draw(sr -i, minY);
 840                 for j:=1 to 100 do j:=j od;
 841             od;
 842             for i := 0 to (maxY - minY)
 843             do
 844                 call move( sr, maxY);
 845                 call draw(maxX, minY+i);
 846                 call move(sr, maxY);
 847                 call draw(minX, minY+i);
 848                 for j:=1 to 100 do j:=j od;
 849             od;
 850
 851        end clear;
 852
 853
 854     unit clear_all : procedure(col, minX,minY,maxX,maxY : integer);
 855     var i,j : integer;
 856     begin
 857             call color(col);
 858             for i := 1 to ((maxY - minY) div 2)
 859             do
 860                 call patern(minX+i,minY+i,maxX-i,maxY-i,3,0);
 861                 for j:=1 to 200 do j:=j od;
 862             od;
 863     end clear_all;
 864
 865     unit waittt : procedure;
 866     var x,y,i,l,r,z : integer,boo : boolean;
 867     begin
 868         call outstring(maxX-100,maxY+25, "CONTINUE",zielony,noir);
 869         boo := false;
 870         while z=0 do boo := getpress(x,y,i,l,r,z) od;
 871         call outstring(maxX-100,maxY+25, "          ",gris,gris);
 872
 873     end waittt;
 874
 875     unit YES : function : boolean;
 876     var x,y,i,l,r,z : integer,boo : boolean;
 877     begin
 878         boo := false;
 879         while l=0 do boo := getpress(x,y,i,l,r,z) od;
 880         if (l= ord('y') or l=ord('Y')) then
 881                 result := true else result := false
 882         fi;
 883     end YES;
 884
 885     unit comment : procedure (s : string);
 886     begin
 887         call patern(MinX+10,MaxY+2,MaxX,MaxY+50,gris,1);
 888         call outstring(MinX+10,MaxY+16,s,noir,gris);
 889     end comment;
 890
 891 \80
 892 \0\0