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