examp/lift5.log

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