examples/grazyna.xmp/bus13.log

   1 BLOCK\r
   2  \r
   3 (*****************************************************************************)\r
   4 (********************************** F I F O **********************************)\r
   5 (*****************************************************************************)\r
   6  \r
   7 unit FIFO : class ( type T);\r
   8  \r
   9      var HEAD,LAST : ELEM;\r
  10  \r
  11      unit   ELEM : class ( INFO : T);\r
  12      var NEXT : ELEM;\r
  13      begin\r
  14      end ELEM;\r
  15  \r
  16      unit EMPTY : function : boolean;\r
  17      begin\r
  18        result := (HEAD=NONE)\r
  19      end EMPTY;\r
  20  \r
  21      unit INTO : procedure ( INFO : T );\r
  22      begin\r
  23        if EMPTY then\r
  24         HEAD := new ELEM(INFO);\r
  25         LAST := HEAD\r
  26        else\r
  27          LAST.NEXT := new ELEM(INFO);\r
  28          LAST := LAST.NEXT\r
  29       fi\r
  30      end INTO;\r
  31  \r
  32      unit FIRST : function : T;\r
  33      begin\r
  34        result := HEAD.INFO\r
  35      end FIRST;\r
  36  \r
  37      unit OUT_FIRST : procedure;\r
  38      begin\r
  39           if not EMPTY\r
  40           then\r
  41               HEAD := HEAD.NEXT\r
  42           fi\r
  43      end OUT_FIRST;\r
  44  \r
  45      unit CARDINAL : function : integer;\r
  46      var HLP : ELEM;\r
  47      begin\r
  48            HLP := HEAD;\r
  49            while HLP <> NONE\r
  50            do\r
  51                 result :=result + 1;\r
  52                 HLP := HLP.NEXT\r
  53            od\r
  54      end CARDINAL;\r
  55  \r
  56  end FIFO;\r
  57  \r
  58  \r
  59 (*****************************************************************************)\r
  60 (************************** E N D      F I F O *******************************)\r
  61 (*****************************************************************************)\r
  62  \r
  63 (*                       *   *   *   *   *   *    *                          *)\r
  64  \r
  65 (*****************************************************************************)\r
  66 (************************* S I M U L A T I O N *******************************)\r
  67 (*****************************************************************************)\r
  68  \r
  69 UNIT PRIORITYQUEUE: IIUWGRAPH  CLASS;\r
  70  \r
  71      UNIT QUEUEHEAD: CLASS;\r
  72         (* HEAP ACCESING MODULE *)\r
  73              VAR LAST,ROOT:NODE;\r
  74  \r
  75              UNIT MIN: FUNCTION: ELEM;\r
  76                   BEGIN\r
  77                 IF ROOT=/= NONE THEN RESULT:=ROOT.EL FI;\r
  78                  END MIN;\r
  79  \r
  80              UNIT INSERT: PROCEDURE(E:ELEM);\r
  81                (* INSERTION INTO HEAP *)\r
  82                    VAR X,Z:NODE;\r
  83                  BEGIN\r
  84                        X:= E.LAB;\r
  85                        IF LAST=NONE THEN\r
  86                            ROOT:=X;\r
  87                            ROOT.LEFT,LAST:=ROOT\r
  88                        ELSE\r
  89                          IF LAST.NS=0 THEN\r
  90                            LAST.NS:=1;\r
  91                            Z:=LAST.LEFT;\r
  92                            LAST.LEFT:=X;\r
  93                            X.UP:=LAST;\r
  94                            X.LEFT:=Z;\r
  95                            Z.RIGHT:=X;\r
  96  \r
  97                          ELSE\r
  98                            LAST.NS:=2;\r
  99                            Z:=LAST.RIGHT;\r
 100                            LAST.RIGHT:=X;\r
 101                            X.RIGHT:=Z;\r
 102                            X.UP:=LAST;\r
 103                            Z.LEFT:=X;\r
 104                            LAST.LEFT.RIGHT:=X;\r
 105                            X.LEFT:=LAST.LEFT;\r
 106                            LAST:=Z;\r
 107                          FI\r
 108                        FI;\r
 109  \r
 110                        CALL CORRECT(E,FALSE)\r
 111         END INSERT;\r
 112  \r
 113 UNIT DELETE: PROCEDURE(R: ELEM);\r
 114      VAR X,Y,Z:NODE;\r
 115      BEGIN\r
 116      X:=R.LAB;\r
 117      Z:=LAST.LEFT;\r
 118      IF LAST.NS =0 THEN\r
 119            Y:= Z.UP;\r
 120            if y<>none then Y.RIGHT:= LAST else root :=none fi;\r
 121            LAST.LEFT:=Y;\r
 122            LAST:=Y;\r
 123                    ELSE\r
 124            Y:= Z.LEFT;\r
 125            Y.RIGHT:= LAST;\r
 126             LAST.LEFT:= Y;\r
 127                     FI;\r
 128        Z.EL.LAB:=X;\r
 129        X.EL:= Z.EL;\r
 130        LAST.NS:= LAST.NS-1;\r
 131        R.LAB:=Z;\r
 132        Z.EL:=R;\r
 133  \r
 134        z.left.right := none;\r
 135        z.ns := 0;\r
 136        z.left, z.right, z.up := none;\r
 137        IF X.LESS(X.UP) THEN CALL CORRECT(X.EL,FALSE)\r
 138                        ELSE CALL CORRECT(X.EL,TRUE) FI;\r
 139      END DELETE;\r
 140  \r
 141 UNIT CORRECT: PROCEDURE(R:ELEM,DOWN:BOOLEAN);\r
 142    (* CORRECTION OF THE HEAP WITH STRUCTURE BROKEN BY R *)\r
 143      VAR X,Z:NODE,T:ELEM,FIN,LOG:BOOLEAN;\r
 144      BEGIN\r
 145      Z:=R.LAB;\r
 146      IF DOWN THEN\r
 147           WHILE NOT FIN DO\r
 148                  IF Z.NS =0 THEN FIN:=TRUE ELSE\r
 149                       IF Z.NS=1 THEN X:=Z.LEFT ELSE\r
 150                       IF Z.LEFT.LESS(Z.RIGHT) THEN X:=Z.LEFT ELSE X:=Z.RIGHT\r
 151                        FI; FI;\r
 152                       IF Z.LESS(X) THEN FIN:=TRUE ELSE\r
 153                             T:=X.EL;\r
 154                             X.EL:=Z.EL;\r
 155                             Z.EL:=T;\r
 156                             Z.EL.LAB:=Z;\r
 157                            X.EL.LAB:=X\r
 158                       FI; FI;\r
 159                  Z:=X;\r
 160                        OD\r
 161               ELSE\r
 162     X:=Z.UP;\r
 163     IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z); FI;\r
 164     WHILE NOT LOG DO\r
 165           T:=Z.EL;\r
 166           Z.EL:=X.EL;\r
 167            X.EL:=T;\r
 168           X.EL.LAB:=X;\r
 169           Z.EL.LAB:=Z;\r
 170           Z:=X;\r
 171           X:=Z.UP;\r
 172            IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z);\r
 173             FI;\r
 174                 OD\r
 175      FI;\r
 176  END CORRECT;\r
 177  \r
 178 END QUEUEHEAD;\r
 179  \r
 180  \r
 181 UNIT NODE: CLASS (EL:ELEM);\r
 182   (* ELEMENT OF THE HEAP *)\r
 183       VAR LEFT,RIGHT,UP: NODE, NS:INTEGER;\r
 184       UNIT LESS: FUNCTION(X:NODE): BOOLEAN;\r
 185           BEGIN\r
 186           IF X= NONE THEN RESULT:=FALSE\r
 187                     ELSE RESULT:=EL.LESS(X.EL) FI;\r
 188           END LESS;\r
 189      END NODE;\r
 190  \r
 191  \r
 192 UNIT ELEM: CLASS(PRIOR:REAL);\r
 193   (* PREFIX OF INFORMATION TO BE STORED IN NODE *)\r
 194    VAR LAB: NODE;\r
 195    UNIT VIRTUAL LESS: FUNCTION(X:ELEM):BOOLEAN;\r
 196             BEGIN\r
 197             IF X=NONE THEN RESULT:= FALSE ELSE\r
 198                            RESULT:= PRIOR< X.PRIOR FI;\r
 199             END LESS;\r
 200     BEGIN\r
 201     LAB:= NEW NODE(THIS ELEM);\r
 202     END ELEM;\r
 203  \r
 204 END PRIORITYQUEUE;\r
 205  \r
 206 UNIT SIMULATION: PRIORITYQUEUE CLASS;\r
 207 (* THE LANGUAGE FOR SIMULATION PURPOSES *)\r
 208  \r
 209     hidden curr, pq;\r
 210     signal ERROR1, ERROR2;\r
 211     VAR  CURR : SIMPROCESS,  (* ACTIVE PROCESS *)\r
 212            PQ : QUEUEHEAD,   (* THE TIME AXIS *)\r
 213        MAINPR : MAINPROGRAM;\r
 214  \r
 215  \r
 216     UNIT   SIMPROCESS: COROUTINE;\r
 217          (* USER PROCESS PREFIX *)\r
 218  \r
 219          VAR EVENT,  (* ACTIVATION MOMENT NOTICE *)\r
 220              EVENTAUX: EVENTNOTICE,\r
 221              (* THIS IS FOR AVOIDING MANY NEW CALLS AS AN RESULT OF *)\r
 222              (* SUBSEQUENT PASSIVATIONS AND ACTIVATIONS             *)\r
 223              FINISH: BOOLEAN;\r
 224  \r
 225              UNIT IDLE: FUNCTION: BOOLEAN;\r
 226              BEGIN\r
 227                    RESULT:= EVENT= NONE\r
 228              END IDLE;\r
 229  \r
 230              UNIT TERMINATED: FUNCTION :BOOLEAN;\r
 231              BEGIN\r
 232                   RESULT:= FINISH;\r
 233              END TERMINATED;\r
 234  \r
 235              UNIT EVTIME: FUNCTION: REAL;\r
 236              (* TIME OF ACTIVATION *)\r
 237              BEGIN\r
 238                     IF IDLE THEN raise ERROR1; FI;\r
 239                     RESULT:= EVENT.EVENTTIME;\r
 240              END EVTIME;\r
 241     handlers\r
 242        when ERROR1 :\r
 243                WRITELN(" AN ATTEMPT TO ACTIVATE AN IDLE PROCESS TIME");\r
 244                attach(main);\r
 245        when ERROR2 :\r
 246                WRITELN(" AN ATTEMPT TO ACTIVATE A TERMINATED PROCESS TIME");\r
 247                attach(MAIN);\r
 248    end handlers;\r
 249  \r
 250      BEGIN\r
 251              RETURN;\r
 252              INNER;\r
 253              FINISH:=TRUE;\r
 254              CALL PASSIVATE;\r
 255              raise ERROR2;\r
 256      END SIMPROCESS;\r
 257  \r
 258  \r
 259      UNIT EVENTNOTICE: ELEM CLASS;\r
 260      (* A PROCESS ACTIVATION NOTICE TO BE PLACED ONTO THE TIME AXIS PQ *)\r
 261      VAR EVENTTIME: REAL, PROC: SIMPROCESS;\r
 262  \r
 263         UNIT VIRTUAL LESS: FUNCTION(X: EVENTNOTICE):BOOLEAN;\r
 264         (* OVERWRITE THE FORMER VERSION CONSIDERING EVENTTIME *)\r
 265         BEGIN\r
 266             IF X=NONE\r
 267             THEN\r
 268                 RESULT:= FALSE\r
 269             ELSE\r
 270                   RESULT:= EVENTTIME< X.EVENTTIME OR\r
 271                   (EVENTTIME=X.EVENTTIME AND PRIOR<= X.PRIOR);\r
 272             FI;\r
 273         END LESS;\r
 274  \r
 275      END EVENTNOTICE;\r
 276  \r
 277  \r
 278      UNIT MAINPROGRAM: SIMPROCESS CLASS;\r
 279      (* IMPLEMENTING MASTER PROGRAM AS A PROCESS *)\r
 280      BEGIN\r
 281           DO ATTACH(MAIN) OD;\r
 282      END MAINPROGRAM;\r
 283  \r
 284      UNIT TIME:FUNCTION:REAL;\r
 285      (* CURRENT VALUE OF SIMULATION TIME *)\r
 286      BEGIN\r
 287           RESULT:=CURRENT.EVTIME\r
 288      END TIME;\r
 289  \r
 290      UNIT CURRENT: FUNCTION: SIMPROCESS;\r
 291      (* THE FIRST PROCESS ON THE TIME AXIS *)\r
 292      BEGIN\r
 293           RESULT:=CURR;\r
 294      END CURRENT;\r
 295  \r
 296      UNIT SCHEDULE: PROCEDURE(P:SIMPROCESS,T:REAL);\r
 297      (* ACTIVATION OF PROCESS P AT TIME T AND DEFINITION OF *)\r
 298      (*  "PRIOR"- PRIORITY WITHIN TIME MOMENT T             *)\r
 299      BEGIN\r
 300  \r
 301         if p.terminated then raise ERROR2 fi;\r
 302  \r
 303         IF T<TIME THEN T:= TIME FI;\r
 304         IF P=CURRENT THEN CALL HOLD(T-TIME) ELSE\r
 305         IF P.IDLE AND P.EVENTAUX=NONE THEN (* HAS NOT BEEN SCHEDULED YET*)\r
 306                 P.EVENT,P.EVENTAUX:= NEW EVENTNOTICE(RANDOM);\r
 307                 P.EVENT.PROC:= P;\r
 308         ELSE\r
 309               IF P.IDLE (* P HAS ALREADY BEEN SCHEDULED *) THEN\r
 310                    P.EVENT:= P.EVENTAUX;\r
 311                    P.EVENT.PRIOR:=RANDOM;\r
 312                ELSE\r
 313                    (* NEW SCHEDULING *)\r
 314                    P.EVENT.PRIOR:=RANDOM;\r
 315                    CALL PQ.DELETE(P.EVENT)\r
 316                FI;\r
 317         FI;\r
 318         P.EVENT.EVENTTIME:= T;\r
 319         CALL PQ.INSERT(P.EVENT) FI;\r
 320     END SCHEDULE;\r
 321  \r
 322     UNIT HOLD:PROCEDURE(T:REAL);\r
 323     (* MOVE THE ACTIVE PROCESS T MINUTES BACK ALONG PQ *)\r
 324     (* REDEFINE PRIOR                                  *)\r
 325      BEGIN\r
 326         CALL PQ.DELETE(CURRENT.EVENT);\r
 327         CURRENT.EVENT.PRIOR:=RANDOM;\r
 328         IF T<0 THEN T:=0; FI;\r
 329         CURRENT.EVENT.EVENTTIME:=TIME+T;\r
 330         CALL PQ.INSERT(CURRENT.EVENT);\r
 331         CALL CHOICEPROCESS;\r
 332      END HOLD;\r
 333  \r
 334 UNIT PASSIVATE: PROCEDURE;\r
 335   (* REMOVE THE ACTVE PROCESS FROM PQ AND ACTIVATE THE NEXT ONE *)\r
 336      BEGIN\r
 337       CALL PQ.DELETE(CURRENT.EVENT);\r
 338       CURRENT.EVENT:=NONE;\r
 339       CALL CHOICEPROCESS\r
 340      END PASSIVATE;\r
 341  \r
 342 UNIT RUN: PROCEDURE(P:SIMPROCESS);\r
 343  (* ACTIVATE P IMMEDIATELY AND DELAY THE current PROCESS BY REDEFINING*)\r
 344  (* PRIOR                                                             *)\r
 345      BEGIN\r
 346      CURRENT.EVENT.PRIOR:=RANDOM;\r
 347      IF NOT P.IDLE THEN\r
 348             P.EVENT.PRIOR:=0;\r
 349             P.EVENT.EVENTTIME:=TIME;\r
 350             CALL PQ.CORRECT(P.EVENT,FALSE)\r
 351                     ELSE\r
 352         IF P.EVENTAUX=NONE THEN\r
 353             P.EVENT,P.EVENTAUX:=NEW EVENTNOTICE(0);\r
 354         ELSE\r
 355              P.EVENT:=P.EVENTAUX;\r
 356              P.EVENT.PRIOR:=0;\r
 357         fi;\r
 358              P.EVENT.EVENTTIME:=TIME;\r
 359              P.EVENT.PROC:=P;\r
 360              CALL PQ.INSERT(P.EVENT);\r
 361       FI;\r
 362       CALL CHOICEPROCESS;\r
 363 END RUN;\r
 364  \r
 365 UNIT CANCEL:PROCEDURE(P: SIMPROCESS);\r
 366  (* REMOVE PROCESS P FROM PQ AND CONTINUE SIMULATION *)\r
 367    BEGIN\r
 368    IF P= CURRENT THEN CALL PASSIVATE ELSE\r
 369     CALL PQ.DELETE(P.EVENT);\r
 370     P.EVENT:=NONE;  FI;\r
 371  END CANCEL;\r
 372  \r
 373 UNIT CHOICEPROCESS:PROCEDURE;\r
 374  (* CHOOSE THE FIRST PROCESS FROM PQ TO BE ACTIVATED *)\r
 375    BEGIN\r
 376   (**** poprawka 10-93 ****)\r
 377    CURR:= PQ.MIN QUA EVENTNOTICE.PROC;\r
 378     IF CURR=NONE THEN WRITE(" ERROR IN THE HEAP"); WRITELN;\r
 379                       ATTACH(MAIN);\r
 380                  ELSE ATTACH(CURR); FI;\r
 381 END CHOICEPROCESS;\r
 382  \r
 383 BEGIN\r
 384   PQ:=NEW QUEUEHEAD;  (* SIMULATION TIME AXIS*)\r
 385   CURR,MAINPR:=NEW MAINPROGRAM;\r
 386   MAINPR.EVENT,MAINPR.EVENTAUX:=NEW EVENTNOTICE(0);\r
 387   MAINPR.EVENT.EVENTTIME:=0;\r
 388   MAINPR.EVENT.PROC:=MAINPR;\r
 389   CALL PQ.INSERT(MAINPR.EVENT);\r
 390   (* THE FIRST PROCESS TO BE ACTIVATED IS MAIN PROGRAM *)\r
 391   INNER;\r
 392   PQ:=NONE;\r
 393 END SIMULATION;\r
 394  \r
 395 (*****************************************************************************)\r
 396 (************************ E N D      S I M U L A T I O N *********************)\r
 397 (*****************************************************************************)\r
 398  \r
 399  \r
 400 (*                 B U S     S I M U L A T I O N                            *)\r
 401 begin\r
 402   pref iiuwgraph block\r
 403  \r
 404    BEGIN\r
 405      PREF  SIMULATION BLOCK\r
 406      const pojemnosc=30;\r
 407      var\r
 408        autobusy:arrayof bus,\r
 409        przystan:arrayof przystanek,\r
 410        inf:info,cl:zegar,\r
 411        ws:integer,\r
 412        c:char,\r
 413        praz:boolean,\r
 414        i,j,jj,p,czas_sym,czas,ilosc_przystankow,\r
 415        ilosc_auto,czestosc,odstep1,odstep2,podst1,podst2:integer;\r
 416  \r
 417      unit wsp:class(x,y,i:integer);\r
 418      begin\r
 419      end wsp;\r
 420  \r
 421      unit nast:function(w:wsp):wsp;\r
 422        var pom:wsp;\r
 423        begin\r
 424          if w.i <= ilosc_przystankow div 2\r
 425          then\r
 426            pom:=new wsp(w.x,w.y - odstep1,i mod ilosc_przystankow +1)\r
 427          else\r
 428            if w.x>550\r
 429            then\r
 430              pom:=new wsp(600-w.x,20,i mod ilosc_przystankow+1)\r
 431            else\r
 432              pom:=new wsp(w.x,w.y+odstep1,i mod ilosc_przystankow+1)\r
 433            fi\r
 434          fi;\r
 435          result:=pom\r
 436        end nast;\r
 437  \r
 438      unit bus:simprocess class(kolor:integer);\r
 439      var  i,j,kier,\r
 440           wolnych_miejsc : integer,\r
 441           dokad : arrayof integer,\r
 442           ws : wsp,\r
 443           wsiadajacy:pasazer;\r
 444      begin\r
 445          array dokad dim (1: ilosc_przystankow);\r
 446          wolnych_miejsc := pojemnosc;\r
 447          praz := true;\r
 448  \r
 449          ws := new wsp(480,282,1);\r
 450          call auto(kolor,ws.x,ws.y,wolnych_miejsc);\r
 451          write(chr(7));\r
 452          write(chr(7));\r
 453          i:= entier(random*10);\r
 454          call hold(10+i);\r
 455          i:=1;\r
 456          (* dojazd do pierwszego przystanku *)\r
 457          while ws.y>przystan(i).ws.y\r
 458          do\r
 459              call auto(kolor,ws.x,ws.y,wolnych_miejsc);\r
 460              call auto(0 ,ws.x,ws.y,wolnych_miejsc);\r
 461              ws.y := ws.y-2;\r
 462  \r
 463          od;\r
 464  \r
 465          do  (* petla w ktorej pracuje autobus *)\r
 466  \r
 467            ws.y:=przystan(i).ws.y;\r
 468            ws.i:=i;\r
 469            if i <= ilosc_przystankow div 2\r
 470            then\r
 471                kier:=1; ws.x := 480 else kier := -1; ws.x :=420;\r
 472            fi;\r
 473  \r
 474            call auto(kolor,ws.x+kier*10,ws.y,wolnych_miejsc);\r
 475  \r
 476            (* autobus jest na przystanku *)\r
 477            praz:=false;\r
 478            wolnych_miejsc:=wolnych_miejsc + dokad(i);\r
 479            (*  z autobusu wysiadlo dokad(i) pasazerow *)\r
 480            call auto(kolor,ws.x+kier*10,ws.y,wolnych_miejsc);\r
 481  \r
 482            call hold(2);\r
 483  \r
 484            (*** teraz pasazerowie wsiadaja ***)\r
 485            while (wolnych_miejsc > 0) and (not przystan(i).kolejka.empty)\r
 486            do\r
 487                 wsiadajacy:=przystan(i).kolejka.first;\r
 488                 dokad(wsiadajacy.dokad) := dokad(wsiadajacy.dokad) +1;\r
 489                 call usun(przystan(i).ws.x,przystan(i).ws.y,\r
 490                        kier*przystan(i).kolejka.cardinal);\r
 491                 call przystan(i).kolejka.out_first;\r
 492                 wolnych_miejsc:=wolnych_miejsc - 1;\r
 493  \r
 494                 call auto(0,ws.x+kier*10,ws.y,wolnych_miejsc);\r
 495                 call auto(kolor,ws.x+kier*10,ws.y,wolnych_miejsc);\r
 496  \r
 497                 call run(wsiadajacy);\r
 498                 call run(inf);\r
 499                 kill(wsiadajacy)\r
 500             od;\r
 501  \r
 502            (* autobus rusza z przystanku *)\r
 503             call auto(0,ws.x+kier*10,ws.y,wolnych_miejsc);\r
 504             if i= ilosc_przystankow div 2\r
 505             then\r
 506                 while ws.y> 26\r
 507                 do\r
 508                    call auto(kolor,ws.x,ws.y,wolnych_miejsc);\r
 509                    call hold(2);\r
 510                    call auto(0,ws.x,ws.y,wolnych_miejsc);\r
 511                    ws.y := ws.y-2;\r
 512                 od;\r
 513                 ws.x := 420; (*autobus przeskakuje na druga strone ulicy*)\r
 514                 kier := -1;\r
 515             fi;\r
 516  \r
 517             if i=ilosc_przystankow then\r
 518                 while ws.y< 282\r
 519                 do\r
 520                    call auto(kolor,ws.x,ws.y,wolnych_miejsc);\r
 521                    call hold(2);\r
 522                    call auto(0,ws.x,ws.y,wolnych_miejsc);\r
 523                    ws.y := ws.y+2;\r
 524                 od;\r
 525                 ws.x := 480; (*autobus przeskakuje na druga strone ulicy*)\r
 526                 kier := 1;\r
 527                 i :=0;\r
 528             fi;\r
 529  \r
 530             if i<ilosc_przystankow div 2\r
 531             then\r
 532             while ws.y>przystan(i+1).ws.y\r
 533             do\r
 534                call auto(kolor,ws.x,ws.y,wolnych_miejsc);\r
 535                call hold(2);\r
 536                call auto(0,ws.x,ws.y,wolnych_miejsc);\r
 537                ws.y := ws.y-kier*2;\r
 538             od;\r
 539             else\r
 540  \r
 541             while ws.y< przystan(i+1).ws.y\r
 542             do\r
 543                call auto(kolor,ws.x,ws.y,wolnych_miejsc);\r
 544                call hold(2);\r
 545                call auto(0,ws.x,ws.y,wolnych_miejsc);\r
 546                ws.y := ws.y-kier*2;\r
 547             od;\r
 548             fi;\r
 549  \r
 550          i:=i mod ilosc_przystankow + 1;\r
 551         od\r
 552      end bus;\r
 553  \r
 554      unit pasazer:simprocess class(nr,kolor:integer);\r
 555      var czas_przyjscia,czas_oczekiwania:integer,\r
 556      dokad : integer;\r
 557        begin\r
 558          dokad := 1+entier(random*(ilosc_przystankow-1));\r
 559          czas_przyjscia:=time;\r
 560          call passivate;\r
 561          czas_oczekiwania:=time-czas_przyjscia;\r
 562          przystan(nr).laczny_czas:=przystan(nr).laczny_czas +\r
 563                                    czas_oczekiwania;\r
 564          przystan(nr).sredniczas:=przystan(nr).laczny_czas /\r
 565                                   przystan(nr).total\r
 566        end pasazer;\r
 567  \r
 568  \r
 569      unit przystanek:simprocess class(nr:integer);\r
 570      var k , jak_czesto : integer;\r
 571        var\r
 572          kolejka:FIFO,\r
 573          new_pas:pasazer,\r
 574          ws:wsp,\r
 575          kier,ilosc_pas,total,laczny_czas,czas_do_nast:integer,\r
 576          sredniczas:real;\r
 577        begin\r
 578          kolejka:=new FIFO(pasazer);\r
 579          czas_do_nast:=3;\r
 580          (*to powinno byc zalezne od szybkosci autobusu*)\r
 581          (* i odleglosci miedzy przystankami*)\r
 582  \r
 583          if nr<=ilosc_przystankow div 2 then\r
 584            ws:=new wsp(510,290-podst1-(nr-1)*odstep1,nr)\r
 585          else\r
 586            ws:=new wsp(390,podst2+(nr-ilosc_przystankow div 2-1)*odstep2,nr)\r
 587          fi;\r
 588  \r
 589          if ws.x>450 then\r
 590               call move(ws.x-15,ws.y+10)\r
 591          else\r
 592                call move(ws.x,ws.y+10)\r
 593          fi;\r
 594          call color(15);\r
 595          call wypisz(ws.i);\r
 596          call hold(2);\r
 597          do\r
 598  \r
 599            call hold(20);(* jak_czesto sa losowani pasazerowie *)\r
 600            if nr<= ilosc_przystankow div 2 \r
 601            then kier :=1 else kier :=-1 fi;\r
 602            k:= entier(random*12)+2; (*kolor pasazera*)\r
 603            new_pas:=new pasazer(nr,k);\r
 604            total:=total+1;\r
 605            call kolejka.into(new_pas);\r
 606            call kol(ws.x,ws.y,kier*kolejka.cardinal,k);\r
 607            call schedule(new_pas,time);\r
 608  \r
 609          od;\r
 610        end przystanek;\r
 611  \r
 612  \r
 613  (*------------------------------------------------------------------------*)\r
 614  (*--------------------  PROCEDURY POMOCNICZE  ----------------------------*)\r
 615  (*------------------------------------------------------------------------*)\r
 616  \r
 617    unit ludzik:procedure(x,y,k :integer);\r
 618      begin\r
 619        call color(k);\r
 620        call move(x,y);\r
 621        call draw(x,y+6);\r
 622        call draw(x-2,y+10);\r
 623        call move(x,y+6);\r
 624        call draw(x+2,y+10);\r
 625        call move(x-2,y+2);\r
 626        call draw(x+2,y+2);\r
 627        call move(x-2,y+2);\r
 628        call draw(x-4,y+4);\r
 629        call move(x+2,y+2);\r
 630        call draw(x+4,y+4);\r
 631        call color(15);\r
 632      end;\r
 633  \r
 634  \r
 635    unit usun:procedure(x,y,m:integer);\r
 636      var i:integer;\r
 637      begin\r
 638        if m<=15\r
 639        then\r
 640        call color(0);\r
 641        call ludzik(x+8*m,y,0);\r
 642        call color(15)\r
 643        fi\r
 644      end;\r
 645  \r
 646    unit kol:procedure(x,y,m,k:integer);\r
 647      var i:integer;\r
 648      begin\r
 649       if m<=15\r
 650       then\r
 651        call ludzik(x+8*m,y,k)\r
 652       fi\r
 653      end;\r
 654  \r
 655  \r
 656     unit wypisz : procedure(x:integer);\r
 657         unit CHRTYP :function ( x:integer):string;\r
 658            (* zamiana liczby na tekst *)\r
 659           begin\r
 660           case x\r
 661             when 1 : result:="1";\r
 662             when 2 : result:="2";\r
 663             when 3 : result:="3";\r
 664             when 4 : result:="4";\r
 665             when 5 : result:="5";\r
 666             when 6 : result:="6";\r
 667             when 7 : result:="7";\r
 668             when 8 : result:="8";\r
 669             when 9 : result:="9";\r
 670             when 0 : result:="0"\r
 671          esac\r
 672        end;\r
 673     begin\r
 674  \r
 675         if x<0 then call outstring("ujemna liczba")\r
 676         else\r
 677             call outstring(chrtyp(x div 10));\r
 678             call outstring(chrtyp(x mod 10))\r
 679         fi\r
 680     end wypisz;\r
 681  \r
 682  \r
 683     unit zegar:simprocess class;\r
 684     var i,j:integer;\r
 685     begin\r
 686           call color(4);\r
 687           call ramka(420,310,480,335);\r
 688           call ramka(422,312,478,333);\r
 689           call ramka(421,311,479,334);\r
 690           call color(15);\r
 691           do\r
 692              call color(1);\r
 693              call move(433,320);\r
 694              call wypisz(i);\r
 695              call outstring(":");\r
 696              call wypisz(j);\r
 697              j:=j+1;\r
 698              if j=60 then j:=0;i:=i+1 fi;\r
 699              call hold(1);\r
 700           od\r
 701       end zegar;\r
 702  \r
 703  \r
 704     unit info:simprocess class;\r
 705       var i:integer;\r
 706       begin\r
 707         call color(4);\r
 708         call ramka(0,0,324,140+10*ilosc_przystankow);\r
 709         call ramka(1,1,326,141+10*ilosc_przystankow);\r
 710         call color(15);\r
 711         call move(10,50);\r
 712         call outstring("Max. nb. of persons in the bus:");\r
 713         call outstring("30 os.");\r
 714         call move(10,70);\r
 715         call outstring("Time przejazdu miedzy");\r
 716         call move(10,80);\r
 717         call outstring("przystankami:");\r
 718         call outstring("  3 min.");\r
 719         call move(10,10);\r
 720         call outstring("The time of Simulation:");\r
 721         if czas_sym div 60=/=0\r
 722         then\r
 723           call wypisz(czas_sym div 60);\r
 724           call outstring(" h. ")\r
 725         fi;\r
 726         call wypisz(czas_sym mod 60);\r
 727         call outstring(" min.");\r
 728         call move(10,30);\r
 729         call outstring("Frequency :");\r
 730         call wypisz(czestosc);\r
 731         call outstring(" min.");\r
 732         call move(200,100);\r
 733         call outstring("Avrage   ");\r
 734         call move(200,110);\r
 735         call outstring("waiting-time:");\r
 736         call move(30,100);\r
 737         call outstring("BUS");\r
 738         call move(30,110);\r
 739         call outstring("STOP");\r
 740         call outstring("  ");\r
 741         call move(90,100);\r
 742         call outstring("Number");\r
 743         call move(90,110);\r
 744         call outstring("of persons");\r
 745         call color(4);\r
 746         call ramka(530,5,610,20);\r
 747         call move(535,10);\r
 748         call outstring("Esc - END");\r
 749         call color(15);\r
 750       do\r
 751       if inkey=27 then call run(mainpr) fi;\r
 752       call color(15);\r
 753       for i:=1 to ilosc_przystankow\r
 754       do\r
 755         call move(30,120+i*10);\r
 756         call wypisz(i);\r
 757         call outstring("     ");\r
 758         call move(90,120+i*10);\r
 759         call wypisz(przystan(i).kolejka.cardinal);\r
 760         call outstring("    ");\r
 761         call move(200,120+i*10);\r
 762         call wypisz(entier(przystan(i).sredniczas));\r
 763         call outstring(".");\r
 764         call wypisz(entier(przystan(i).sredniczas*10) mod 10);\r
 765         call outstring(" min.  ")\r
 766       od;\r
 767       call hold(0.5)\r
 768     od\r
 769   end info;\r
 770  \r
 771  \r
 772  \r
 773    unit ramka : procedure(x1,y1,x2,y2:integer);\r
 774    begin\r
 775      call move(x1,y1);\r
 776      call draw(x2,y1);\r
 777      call draw(x2,y2);\r
 778      call draw(x1,y2);\r
 779      call draw(x1,y1)\r
 780    end ramka;\r
 781  \r
 782  \r
 783    unit pr:procedure(x,y,dx,dy:integer);\r
 784    begin\r
 785      call ramka(x-dx div 2,y-dy div 2,x+dx div 2,y+dy div 2)\r
 786    end pr;\r
 787  \r
 788    unit auto:procedure(k,x,y,n:integer);\r
 789    begin (* ilosc miejsc wolnych w aucie *)\r
 790      call color(k);\r
 791      call pr(x,y,8,18);\r
 792      call pr(x,y,10,20);\r
 793      call pr(x,y,10,2);\r
 794      call wypisz(n);   (* ilosc pasazerow w autobusie *)\r
 795    end auto;\r
 796  \r
 797  \r
 798  \r
 799    unit zabij_pas:procedure(i:integer);\r
 800      var p:pasazer;\r
 801      begin\r
 802        while  przystan(i).kolejka.cardinal>0\r
 803        do\r
 804          p:=przystan(i).kolejka.first;\r
 805          call przystan(i).kolejka.out_first;\r
 806          if p.event=/=none then call cancel(p) fi;\r
 807          kill(p)\r
 808        od\r
 809      end zabij_pas;\r
 810  \r
 811    unit wstep:procedure;\r
 812      begin\r
 813         call gron(0);\r
 814         call ramka(230,120,480,220);\r
 815         call ramka(228,118,482,222);\r
 816         call ramka(226,116,484,224);\r
 817         call move(250,140);\r
 818         call outstring(" PROJET  6 ");\r
 819         call move(250,160);\r
 820         call outstring("     BUS  SIMULATION    ");\r
 821         call move(250,180);\r
 822         call outstring("Author: Nguyen  Tuan  Trung");\r
 823         call move(250,200);\r
 824         call outstring(" Warsaw 24 - 05 - 1990");\r
 825         WHILE INKEY=0 DO OD;\r
 826         call groff\r
 827       end wstep;\r
 828  \r
 829    (*-----------  PROGRAM GLOWNY---------------------------------------------*)\r
 830  \r
 831  \r
 832   begin\r
 833       call wstep;\r
 834   do            (* to repeat simulation *)\r
 835  \r
 836        do\r
 837          write("Simulation time = ");\r
 838          readln(czas_sym);\r
 839          if czas_sym > 0\r
 840          then exit\r
 841          else writeln(" The simulation time must be >0 ")\r
 842          fi\r
 843        od;\r
 844        do\r
 845          write("Number of bus-stops (1-20) = ");\r
 846          readln(ilosc_przystankow);\r
 847          if ilosc_przystankow>1 and ilosc_przystankow < 21 then exit\r
 848          else writeln("It must be not bigger than 20!")\r
 849          fi\r
 850        od;\r
 851        do\r
 852          write("Number of buses (>0) = ");\r
 853          readln(ilosc_auto);\r
 854          if ilosc_auto>0 then\r
 855                exit\r
 856          else\r
 857              writeln("Must be bigger than 0 !")\r
 858          fi\r
 859        od;\r
 860        do\r
 861             write("Frequency of buses (>10) = ");\r
 862             readln(czestosc);\r
 863             if czestosc>=10 then exit\r
 864             else\r
 865                  writeln("Must be bigger than 9 !")\r
 866             fi;\r
 867        od;\r
 868  \r
 869        call gron(0);\r
 870        call color(2); (* ta ramka odpowiada jezdni *)\r
 871        call ramka(400,3,502,300);\r
 872        call ramka(399,2,503,301);\r
 873        call ramka(398,1,504,302);\r
 874        call ramka(395,0,507,305);\r
 875        call color(15);\r
 876        odstep1:=290 div (ilosc_przystankow div 2 + 1);\r
 877        podst1:=(290- (ilosc_przystankow div 2-1)*odstep1) div 2;\r
 878        odstep2:=290 div (ilosc_przystankow -\r
 879                          ilosc_przystankow div 2 + 1);\r
 880        podst2:=(290- (ilosc_przystankow-\r
 881                       ilosc_przystankow div 2-1)*odstep2) div 2;\r
 882  \r
 883        for i:=1 to 7\r
 884        do\r
 885          (* rysowanie pasa srodkowego jezdni *)\r
 886           call color(14);\r
 887           call ramka(448,300-i*40,452,320-i*40);\r
 888           call ramka(449,300-i*40,451,320-i*40);\r
 889           call ramka(450,300-i*40,450,320-i*40);\r
 890           call color(15);\r
 891        od;\r
 892  \r
 893  \r
 894        array przystan dim(1:ilosc_przystankow);\r
 895        for i:=1 to ilosc_przystankow\r
 896        do\r
 897          przystan(i):=new przystanek(i);\r
 898          call schedule(przystan(i),time)\r
 899        od;\r
 900        array autobusy dim(1:ilosc_auto);\r
 901        for i:=1 to ilosc_auto\r
 902        do\r
 903          j:= entier(random*5)+2; (*kolor autobusu*)\r
 904          autobusy(i):=new bus(j) ;\r
 905          call schedule(autobusy(i),time+(i-1)*czestosc+0.6)\r
 906        od;\r
 907        cl:=new zegar;\r
 908        call schedule(cl,time);\r
 909        inf:=new info;\r
 910        call schedule(inf,time+0.5);\r
 911        call hold(czas_sym+0.7);\r
 912  \r
 913        (* dlaczgo to mi sie  wykonuje tak rzadko ????? *)\r
 914  \r
 915         call ramka(520,290,620,345);\r
 916         call ramka(521,291,619,344);\r
 917         call move(530,300);\r
 918  \r
 919         call outstring("TIME IS OUT");\r
 920         call move(530,320);\r
 921         call outstring("GO ON(y/n)?");\r
 922         i:=inkey;\r
 923         while i=0 do i:=inkey od;\r
 924         if (i=ord('y'))\r
 925         then\r
 926  \r
 927            call move(530,320);\r
 928            call outstring("add:       ");\r
 929            call move(565,320);\r
 930            jj:=0;\r
 931            for p:=1 to 2\r
 932            do\r
 933               i:=inkey;\r
 934               while ( not( i>=ord('0') and i<=ord('9')) and i=0)\r
 935               do i:= inkey od;\r
 936               call hascii(i);\r
 937               jj := 10*jj+ (i-ord('0'));\r
 938            od;\r
 939            czas := czas+jj;\r
 940            call outstring(" min");\r
 941          fi; (******************************????*)\r
 942          for j:=1 to 2000 do od;\r
 943          call color(0);\r
 944          call ramka(520,290,620,345);\r
 945          call ramka(521,291,619,344);\r
 946  \r
 947          call move(530,300);\r
 948          call outstring("              ");\r
 949          call move(530,320);\r
 950          call outstring("              ");\r
 951  \r
 952          czas_sym:=czas_sym+czas;\r
 953          call color(15);\r
 954          call move(10,10);\r
 955          call outstring("                              ");\r
 956          call move(10,10);\r
 957          call outstring("Czas symulacji:");\r
 958          if czas_sym div 60<>0\r
 959          then\r
 960               call wypisz(czas_sym div 60);\r
 961               call outstring(" godz. ")\r
 962          fi;\r
 963          if czas_sym mod 60 <>0 then\r
 964              call wypisz(czas_sym mod 60);\r
 965              call outstring(" min.");\r
 966          fi;\r
 967          call hold(czas);\r
 968  \r
 969  \r
 970         for i:=1 to ilosc_auto\r
 971         do\r
 972             call cancel(autobusy(i));\r
 973             kill (autobusy(i))\r
 974         od;\r
 975         for i:=1 to ilosc_przystankow\r
 976         do\r
 977             call zabij_pas(i);\r
 978             call cancel(przystan(i));\r
 979             kill (przystan(i))\r
 980         od;\r
 981         kill (autobusy);\r
 982         kill (przystan);\r
 983         call cancel(cl);\r
 984         kill (cl);\r
 985         call cancel(inf);\r
 986         kill (inf);\r
 987         call groff;\r
 988         write("Do you like to repeat the simulation process (y/n) ?");\r
 989         read(c);\r
 990         if c<> 'y' then exit fi ;\r
 991       OD;\r
 992     end\r
 993   end\r
 994 end.\r