examples/simulati/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        zaj : zajezdnia,\r
 409        przystan:arrayof przystanek,\r
 410        inf:info,cl:zegar,\r
 411        ws:integer,\r
 412        c:char,\r
 413        praz, booo: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(nr,kolor:integer);\r
 439      (* nr = numer autobusu *)\r
 440     var  i,j,kier,\r
 441           wolnych_miejsc : integer,\r
 442           dokad : arrayof integer,\r
 443           ws : wsp,\r
 444           wsiadajacy:pasazer;\r
 445     begin\r
 446          array dokad dim (1: ilosc_przystankow);\r
 447          wolnych_miejsc := pojemnosc;\r
 448          praz := true;\r
 449  \r
 450          ws := new wsp(480,282,1);\r
 451          call auto(kolor,ws.x,ws.y,wolnych_miejsc);\r
 452          write(chr(7));\r
 453          write(chr(7));\r
 454          i:= entier(random*10);\r
 455          call hold(10+i);\r
 456          i:=1;\r
 457          (* dojazd do pierwszego przystanku *)\r
 458  \r
 459          while ws.y>przystan(i).ws.y\r
 460          do\r
 461              call auto(kolor,ws.x,ws.y,wolnych_miejsc);\r
 462              if nr<> 1 then call hold(nr*2) fi;\r
 463              call auto(0 ,ws.x,ws.y,wolnych_miejsc);\r
 464              ws.y := ws.y-2;\r
 465          od;\r
 466  \r
 467          do  (* petla w ktorej pracuje autobus *)\r
 468  \r
 469            ws.y:=przystan(i).ws.y;\r
 470            ws.i:=i;\r
 471            if i <= ilosc_przystankow div 2\r
 472            then\r
 473                kier:=1; ws.x := 480 else kier := -1; ws.x :=420;\r
 474            fi;\r
 475  \r
 476            call auto(kolor,ws.x+kier*10,ws.y,wolnych_miejsc);\r
 477  \r
 478            (* autobus jest na przystanku *)\r
 479            praz:=false;\r
 480            wolnych_miejsc:=wolnych_miejsc + dokad(i);\r
 481            (*  z autobusu wysiadlo dokad(i) pasazerow *)\r
 482            call auto(kolor,ws.x+kier*10,ws.y,wolnych_miejsc);\r
 483  \r
 484            call hold(2);\r
 485  \r
 486            (*** teraz pasazerowie wsiadaja ***)\r
 487            while (wolnych_miejsc > 0) and (not przystan(i).kolejka.empty)\r
 488            do\r
 489                 wsiadajacy:=przystan(i).kolejka.first;\r
 490                 dokad(wsiadajacy.dokad) := dokad(wsiadajacy.dokad) +1;\r
 491                 call usun(przystan(i).ws.x,przystan(i).ws.y,\r
 492                        kier*przystan(i).kolejka.cardinal);\r
 493                 call przystan(i).kolejka.out_first;\r
 494                 wolnych_miejsc:=wolnych_miejsc - 1;\r
 495  \r
 496                 call auto(0,ws.x+kier*10,ws.y,wolnych_miejsc);\r
 497                 call auto(kolor,ws.x+kier*10,ws.y,wolnych_miejsc);\r
 498  \r
 499                 call run(wsiadajacy);\r
 500                 call run(inf);\r
 501                 kill(wsiadajacy)\r
 502             od;\r
 503  \r
 504            (* autobus rusza z przystanku *)\r
 505             call auto(0,ws.x+kier*10,ws.y,wolnych_miejsc);\r
 506             if i= ilosc_przystankow div 2\r
 507             then\r
 508                 while ws.y> 26\r
 509                 do\r
 510                    call auto(kolor,ws.x,ws.y,wolnych_miejsc);\r
 511                    call hold(2);\r
 512                    call auto(0,ws.x,ws.y,wolnych_miejsc);\r
 513                    ws.y := ws.y-2;\r
 514                 od;\r
 515                 ws.x := 420; (*autobus przeskakuje na druga strone ulicy*)\r
 516                 kier := -1;\r
 517             fi;\r
 518  \r
 519             if i=ilosc_przystankow then\r
 520                 while ws.y< 282\r
 521                 do\r
 522                    call auto(kolor,ws.x,ws.y,wolnych_miejsc);\r
 523                    call hold(2);\r
 524                    call auto(0,ws.x,ws.y,wolnych_miejsc);\r
 525                    ws.y := ws.y+2;\r
 526                 od;\r
 527                 ws.x := 480; (*autobus przeskakuje na druga strone ulicy*)\r
 528                 kier := 1;\r
 529                 i :=0;\r
 530             fi;\r
 531  \r
 532             if i<ilosc_przystankow div 2\r
 533             then\r
 534                while ws.y>przystan(i+1).ws.y\r
 535                do\r
 536                   call auto(kolor,ws.x,ws.y,wolnych_miejsc);\r
 537                   call hold(2);\r
 538                   call auto(0,ws.x,ws.y,wolnych_miejsc);\r
 539                   ws.y := ws.y-kier*2;\r
 540                od;\r
 541             else\r
 542                while ws.y< przystan(i+1).ws.y\r
 543                do\r
 544                   call auto(kolor,ws.x,ws.y,wolnych_miejsc);\r
 545                   call hold(2);\r
 546                   call auto(0,ws.x,ws.y,wolnych_miejsc);\r
 547                   ws.y := ws.y-kier*2;\r
 548                od;\r
 549             fi;\r
 550  \r
 551             i:=i mod ilosc_przystankow + 1;\r
 552         od\r
 553      end bus;\r
 554  \r
 555      unit pasazer:simprocess class(nr,kolor:integer);\r
 556      var  czas_przyjscia,czas_oczekiwania:integer,\r
 557           dokad : integer;\r
 558      begin\r
 559          dokad := 1+entier(random*(ilosc_przystankow-1));\r
 560          czas_przyjscia:=time;\r
 561          call passivate;\r
 562          czas_oczekiwania:=time-czas_przyjscia;\r
 563          przystan(nr).laczny_czas:=przystan(nr).laczny_czas +\r
 564                                    czas_oczekiwania;\r
 565          przystan(nr).sredniczas:=przystan(nr).laczny_czas /\r
 566                                   przystan(nr).total\r
 567      end pasazer;\r
 568  \r
 569      unit zajezdnia : simprocess class(ilosc,czestosc : integer) ;\r
 570      var autobus : bus, i,j : integer;\r
 571      begin\r
 572        for i:=1 to ilosc\r
 573        do\r
 574           j:= entier(random*5)+2; (*kolor autobusu i= numer autobusu*)\r
 575           autobus := new bus(i,j) ;\r
 576           call schedule(autobus,time+2);\r
 577           call HOLD(czestosc*i);\r
 578        od;\r
 579      end zajezdnia;\r
 580  \r
 581      unit przystanek : simprocess class(nr:integer);\r
 582      var  k, jak_czesto : integer,\r
 583           kolejka : FIFO,\r
 584           new_pas : pasazer,\r
 585           ws:wsp,\r
 586           kier,ilosc_pas,total,laczny_czas,czas_do_nast:integer,\r
 587           sredniczas : real;\r
 588      begin\r
 589          kolejka := new FIFO(pasazer);\r
 590          czas_do_nast:=3;\r
 591          (*to powinno byc zalezne od szybkosci autobusu*)\r
 592          (* i odleglosci miedzy przystankami*)\r
 593  \r
 594          if nr<=ilosc_przystankow div 2 then\r
 595              ws := new wsp(510,290-podst1-(nr-1)*odstep1,nr)\r
 596          else\r
 597              ws := new wsp(390,podst2+(nr-ilosc_przystankow div 2-1)*odstep2,nr)\r
 598          fi;\r
 599  \r
 600          if ws.x>450 then\r
 601               call move(ws.x-15,ws.y+10)\r
 602          else\r
 603                call move(ws.x,ws.y+10)\r
 604          fi;\r
 605          call color(15);\r
 606          call wypisz(ws.i);\r
 607          call hold(2);\r
 608          (* generowanie pasazerow *)\r
 609          do\r
 610            (* jak_czesto sa losowani pasazerowie *)\r
 611            if nr<= (ilosc_przystankow div 2)\r
 612            then\r
 613               kier := 1 else kier := -1\r
 614            fi;\r
 615            k:= entier(random*12)+2; (*kolor pasazera*)\r
 616            new_pas:=new pasazer(nr,k);\r
 617            total:=total+1;\r
 618            call kolejka.into(new_pas);\r
 619            call kol(ws.x,ws.y,kier*kolejka.cardinal,k);\r
 620            call schedule(new_pas,time);\r
 621            call hold(entier(random*10)+10);\r
 622          od;\r
 623        end przystanek;\r
 624  \r
 625  \r
 626  (*------------------------------------------------------------------------*)\r
 627  (*--------------------  PROCEDURY POMOCNICZE  ----------------------------*)\r
 628  (*------------------------------------------------------------------------*)\r
 629  \r
 630    unit ludzik:procedure(x,y,k :integer);\r
 631      begin\r
 632        call color(k);\r
 633        call move(x,y);\r
 634        call draw(x,y+6);\r
 635        call draw(x-2,y+10);\r
 636        call move(x,y+6);\r
 637        call draw(x+2,y+10);\r
 638        call move(x-2,y+2);\r
 639        call draw(x+2,y+2);\r
 640        call move(x-2,y+2);\r
 641        call draw(x-4,y+4);\r
 642        call move(x+2,y+2);\r
 643        call draw(x+4,y+4);\r
 644        call color(15);\r
 645      end;\r
 646  \r
 647  \r
 648    unit usun:procedure(x,y,m:integer);\r
 649      var i:integer;\r
 650      begin\r
 651        if m<=15\r
 652        then\r
 653        call color(0);\r
 654        call ludzik(x+8*m,y,0);\r
 655        call color(15)\r
 656        fi\r
 657      end;\r
 658  \r
 659    unit kol:procedure(x,y,m,k:integer);\r
 660      var i:integer;\r
 661      begin\r
 662       if m<=15\r
 663       then\r
 664        call ludzik(x+8*m,y,k)\r
 665       fi\r
 666      end;\r
 667  \r
 668  \r
 669     unit wypisz : procedure(x:integer);\r
 670         unit CHRTYP :function ( x:integer):string;\r
 671            (* zamiana liczby na tekst *)\r
 672           begin\r
 673           case x\r
 674             when 1 : result:="1";\r
 675             when 2 : result:="2";\r
 676             when 3 : result:="3";\r
 677             when 4 : result:="4";\r
 678             when 5 : result:="5";\r
 679             when 6 : result:="6";\r
 680             when 7 : result:="7";\r
 681             when 8 : result:="8";\r
 682             when 9 : result:="9";\r
 683             when 0 : result:="0"\r
 684          esac\r
 685        end;\r
 686     begin\r
 687  \r
 688         if x<0 then call outstring("ujemna liczba")\r
 689         else\r
 690             call outstring(chrtyp(x div 10));\r
 691             call outstring(chrtyp(x mod 10))\r
 692         fi\r
 693     end wypisz;\r
 694  \r
 695  \r
 696     unit zegar:simprocess class;\r
 697     var i,j:integer;\r
 698     begin\r
 699           call color(4);\r
 700           call ramka(420,310,480,335);\r
 701           call ramka(422,312,478,333);\r
 702           call ramka(421,311,479,334);\r
 703           call color(15);\r
 704           do\r
 705              call color(1);\r
 706              call move(433,320);\r
 707              call wypisz(i);\r
 708              call outstring(":");\r
 709              call wypisz(j);\r
 710              j:=j+1;\r
 711              if j=60 then j:=0;i:=i+1 fi;\r
 712              call hold(1);\r
 713           od\r
 714       end zegar;\r
 715  \r
 716  \r
 717     unit info:simprocess class;\r
 718       var i:integer;\r
 719       begin\r
 720         call color(4);\r
 721         call ramka(0,0,324,140+10*ilosc_przystankow);\r
 722         call ramka(1,1,326,141+10*ilosc_przystankow);\r
 723         call color(15);\r
 724         call move(10,50);\r
 725         call outstring("Max. nb. of persons in the bus:");\r
 726         call outstring("30 os.");\r
 727         call move(10,70);\r
 728         call outstring("Time przejazdu miedzy");\r
 729         call move(10,80);\r
 730         call outstring("przystankami:");\r
 731         call outstring("  3 min.");\r
 732         call move(10,10);\r
 733         call outstring("The time of Simulation:");\r
 734         if czas_sym div 60=/=0\r
 735         then\r
 736           call wypisz(czas_sym div 60);\r
 737           call outstring(" h. ")\r
 738         fi;\r
 739         call wypisz(czas_sym mod 60);\r
 740         call outstring(" min.");\r
 741         call move(10,30);\r
 742         call outstring("Frequency :");\r
 743         call wypisz(czestosc);\r
 744         call outstring(" min.");\r
 745         call move(200,100);\r
 746         call outstring("Avrage   ");\r
 747         call move(200,110);\r
 748         call outstring("waiting-time:");\r
 749         call move(30,100);\r
 750         call outstring("BUS");\r
 751         call move(30,110);\r
 752         call outstring("STOP");\r
 753         call outstring("  ");\r
 754         call move(90,100);\r
 755         call outstring("Number");\r
 756         call move(90,110);\r
 757         call outstring("of persons");\r
 758         call color(4);\r
 759         call ramka(530,5,610,20);\r
 760         call move(535,10);\r
 761         call outstring("Esc - END");\r
 762         call color(15);\r
 763       do\r
 764       if inkey=27 then call run(mainpr) fi;\r
 765       call color(15);\r
 766       for i:=1 to ilosc_przystankow\r
 767       do\r
 768         call move(30,120+i*10);\r
 769         call wypisz(i);\r
 770         call outstring("     ");\r
 771         call move(90,120+i*10);\r
 772         call wypisz(przystan(i).kolejka.cardinal);\r
 773         call outstring("    ");\r
 774         call move(200,120+i*10);\r
 775         call wypisz(entier(przystan(i).sredniczas));\r
 776         call outstring(".");\r
 777         call wypisz(entier(przystan(i).sredniczas*10) mod 10);\r
 778         call outstring(" min.  ")\r
 779       od;\r
 780       call hold(0.5)\r
 781     od\r
 782   end info;\r
 783  \r
 784  \r
 785  \r
 786    unit ramka : procedure(x1,y1,x2,y2:integer);\r
 787    begin\r
 788      call move(x1,y1);\r
 789      call draw(x2,y1);\r
 790      call draw(x2,y2);\r
 791      call draw(x1,y2);\r
 792      call draw(x1,y1)\r
 793    end ramka;\r
 794  \r
 795  \r
 796    unit pr:procedure(x,y,dx,dy:integer);\r
 797    begin\r
 798      call ramka(x-dx div 2,y-dy div 2,x+dx div 2,y+dy div 2)\r
 799    end pr;\r
 800  \r
 801    unit auto:procedure(k,x,y,n:integer);\r
 802    begin (* ilosc miejsc wolnych w aucie *)\r
 803      call color(k);\r
 804      call pr(x,y,8,18);\r
 805      call pr(x,y,10,20);\r
 806      call pr(x,y,10,2);\r
 807      call wypisz(n);   (* ilosc pasazerow w autobusie *)\r
 808    end auto;\r
 809  \r
 810  \r
 811  \r
 812    unit zabij_pas:procedure(i:integer);\r
 813      var p:pasazer;\r
 814      begin\r
 815        while  przystan(i).kolejka.cardinal>0\r
 816        do\r
 817          p:=przystan(i).kolejka.first;\r
 818          call przystan(i).kolejka.out_first;\r
 819          if p.event=/=none then call cancel(p) fi;\r
 820          kill(p)\r
 821        od\r
 822      end zabij_pas;\r
 823  \r
 824      unit wstep:procedure;\r
 825      begin\r
 826         call gron(0);\r
 827         call ramka(230,120,480,220);\r
 828         call ramka(228,118,482,222);\r
 829         call ramka(226,116,484,224);\r
 830         call move(250,140);\r
 831         call outstring(" PROJET  6 ");\r
 832         call move(250,160);\r
 833         call outstring("     BUS  SIMULATION    ");\r
 834         call move(250,180);\r
 835         call outstring("Author: Nguyen  Tuan  Trung");\r
 836         call move(250,200);\r
 837         call outstring(" Warsaw 24 - 05 - 1990");\r
 838         WHILE INKEY=0 DO OD;\r
 839         call groff\r
 840      end wstep;\r
 841  \r
 842      unit  Jezdnia : procedure;\r
 843      var i : integer;\r
 844      begin\r
 845        for i:=1 to 7\r
 846        do\r
 847          (* rysowanie pasa srodkowego jezdni *)\r
 848           call color(14);\r
 849           call ramka(448,300-i*40,452,320-i*40);\r
 850           call ramka(449,300-i*40,451,320-i*40);\r
 851           call ramka(450,300-i*40,450,320-i*40);\r
 852           call color(15);\r
 853        od;\r
 854      end Jezdnia;\r
 855  \r
 856    (*-----------  PROGRAM GLOWNY---------------------------------------------*)\r
 857  \r
 858  \r
 859   begin\r
 860      call wstep; booo:= true;\r
 861      DO            (* to repeat simulation *)\r
 862  \r
 863        do\r
 864          write("Simulation time = ");\r
 865          readln(czas_sym);\r
 866          if czas_sym > 0\r
 867          then exit\r
 868          else writeln(" The simulation time must be >0 ")\r
 869          fi\r
 870        od;\r
 871        do\r
 872          write("Number of bus-stops (1-10) = ");\r
 873          readln(ilosc_przystankow);\r
 874          if ilosc_przystankow>1 and ilosc_przystankow < 11 then exit\r
 875          else writeln("It must be not bigger than 10!")\r
 876          fi\r
 877        od;\r
 878        do\r
 879          write("Number of buses (>0) = ");\r
 880          readln(ilosc_auto);\r
 881          if ilosc_auto>0 then\r
 882                exit\r
 883          else\r
 884              writeln("Must be bigger than 0 !")\r
 885          fi\r
 886        od;\r
 887        do\r
 888             write("Frequency of buses (>10) = ");\r
 889             readln(czestosc);\r
 890             if czestosc>=10 then exit\r
 891             else\r
 892                  writeln("Must be bigger than 9 !")\r
 893             fi;\r
 894        od;\r
 895  \r
 896        call gron(0);\r
 897        call color(2); (* ta ramka odpowiada jezdni *)\r
 898        call ramka(400,3,502,300);\r
 899        call ramka(399,2,503,301);\r
 900        call ramka(398,1,504,302);\r
 901        call ramka(395,0,507,305);\r
 902        call color(15);\r
 903        odstep1:=290 div (ilosc_przystankow div 2 + 1);\r
 904        podst1:=(290- (ilosc_przystankow div 2-1)*odstep1) div 2;\r
 905        odstep2:=290 div (ilosc_przystankow -\r
 906                          ilosc_przystankow div 2 + 1);\r
 907        podst2:=(290- (ilosc_przystankow-\r
 908                       ilosc_przystankow div 2-1)*odstep2) div 2;\r
 909        call jezdnia;\r
 910  \r
 911 (*_____________________________________________________________*)\r
 912  \r
 913        array przystan dim(1:ilosc_przystankow);\r
 914        for i:=1 to ilosc_przystankow\r
 915        do\r
 916          przystan(i):=new przystanek(i);\r
 917          call schedule(przystan(i),time)\r
 918        od;\r
 919  \r
 920        cl:=new zegar;\r
 921        call schedule(cl,time);\r
 922        inf:=new info;\r
 923        call schedule(inf,time+0.5);\r
 924  \r
 925        zaj := new zajezdnia(ilosc_auto,czestosc);\r
 926        call schedule(zaj, time);\r
 927  \r
 928        WHILE BOOO  DO\r
 929            call hold(czas_sym+0.7);\r
 930            (* program glowny czeka az sie skonczy czas symulacji *)\r
 931  \r
 932            call ramka(520,290,620,345);\r
 933            call ramka(521,291,619,344);\r
 934            call move(530,300);\r
 935  \r
 936            call outstring("TIME IS OUT");\r
 937            call move(530,320);\r
 938            call outstring("GO ON(y/n)?");\r
 939            i:=inkey;\r
 940            while i=0 do i:=inkey od;\r
 941            if (i=ord('y'))\r
 942            then\r
 943                 booo := true;\r
 944                 call move(530,320);\r
 945                 call outstring("add:       ");\r
 946                 call move(565,320);\r
 947                 jj:=0;\r
 948                 for p:=1 to 2\r
 949                 do\r
 950                     i:=inkey;\r
 951                     while ( not( i>=ord('0') and i<=ord('9')) and i=0)\r
 952                     do i:= inkey od;\r
 953                     call hascii(i);\r
 954                     jj := 10*jj+ (i-ord('0'));\r
 955                 od;\r
 956                 czas := czas+jj;\r
 957                 call outstring(" min");\r
 958  \r
 959                for j:=1 to 2000 do od;\r
 960                call color(0);\r
 961                call ramka(520,290,620,345);\r
 962                call ramka(521,291,619,344);\r
 963  \r
 964                call move(530,300);\r
 965                call outstring("              ");\r
 966                call move(530,320);\r
 967                call outstring("              ");\r
 968  \r
 969                czas_sym:=czas_sym+czas;\r
 970                call color(15);\r
 971                call move(10,10);\r
 972                call outstring("                              ");\r
 973                call move(10,10);\r
 974                call outstring("Czas symulacji:");\r
 975                if czas_sym div 60<>0\r
 976                then\r
 977                    call wypisz(czas_sym div 60);\r
 978                    call outstring(" godz. ")\r
 979                fi;\r
 980                if czas_sym mod 60 <>0 then\r
 981                   call wypisz(czas_sym mod 60);\r
 982                   call outstring(" min.");\r
 983                fi;\r
 984            else\r
 985                booo := false; (* nie przedluzam *)\r
 986            fi; (*******************************)\r
 987  \r
 988          OD (* WHILE BOOO *);\r
 989  \r
 990 (*___________________________________________________________________*)\r
 991 (* usuwanie obiektow stworzonych przez symulacje                     *)\r
 992 (*___________________________________________________________________*)\r
 993  \r
 994         for i:=1 to ilosc_przystankow\r
 995         do\r
 996             call zabij_pas(i);\r
 997             call cancel(przystan(i));\r
 998             kill (przystan(i))\r
 999         od;\r
1000  \r
1001         kill (zaj);\r
1002         kill (przystan);\r
1003         call cancel(cl);\r
1004         kill (cl);\r
1005         call cancel(inf);\r
1006         kill (inf);\r
1007         call groff;\r
1008  \r
1009         write("Do you like to repeat the simulation process (y/n) ?");\r
1010         (* uwaga!! autobusy nie zostaly usuniete !!   *)\r
1011  \r
1012         read(c);\r
1013         if c<> 'y' then exit fi ;\r
1014       OD;\r
1015     end\r
1016   end\r
1017 end.\r