examples/ulica.log

   1 block\r
   2 (*_______________________________________________________*)\r
   3 (*        SYMULACJA     RUCHU      ULICZNEGO             *)\r
   4 (*_______________________________________________________*)\r
   5  \r
   6 (* simulation class *)\r
   7  \r
   8  unit fifo:class;\r
   9    (* the type implementing fifo - queues *)\r
  10    hidden front, rear;\r
  11    signal fifoempty;\r
  12    var front, rear:fifoel;\r
  13  \r
  14  \r
  15    unit fifoel : class;\r
  16      var succ:fifoel;\r
  17  \r
  18      unit into:procedure(q:fifo);\r
  19        begin\r
  20          if q.front = none then\r
  21            q.front,q.rear := this fifoel\r
  22          else q.rear.succ, q.rear :=this fifoel\r
  23          fi\r
  24      end into;\r
  25  \r
  26    end fifoel;\r
  27  \r
  28  \r
  29  \r
  30    unit outfirst:procedure;\r
  31      begin\r
  32        if front = none then raise fifoempty\r
  33        else\r
  34          if rear = front then rear,front := none\r
  35          else front:=front.succ\r
  36          fi\r
  37        fi\r
  38    end outfirst;\r
  39  \r
  40  \r
  41  \r
  42    unit empty:function:boolean;\r
  43      begin\r
  44        result := front=none\r
  45    end empty;\r
  46  \r
  47  \r
  48  \r
  49    unit first:function:fifoel;\r
  50      begin\r
  51        result := front\r
  52    end first;\r
  53  \r
  54  \r
  55  \r
  56    unit cardinal:function:integer;\r
  57      var   i:integer,\r
  58          aux:fifoel;\r
  59      begin\r
  60        aux := front;\r
  61        while aux =/= none do\r
  62          i:=i+1;\r
  63          aux:=aux.succ\r
  64        od;\r
  65        result := i\r
  66    end cardinal;\r
  67  \r
  68  end fifo;\r
  69  \r
  70  \r
  71  \r
  72  unit priorityqueue: fifo class;\r
  73   (* heap as binary linked tree with father link*)\r
  74    hidden node;\r
  75  \r
  76    unit queuehead: class;\r
  77       (* heap accessing module *)\r
  78      hidden last, root;\r
  79      var last,root:node;\r
  80  \r
  81      unit min: function: elem;\r
  82        begin\r
  83          if root=/= none then result:=root.el fi;\r
  84      end min;\r
  85  \r
  86      unit insert: procedure(r:elem);\r
  87        (* insertion into heap *)\r
  88        var x,z:node;\r
  89        begin\r
  90          x:= r.lab;\r
  91          if last = none then\r
  92            root:=x;\r
  93            root.left,root.right,last:=root\r
  94          else\r
  95            if last.ns = 0 then\r
  96              last.ns:=1;\r
  97              z:= last.left;\r
  98              last.left:=x;\r
  99              x.up:= last;\r
 100              x.left:= z; z.right:=x\r
 101            else\r
 102              last.ns:=2;\r
 103              z:= last.right;\r
 104              last.right:=x;\r
 105              x.right:=z;\r
 106              x.up:= last;\r
 107              z.left:=x;\r
 108              last.left.right:=x;\r
 109              x.left:=last.left;\r
 110              last:= z;\r
 111            fi;\r
 112          fi;\r
 113          call correct(r,false);\r
 114      end insert;\r
 115  \r
 116  \r
 117  \r
 118      unit delete: procedure(r: elem);\r
 119        var x,y,z:node;\r
 120        begin\r
 121          x:=r.lab;\r
 122          if x=root and root.ns=0 then\r
 123            root,last:= none\r
 124          else\r
 125            z:=last.left;\r
 126            if last.ns =0 then\r
 127              y:= z.up;\r
 128              y.right:= last;\r
 129              last.left:=y;\r
 130              last:=y;\r
 131            else\r
 132              y:= z.left;\r
 133              y.right:= last;\r
 134              last.left:= y;\r
 135            fi;\r
 136            z.el.lab:=x;\r
 137            x.el:= z.el;\r
 138            last.ns:= last.ns-1;\r
 139            r.lab:=z;\r
 140            z.el:=r;\r
 141            if x.less(x.up) then\r
 142              call correct(x.el,false)\r
 143            else\r
 144              call correct(x.el,true)\r
 145            fi;\r
 146          fi;\r
 147      end delete;\r
 148  \r
 149  \r
 150      unit correct: procedure(r:elem,down:boolean);\r
 151             (* correction of the heap with structure broken by r *)\r
 152        var x,z:node,t:elem,fin,log:boolean;\r
 153        begin\r
 154          z:=r.lab;\r
 155          if down then\r
 156            while not fin do\r
 157              if z.ns =0 then\r
 158                fin:=true\r
 159              else\r
 160                if z.ns=1 then\r
 161                  x:=z.left\r
 162                else\r
 163                  if z.left.less(z.right) then\r
 164                    x:=z.left\r
 165                   else x:=z.right\r
 166                  fi\r
 167                fi;\r
 168                if z.less(x) then\r
 169                  fin:=true\r
 170                else\r
 171                  t:=x.el;\r
 172                  x.el:=z.el;\r
 173                  z.el:=t;\r
 174                  z.el.lab:=z;\r
 175                  x.el.lab:=x\r
 176                fi\r
 177              fi;\r
 178              z:=x;\r
 179            od\r
 180          else\r
 181            x:=z.up;\r
 182            if x=none then log:=true else log:=x.less(z); fi;\r
 183            while not log do\r
 184              t:=z.el;\r
 185              z.el:=x.el;\r
 186              x.el:=t;\r
 187              x.el.lab:=x;\r
 188              z.el.lab:=z;\r
 189              z:=x;\r
 190              x:=z.up;\r
 191              if x=none then log:=true else log:=x.less(z);fi;\r
 192            od;\r
 193          fi;\r
 194      end correct;\r
 195  \r
 196    end queuehead;\r
 197  \r
 198  \r
 199  \r
 200    unit node: class (el:elem);\r
 201        (* element of the heap *)\r
 202      var left,right,up: node, ns:integer;\r
 203      unit less: function(x:node): boolean;\r
 204        begin\r
 205          if x= none then result:=false\r
 206          else result:=el.less(x.el)\r
 207          fi;\r
 208      end less;\r
 209    end node;\r
 210  \r
 211    unit elem: class(prior:real);\r
 212        (* prefix of information to be stored in node *)\r
 213      var lab: node;\r
 214      unit virtual less: function(x:elem):boolean;\r
 215        begin\r
 216          if x=none then result:= false\r
 217          else\r
 218            result:= prior< x.prior\r
 219          fi;\r
 220      end less;\r
 221      begin\r
 222        lab:= new node(this elem);\r
 223    end elem;\r
 224  \r
 225  \r
 226  end priorityqueue;\r
 227 (*______________________________________________________________*)\r
 228  \r
 229  \r
 230  \r
 231  \r
 232  unit simulation: priorityqueue class;\r
 233    (* the language for simulation purposes *)\r
 234    taken queuehead, elem, fifoel;\r
 235    hidden pq, curr, eventnotice, mainprogram, choiceprocess;\r
 236    var curr  : simprocess,  (*active process *)\r
 237        pq    :queuehead,  (* the time axis *)\r
 238        mainpr: mainprogram;\r
 239  \r
 240    unit simprocess:fifoel coroutine;\r
 241          (* user process prefix *)\r
 242      var event,  (* activation moment notice *)\r
 243          eventpom: eventnotice,\r
 244                  (* this is for avoiding many new calls as an result *)\r
 245                  (* of subsequent passivations and activations             *)\r
 246          finish: boolean;\r
 247       signal termproc, idleproc;\r
 248       unit idle: function: boolean;\r
 249         begin\r
 250           result:= event= none;\r
 251       end idle;\r
 252  \r
 253  \r
 254       unit terminated: function :boolean;\r
 255         begin\r
 256           result:= finish;\r
 257       end terminated;\r
 258  \r
 259  \r
 260       unit evtime: function: real;\r
 261            (* time of activation *)\r
 262         begin\r
 263           if idle then raise idleproc  fi;\r
 264           result:= event.eventtime;\r
 265       end evtime;\r
 266       handlers\r
 267                 (* default handlers for signals termproc and idleproc *)\r
 268           when termproc: writeln(" simprocess is terminated ");\r
 269                         attach(mainpr);\r
 270           when idleproc: writeln(" simprocess is idle ");\r
 271                         attach(mainpr);\r
 272       end handlers;\r
 273       begin\r
 274           return;\r
 275           inner;\r
 276           finish:=true;\r
 277           call passivate;\r
 278           raise termproc\r
 279    end simprocess;\r
 280  \r
 281  \r
 282  \r
 283    unit eventnotice: elem class;\r
 284         (* a process activation notice to be placed onto the time axis pq *)\r
 285      var eventtime: real, proc: simprocess;\r
 286      unit virtual less: function(x: eventnotice):boolean;\r
 287                (* overwrite the former version considering eventtime *)\r
 288        begin\r
 289          if x=none then result:= false\r
 290          else\r
 291            result:=eventtime < x.eventtime or\r
 292                    (eventtime=x.eventtime and prior < x.prior);\r
 293          fi;\r
 294      end less;\r
 295    end eventnotice;\r
 296  \r
 297  \r
 298    unit mainprogram: simprocess class;\r
 299       (* implementing master programm as a process *)\r
 300      begin\r
 301        do attach(main) od;\r
 302    end mainprogram;\r
 303  \r
 304  \r
 305    unit time:function:real;\r
 306       (* current value of simulation time *)\r
 307      begin\r
 308        result:=current.evtime\r
 309    end time;\r
 310  \r
 311  \r
 312    unit current: function: simprocess;\r
 313          (* the first process on the time axis *)\r
 314      begin\r
 315        result:=curr;\r
 316    end current;\r
 317  \r
 318     unit schedule: procedure(p:simprocess,t:real);\r
 319        (* activation of process p at time t *)\r
 320      begin\r
 321        if t<time then t:= time fi;\r
 322        if p=current then\r
 323          call hold(t-time)\r
 324        else\r
 325           if p.idle and p.eventpom=none then\r
 326               (* has not been scheduled yet *)\r
 327            p.event,p.eventpom:= new eventnotice(random);\r
 328            p.event.proc:= p;\r
 329          else\r
 330            if p.idle (* p has been scheduled yet *) then\r
 331              p.event:= p.eventpom;\r
 332              p.event.prior:=random;\r
 333            else\r
 334                     (* new scheduling *)\r
 335              p.event.prior:=random;\r
 336              call pq.delete(p.event)\r
 337            fi\r
 338          fi;\r
 339          p.event.eventtime:= t;\r
 340          call pq.insert(p.event);\r
 341        fi;\r
 342    end schedule;\r
 343  \r
 344  \r
 345    unit hold:procedure(t:real);\r
 346        (* move the active process t minutes back along pq *)\r
 347        (* redefine prior                                *)\r
 348      begin\r
 349        call pq.delete(current.event);\r
 350        current.event.prior:=random;\r
 351        if t<0 then t:=0; fi;\r
 352        current.event.eventtime:=time+t;\r
 353        call pq.insert(current.event);\r
 354        call choiceprocess;\r
 355    end hold;\r
 356  \r
 357  \r
 358    unit passivate: procedure;\r
 359         (* remove the actve process from pq and activate the next one *)\r
 360      begin\r
 361        call pq.delete(current.event);\r
 362        current.event:=none;\r
 363        call choiceprocess\r
 364    end passivate;\r
 365  \r
 366  \r
 367    unit run: procedure(p:simprocess);\r
 368         (* activate p immediately and delay former first process   *)\r
 369         (* by redefining prior                                    *)\r
 370      begin\r
 371        current.event.prior:=random;\r
 372        if not p.idle then\r
 373          p.event.prior:=0;\r
 374          p.event.eventtime:=time;\r
 375          call pq.correct(p.event,false)\r
 376        else\r
 377          if p.eventpom=none then\r
 378            p.event,p.eventpom:=new eventnotice(0);\r
 379            p.event.eventtime:=time;\r
 380            p.event.proc:=p;\r
 381            call pq.insert(p.event)\r
 382          else\r
 383            p.event:=p.eventpom;\r
 384            p.event.prior:=0;\r
 385            p.event.eventtime:=time;\r
 386            p.event.proc:=p;\r
 387            call pq.insert(p.event);\r
 388          fi\r
 389         fi;\r
 390        call choiceprocess;\r
 391    end run;\r
 392  \r
 393  \r
 394  \r
 395    unit cancel:procedure(p: simprocess);\r
 396       (* remove process p from pq and continue simulation *)\r
 397      begin\r
 398        if p= current then call passivate\r
 399        else\r
 400          call pq.delete(p.event);\r
 401          p.event:=none;\r
 402        fi;\r
 403    end cancel;\r
 404  \r
 405  \r
 406  \r
 407    unit choiceprocess:procedure;\r
 408        (* choose the first process from pq to be activated *)\r
 409       var p:simprocess;\r
 410      begin\r
 411        p:=curr;\r
 412        if pq.min= none then\r
 413          writeln(" empty queue");\r
 414          mainpr.event:=mainpr.eventpom;\r
 415          mainpr.event.prior:=0;\r
 416          mainpr.event.eventtime:=time;\r
 417          call pq.insert(mainpr.event);\r
 418          curr:=mainpr;\r
 419          attach(mainpr)\r
 420        else\r
 421          curr:=pq.min qua eventnotice.proc;\r
 422          attach(curr)\r
 423        fi;\r
 424    end choiceprocess;\r
 425  \r
 426  \r
 427  \r
 428    begin\r
 429      pq:=new queuehead;  (* simulation time axis*)\r
 430      curr,mainpr:=new mainprogram;\r
 431      mainpr.event,mainpr.eventpom:=new eventnotice(0);\r
 432      mainpr.event.eventtime:=0;\r
 433      mainpr.event.proc:=mainpr;\r
 434      call pq.insert(mainpr.event);\r
 435      (* the first process to be activated is main program *)\r
 436      inner;\r
 437      pq:=none;\r
 438  \r
 439  end simulation;\r
 440  \r
 441 (*______________________________________________________________________*)\r
 442 (*              grafika do symulacji                                    *)\r
 443 (*______________________________________________________________________*)\r
 444  \r
 445  \r
 446 unit graf:iiuwgraph class;    (* clasa graficzna  *)\r
 447 var c:arrayof arrayof integer;\r
 448 var ile :arrayof integer;\r
 449  \r
 450  unit inchar:function:integer;\r
 451  begin\r
 452    while result=0 do\r
 453      result:=inkey;\r
 454    od;\r
 455  end inchar;\r
 456  \r
 457  \r
 458  unit outhline: procedure(a:arrayof char);\r
 459  (* wypisanie w trybie graficznym*)\r
 460    var i,j:integer;\r
 461    begin\r
 462      i:=upper(a);\r
 463      for j:=1 to i do\r
 464        call hascii(0);\r
 465        call hascii(ord(a(j)));\r
 466      od;\r
 467      kill (a);\r
 468  end outhline;\r
 469  \r
 470  \r
 471  \r
 472  unit inhline:function(xc:integer;yc,il:integer):arrayof char;\r
 473    var i,count,ik:integer;\r
 474    var ar:arrayof char;\r
 475    begin\r
 476     call move(xc,yc);\r
 477     count:=0;\r
 478     array ar dim(1:il);\r
 479     while ik=/=13 and count<il do\r
 480       ik:=inchar;\r
 481       if ik=8 and count>0 then\r
 482         ar(count):=' ';\r
 483         count:=count-1;\r
 484         call move(xc+(count)*8,yc);\r
 485         call hascii(0);\r
 486       else\r
 487         if ik=/=13 then\r
 488           count:=count+1;\r
 489           ar(count):=chr(ik);\r
 490           call hascii(0);\r
 491           call hascii(ik);\r
 492         fi;\r
 493       fi;\r
 494     od;\r
 495     if count=/=0 then\r
 496       array result dim(1:count);\r
 497       for i:=1 to count do\r
 498         result(i):=ar(i);\r
 499       od;\r
 500     fi;\r
 501  end inhline;\r
 502  \r
 503  \r
 504  \r
 505 (* funkcja zamiany na liczbe liczby zapisanej znakowo                     *);\r
 506  unit cyfra:function(at:arrayof char):integer;\r
 507    var id,i,j,k:integer;\r
 508    begin\r
 509     j:=1;\r
 510     k:=0;\r
 511     id:=upper(at);\r
 512     for i:=id downto 1 do\r
 513       k:=k+((ord(at(i))-48)*j);\r
 514       j:=j*10;\r
 515     od;\r
 516     result:=k;\r
 517  end cyfra;\r
 518  \r
 519  \r
 520  unit daj:function(a:integer):arrayof char;\r
 521    var ta:arrayof char;\r
 522    var i,j,k,l,m:integer;\r
 523    begin\r
 524      if a>9 then\r
 525        if a>99 then\r
 526          if a>999 then\r
 527            if a>9999 then i:=5;\r
 528            else i:=4; fi;\r
 529          else i:=3; fi;\r
 530        else i:=2; fi;\r
 531      else i:=1; fi;\r
 532      k:=10;\r
 533      l:=1;\r
 534      m:=1;\r
 535      array ta dim(1:i);\r
 536      if i=5 then m:=2;ta(1):=chr((a div 10000)+48); fi;\r
 537      for j:=i downto m do\r
 538        ta(j):=chr(((a mod k) div l)+48);\r
 539        k:=k*10;\r
 540        l:=l*10;\r
 541      od;\r
 542      result:=ta;\r
 543  end daj;\r
 544  \r
 545  unit mapa:procedure; (* rysowanie fragmentu miasta *)\r
 546    begin\r
 547      call cls;          (* czyszczenie ekranu *)\r
 548      call move(9,5);    (* rameczka *)\r
 549      call draw(719,5);\r
 550      call draw(719,333);\r
 551      call draw(9,333);\r
 552      call draw(9,5);\r
 553      call move(590,5);\r
 554      call draw(590,333);\r
 555      call move(589,5);\r
 556      call draw(589,333);\r
 557      call move(9,70);    (* tu juz skrzyzowanie *)\r
 558      call draw(102,70);\r
 559      call draw(102,5);\r
 560      call move(9,69);\r
 561      call draw(103,69);\r
 562      call draw(103,5);\r
 563      call move(124,5);\r
 564      call draw(124,69);\r
 565      call draw(590,69);\r
 566      call move(125,5);\r
 567      call draw(125,70);\r
 568      call draw(590,70);\r
 569      call move(9,107);\r
 570      call draw(103,107);\r
 571      call draw(103,333);\r
 572      call move(9,108);\r
 573      call draw(102,108);\r
 574      call draw(102,333);\r
 575      call move(124,107);\r
 576      call draw(124,204);\r
 577      call draw(331,204);\r
 578      call draw(331,107);\r
 579      call draw(124,107);\r
 580      call move(125,108);\r
 581      call draw(125,203);\r
 582      call draw(330,203);\r
 583      call draw(330,108);\r
 584      call draw(125,108);\r
 585  \r
 586      call move(124,333);   (* "dolny" parking *)\r
 587      call draw(124,226);\r
 588      call draw(221,226);\r
 589      call draw(221,242);\r
 590      call draw(161,242);\r
 591      call draw(161,297);\r
 592      call draw(290,297);\r
 593      call draw(290,242);\r
 594      call draw(230,242);\r
 595      call draw(230,226);\r
 596      call draw(331,226);\r
 597      call draw(331,333);\r
 598  \r
 599      call move(125,333);\r
 600      call draw(125,227);\r
 601      call draw(220,227);\r
 602      call draw(220,241);\r
 603      call draw(160,241);\r
 604      call draw(160,298);\r
 605      call draw(291,298);\r
 606      call draw(291,241);\r
 607      call draw(231,241);\r
 608      call draw(231,227);\r
 609      call draw(330,227);\r
 610      call draw(330,333);\r
 611  \r
 612      call move(353,333);   (* "gorny" parking *)\r
 613      call draw(353,107);\r
 614      call draw(488,107);\r
 615      call draw(488,123);\r
 616      call draw(463,123);\r
 617      call draw(463,143);\r
 618      call draw(522,143);\r
 619      call draw(522,123);\r
 620      call draw(497,123);\r
 621      call draw(497,107);\r
 622      call draw(590,107);\r
 623  \r
 624      call move(354,333);\r
 625      call draw(354,108);\r
 626      call draw(487,108);\r
 627      call draw(487,122);\r
 628      call draw(464,122);\r
 629      call draw(464,144);\r
 630      call draw(523,144);\r
 631      call draw(523,122);\r
 632      call draw(498,122);\r
 633      call draw(498,108);\r
 634      call draw(590,108);\r
 635  \r
 636      call move(9,84);          (* tory tramwajowe *);\r
 637      call draw(590,84);\r
 638      call move(9,86);\r
 639      call draw(590,86);\r
 640      call move(9,91);\r
 641      call draw(590,91);\r
 642      call move(9,93);\r
 643      call draw(590,93);\r
 644  \r
 645      call move(134,81);       (* przystanki *)\r
 646      call draw(174,81);\r
 647      call move(134,82);\r
 648      call draw(174,82);\r
 649      call move(288,95);\r
 650      call draw(328,95);\r
 651      call move(288,96);\r
 652      call draw(328,96);\r
 653  \r
 654      call move(600,20);      (* poglodowka *)\r
 655      call draw(715,20);\r
 656      call move(620,10);\r
 657      call draw(620,62);\r
 658      call move(680,20);\r
 659      call draw(680,62);\r
 660      call move(620,40);\r
 661      call draw(680,40);\r
 662      call move(617,16);\r
 663      call outhline(unpack("1"));\r
 664      call move(677,16);\r
 665      call outhline(unpack("2"));\r
 666      call move(617,36);\r
 667      call outhline(unpack("3"));\r
 668      call move(677,36);\r
 669      call outhline(unpack("4"));\r
 670      call move(595,80);\r
 671      call outhline(unpack("przejechalo"));\r
 672      call move(595,90);\r
 673      call outhline(unpack("pojazdow"));\r
 674      call ilep;\r
 675      call move(595,300);\r
 676      call outhline(unpack("SPACJA-menu"));\r
 677      call move(595,310);\r
 678      call outhline(unpack("Q   exit"));\r
 679      call move(595,320);\r
 680      call outhline(unpack("Z zmiany"));\r
 681  end mapa;\r
 682  \r
 683  \r
 684  unit ilep:procedure;\r
 685   var i:integer;\r
 686   begin\r
 687     for i:=1 to 4 do\r
 688       call move(595,90+i*10);\r
 689       call outhline(daj(i));\r
 690       call move(640,90+i*10);\r
 691       call outhline(daj(ile(i)));\r
 692     od;\r
 693  end ilep;\r
 694  \r
 695  \r
 696  unit start:procedure;(* strona tytulowa oraz zapamietanie   *)\r
 697    var i:integer;     (* wygladu samochodow                  *)\r
 698    begin\r
 699       call cirb(100,100,20,1,1,1,1,1,1);\r
 700       call cirb(100,120,20,1,1,1,1,1,1);\r
 701       call cirb(150,100,20,1,1,1,1,1,1);\r
 702       call cirb(150,120,20,3.8,1.6,1,1,1,1);\r
 703       call move(101,101);\r
 704       c(1):= getmap(111,104);  (* samochod poziomy  *)\r
 705       call move(101,101);\r
 706       c(2):= getmap(106,108);  (* samochod pionowy  *)\r
 707       call move(1,1);\r
 708       c(3):=getmap(11,4);\r
 709       call move(1,1);\r
 710       c(4):=getmap(6,8);\r
 711       call move(2,110);\r
 712       call outhline(unpack("Symulacja"));\r
 713       i:=inchar;\r
 714  end start;\r
 715  \r
 716  \r
 717  \r
 718  unit grtram:procedure;   (* rysowanie i zapamietanie tramwaju  *)\r
 719    begin\r
 720     call move(9,0);\r
 721     call draw(26,0);\r
 722     call move(0,1);\r
 723     call draw(27,1);\r
 724     call move(8,2);\r
 725     call draw(48,2);\r
 726     call move(0,3);\r
 727     call draw(27,3);\r
 728     call move(9,4);\r
 729     call draw(26,4);\r
 730     call move(30,0);\r
 731     call draw(47,0);\r
 732     call move(29,1);\r
 733     call draw(56,1);\r
 734     call move(29,3);\r
 735     call draw(56,3);\r
 736     call move(30,4);\r
 737     call draw(47,4);\r
 738  end grtram;\r
 739  \r
 740  \r
 741  unit semafv:procedure(x,y:integer,upp:boolean);\r
 742    begin   (* rysowanie pionowych sygnalizatorow "swiatel" *)\r
 743      if upp then y:=y+3 fi;\r
 744      call move(x,y);\r
 745      call draw(x+9,y);\r
 746      call draw(x+9,y+27);\r
 747      call draw(x,y+27);\r
 748      call draw(x,y);\r
 749      call move(x,y+9);\r
 750      call draw(x+9,y+9);\r
 751      call move(x,y+18);\r
 752      call draw(x+9,y+18);\r
 753      if upp then\r
 754        y:=y-30;\r
 755        call move(x,y+27);\r
 756        call draw(x+9,y+27);\r
 757      else\r
 758        call move(x,y+30);\r
 759        call draw(x+9,y+30);\r
 760      fi;\r
 761      call move(x+4,y+27);\r
 762      call draw(x+4,y+30);\r
 763      call move(x+5,y+27);\r
 764      call draw(x+5,y+30);\r
 765  end semafv;\r
 766  \r
 767  \r
 768  unit semafh:procedure(x,y:integer,upp:boolean);\r
 769    begin  (* rysowanie poziomych sygnalizatorow "swiatel" *)\r
 770      if upp then x:=x+3 fi;\r
 771      call move(x,y);\r
 772      call draw(x,y+9);\r
 773      call draw(x+27,y+9);\r
 774      call draw(x+27,y);\r
 775      call draw(x,y);\r
 776      call move(x+9,y);\r
 777      call draw(x+9,y+9);\r
 778      call move(x+18,y);\r
 779      call draw(x+18,y+9);\r
 780      if upp then\r
 781        x:=x-30;\r
 782        call move(x+27,y);\r
 783        call draw(x+27,y+9);\r
 784      else\r
 785        call move(x+30,y);\r
 786        call draw(x+30,y+9);\r
 787      fi;\r
 788      call move(x+27,y+4);\r
 789      call draw(x+30,y+4);\r
 790      call move(x+27,y+5);\r
 791      call draw(x+30,y+5);\r
 792  end semafh;\r
 793  \r
 794   unit ser:class(og:boolean,x,y:integer);\r
 795   (* klasa sygnalizator swietlny*)\r
 796   end ser;\r
 797  \r
 798 (* 3 kolejne procedury to graficzne zapalanie swiatel na skrzyzowaniach *)\r
 799  \r
 800  unit semh:procedure(a:arrayof integer,s:integer);\r
 801    var x,y,i:integer;\r
 802      begin\r
 803        for i:=lower(a) to upper(a) do\r
 804          x:=sem(a(i)).x;\r
 805          y:=sem(a(i)).y;\r
 806          if not sem(a(i)).og then\r
 807            call seml(x,x+9,x+18,y,y,y,s);\r
 808          else\r
 809            call seml(x,x-9,x-18,y,y,y,s);\r
 810          fi;\r
 811       od;\r
 812  end semh;\r
 813  \r
 814  \r
 815  unit semv:procedure(a:arrayof integer,s:integer);\r
 816    var x,y,i:integer;\r
 817      begin\r
 818        for i:=lower(a) to upper(a) do\r
 819          x:=sem(a(i)).x;\r
 820          y:=sem(a(i)).y;\r
 821          if not sem(a(i)).og then\r
 822            call seml(x,x,x,y,y+9,y+18,s);\r
 823          else\r
 824            call seml(x,x,x,y,y-9,y-18,s);\r
 825          fi;\r
 826        od;\r
 827  end semv;\r
 828  \r
 829  \r
 830  unit seml :procedure(x1,x2,x3,y1,y2,y3,s:integer);\r
 831    begin\r
 832     case s\r
 833       when 0:call move(x1,y1);\r
 834              call hascii(0);\r
 835              call move(x2,y2);\r
 836              call hascii(0);\r
 837              call move(x3,y3);\r
 838              call hascii(42);\r
 839       when 1:call move(x3,y3);\r
 840              call hascii(0);\r
 841              call move(x2,y2);\r
 842              call hascii(42);\r
 843       when 2:call move(x2,y2);\r
 844              call hascii(0);\r
 845              call move(x1,y1);\r
 846              call hascii(42);\r
 847       when 3:call move(x2,y2);\r
 848              call hascii(42);\r
 849    esac;\r
 850 end seml;\r
 851  \r
 852  \r
 853 unit parking:procedure(ni:integer,bol:boolean);\r
 854   var i,j,k,b,x,y:integer;\r
 855   begin\r
 856    if ni=11 then x:=457;y:=127;\r
 857    else x:=162;y:=286;\r
 858    fi;\r
 859    k:=1;\r
 860    if bol then\r
 861      while park(ni,k) do k:=k+1 od;\r
 862      b:=2;\r
 863      park(ni,k):=true;\r
 864    else\r
 865      while not park(ni,k) do k:=k+1 od;\r
 866      b:=4;\r
 867      park(ni,k):=false;\r
 868    fi;\r
 869    j:=k div 15;\r
 870    i:=k mod 15;\r
 871    x:=x+9*i;\r
 872    y:=y-14*j;\r
 873    call move(x,y);\r
 874    call putmap(c(b));\r
 875 end parking;\r
 876  \r
 877  \r
 878 unit intoq:procedure(d,i:integer,bol:boolean);\r
 879                        (* rysowanie samochodu *);\r
 880   var a,b,x,y:integer;\r
 881   unit los:procedure;\r
 882     begin\r
 883     case d\r
 884       when  1:y:=76;x:=-2+i*12;\r
 885       when  2:y:=99;x:=102-i*12;\r
 886       when  3:y:=76;x:=110+i*12;\r
 887       when  4:y:=99;x:=330-i*12;\r
 888       when  5:y:=76;x:=341+i*12;\r
 889       when  6:y:=99;x:=590-i*12;\r
 890       when  7:y:=208;x:=110+i*12;\r
 891       when  8:y:=218;x:=330-i*12;\r
 892       when  9:x:=105;y:=204-i*12;\r
 893       when 10:x:=117;y:=95+i*12;\r
 894       when 11:x:=105;y:=333-i*12;\r
 895       when 12:x:=117;y:=214+i*12;\r
 896       when 13:x:=333;y:=204-i*12;\r
 897       when 14:x:=343;y:=95+i*12;\r
 898       when 15:x:=333;y:=333-i*12;\r
 899       when 16:x:=343;y:=214+i*12;\r
 900       when 17:x:=105;y:=70-i*12;\r
 901       when 18:x:=117;y:=-6+i*12;\r
 902       when 19:y:=76;x:=485+i*12;\r
 903       when 20:y:=99;x:=488-i*12;\r
 904       when 21:y:=76;x:=341+i*12;\r
 905       when 22:y:=99;x:=590-i*12;\r
 906       when 23:y:=208;x:=218+i*12;\r
 907       when 24:y:=218;x:=221-i*12;\r
 908       when 25:y:=208;x:=110+i*12;\r
 909       when 26:y:=218;x:=330-i*12;\r
 910     esac;\r
 911  \r
 912  end los;\r
 913  \r
 914   begin\r
 915     if i=/=0 then\r
 916       call los;\r
 917       call move(x,y);\r
 918       if d>8 and d<19 then b:=2 else b:=1 fi;\r
 919       if bol then\r
 920          call putmap(c(b));\r
 921       else\r
 922         call putmap(c(b+2));\r
 923       fi;\r
 924     fi;\r
 925   end intoq;\r
 926  \r
 927  var drogi,park:arrayof arrayof boolean;\r
 928  var i,j:integer;\r
 929  var sem:arrayof ser;\r
 930  \r
 931  begin\r
 932    array drogi dim (1:26);\r
 933    for i:=23 to 26 do\r
 934      array drogi(i) dim(1:8);\r
 935    od;\r
 936    for i:=11 to 16 do\r
 937      array drogi(i) dim(1:10);\r
 938    od;\r
 939    array drogi(1) dim(1:8);\r
 940    array drogi(2) dim(1:8);\r
 941    array drogi(3) dim(1:17);\r
 942    array drogi(4) dim(1:17);\r
 943    array drogi(5) dim(1:20);\r
 944    array drogi(6) dim(1:20);\r
 945    array drogi(7) dim(1:17);\r
 946    array drogi(8) dim(1:17);\r
 947    array drogi(9) dim(1:9);\r
 948    array drogi(10) dim(1:9);\r
 949    array drogi(13) dim(1:9);\r
 950    array drogi(14) dim(1:9);\r
 951    array drogi(17) dim(1:6);\r
 952    array drogi(18) dim(1:6);\r
 953    array drogi(19) dim(1:9);\r
 954    array drogi(20) dim(1:11);\r
 955    array drogi(21) dim(1:11);\r
 956    array drogi(22) dim(1:9);\r
 957    array c dim(1:6);\r
 958    array sem dim(1:13);\r
 959    array ile dim(1:4);\r
 960    for i:=1 to 4 do\r
 961       array c(i) dim(1:10);\r
 962    od;\r
 963    array c(5) dim(1:15);\r
 964    array c(6) dim(1:15);\r
 965    array park dim(10:11);\r
 966    array park(10) dim(1:60);\r
 967    array park(11) dim(1:6);\r
 968    call gron(1);    (* rysowanie planu skrzyzowan oraz sygnalizatorow *)\r
 969    call start;\r
 970    call grtram;\r
 971    call move(0,0);\r
 972    c(5):=getmap(56,4);\r
 973    call mapa;\r
 974    call move(100,83);\r
 975    c(6):=getmap(140,87);\r
 976    call semafv(90,35,true);\r
 977    sem(1):=new ser(true,91,57);\r
 978    call semafv(90,170,true);\r
 979    sem(2):=new ser(true,91,192);\r
 980    call semafv(127,229,false);\r
 981    sem(3):=new ser(false,128,230);\r
 982    call semafv(127,110,false);\r
 983    sem(4):=new ser(false,128,111);\r
 984    call semafv(318,170,true);\r
 985    sem(5):=new ser(true,319,192);\r
 986    call semafv(356,229,false);\r
 987    sem(6):=new ser(false,357,230);\r
 988    call semafv(356,110,false);\r
 989    sem(7):=new ser(false,357,111);\r
 990    call semafh(127,56,false);\r
 991    sem(8):=new ser(false,128,57);\r
 992  \r
 993    call semafh(356,56,false);\r
 994    sem(9):=new ser(false,357,57);\r
 995    call semafh(70,110,true);\r
 996    sem(10):=new ser(true,92,111);\r
 997    call semafh(298,110,true);\r
 998    sem(11):=new ser(true,320,111);\r
 999    call semafh(127,191,false);\r
1000    sem(12):=new ser(false,128,192);\r
1001    call semafh(298,229,true);\r
1002    sem(13):=new ser(true,320,230);\r
1003  end graf;\r
1004  \r
1005  \r
1006  \r
1007 unit droga:simulation class;\r
1008  unit zmiany:procedure;\r
1009  const qord=113;\r
1010  const zord=122;\r
1011  const sord=115;\r
1012  const oord=111;\r
1013  const bord=98;\r
1014  var k,l:integer;\r
1015  var t:real;\r
1016  begin\r
1017    t:=time;\r
1018    k:=1;\r
1019    while k=/=0 do\r
1020      k:=gr.inkey;\r
1021    od;\r
1022    while k=0 do\r
1023      k:=gr.inkey;\r
1024    od;\r
1025    case k\r
1026      when qord:call gr.groff;\r
1027                call endrun;\r
1028      when zord:call change;\r
1029    esac;\r
1030  end zmiany;\r
1031  \r
1032  unit change:procedure;\r
1033  var x,y,i:integer;\r
1034  begin\r
1035    call gr.move(595,150);\r
1036    call gr.outhline(unpack("ktore skrzyz."));\r
1037    i:=gr.cyfra(gr.inhline(600,160,1));\r
1038    if i>0 and i<5 then\r
1039      call gr.move(595,170);\r
1040      call gr.outhline(unpack("zielone ?"));\r
1041      cros(i) qua cross.htim:=gr.cyfra(gr.inhline(600,180,2));\r
1042      call gr.move(595,190);\r
1043      call gr.outhline(unpack("zolte ?"));\r
1044      cros(i) qua cross.otim:=gr.cyfra(gr.inhline(600,200,2));\r
1045      call gr.move(595,210);\r
1046      call gr.outhline(unpack("czerwone ?"));\r
1047      cros(i) qua cross.vtim:=gr.cyfra(gr.inhline(600,220,2));\r
1048    fi;\r
1049    for i:=1 to 8 do\r
1050      call gr.move(594,140+i*10);\r
1051      call gr.outhline(unpack("              "));\r
1052    od;\r
1053  end change;\r
1054  \r
1055  \r
1056  unit cross:simprocess class;(* skrzyzowanie *);\r
1057    var co,ro,sh,sv:arrayof integer;\r
1058    var qu         :arrayof kolej;\r
1059    var openz,tr    :arrayof boolean;\r
1060    var vtim,htim,otim,sctim   :integer;(* czas swiecenia sygnalizatora *);\r
1061    var sigsta     :integer;(* stan sygnalizatorow na skrzyzowaniu *);\r
1062    var ver,hor    :integer;(* liczba kolejek pionowych  i poziomych *);\r
1063    var bzi        :integer;\r
1064      unit outfrom:procedure(a,b:integer);(* wypychanie samochodow z kolejek *);\r
1065        var i:integer;\r
1066        var ok :boolean;\r
1067        begin\r
1068         ok:=true;\r
1069         while time<=sctim and ok do\r
1070           ok:=false;\r
1071           for i:=a to b do\r
1072             if not qu(i).endc then call run (qu(i).firstq);ok:=true; fi;\r
1073           od;\r
1074         od;\r
1075      end outfrom;\r
1076  \r
1077      begin\r
1078       otim:=5;\r
1079       array tr dim (1:2);\r
1080       array openz dim(1:2);\r
1081       do\r
1082        bzi:=gr.inkey;\r
1083        if bzi=32 then call zmiany fi;;\r
1084        sigsta:=(sigsta + 1) mod 4;(* zmiana swiatel*);\r
1085        call gr.semh(sh,sigsta);\r
1086        call gr.semv(sv,(sigsta+2)mod 4);\r
1087        call gr.ilep;\r
1088        case sigsta\r
1089           when 0:openz(1):=true;\r
1090                 if tr(1) then tr(1):=false;call run(tramm(1)) fi;\r
1091                 if tr(2) then tr(2):=false;call run(tramm(2)) fi;\r
1092                 sctim:=time+htim;\r
1093                 call outfrom(1,hor);\r
1094          when 1: openz(1):=false;\r
1095                  sctim:=time+otim;\r
1096          when 2: openz(2):=true;\r
1097                  sctim:=time+vtim;\r
1098                  call outfrom(hor+1,ver+hor);\r
1099          when 3: openz(2):=false;\r
1100                  sctim:=time+otim;\r
1101        esac;\r
1102        call schedule(this cross,sctim);\r
1103      od;\r
1104    end cross;\r
1105  \r
1106  \r
1107    unit wolno:function(a,b:integer):integer;(* obliczenie miejsca     *)\r
1108      var bol:boolean;                       (* stania na skrzyzowaniu *)\r
1109        begin\r
1110        if a>0 and a<5 then\r
1111          case a\r
1112            when 1,2 :if b>8 and b<19 then\r
1113                        bol:=cros(a) qua cross.openz(2);\r
1114                        result:=b mod 2 +3\r
1115                      else\r
1116                        bol:=cros(a) qua cross.openz(1);\r
1117                        result:=b mod 2 +1;\r
1118                      fi;\r
1119            when 3,4 :if (b<9 or b>18) and b=/=0 then\r
1120                        result:=1;\r
1121                        bol:=cros(a) qua cross.openz(1);\r
1122                      else\r
1123                        result:=b mod 2 +2;\r
1124                        bol:=cros(a) qua cross.openz(2);\r
1125                      fi;\r
1126          esac;\r
1127          if bol then  (*and cros(a) qua cross.qu(result).endc*)\r
1128            result:=0;\r
1129          fi;\r
1130        else result:=0;\r
1131        fi;\r
1132    end wolno;\r
1133  \r
1134  \r
1135    unit wyjazd:simprocess class;\r
1136      var co,ro:arrayof integer;\r
1137    end wyjazd;\r
1138  \r
1139    unit parking:simprocess class(poj:integer);\r
1140      var co,ro:arrayof integer;\r
1141      var cars:integer;\r
1142      unit park :procedure(a:car);\r
1143        var i:integer;\r
1144        begin\r
1145          if cars<poj then\r
1146            cars:=cars+1;\r
1147            a.bol:=true;\r
1148            a.stp:=a.nr;\r
1149            while a.finp=a.stp do\r
1150              a.finp:=random*7+5;    (* losowanie wyjazdu *)\r
1151            od;\r
1152            call gr.parking(a.nr,true);\r
1153            i:=150+random*360;\r
1154            call schedule(a,time+i);\r
1155          else\r
1156            a.bol:=false;\r
1157            if a.nr=10 then a.finp:=11 else  a.finp:=10 fi;\r
1158            call schedule(a,time+2);\r
1159          fi;\r
1160      end park;\r
1161    end parking;\r
1162  \r
1163    unit kolej:class(nr:integer);\r
1164    var il:integer;\r
1165     unit elcar:class(p:car);\r
1166       var next:elcar;\r
1167     end elcar;\r
1168     var first,last:elcar;\r
1169  \r
1170     unit insert :procedure(p:car);\r
1171     begin\r
1172       if first=none then\r
1173         first,last:=new elcar(p);\r
1174       else\r
1175          last.next:=new elcar(p);\r
1176         last:=last.next;\r
1177       fi;\r
1178       il:=il+1;\r
1179     end insert;\r
1180  \r
1181     unit firstq:function:car;\r
1182      begin\r
1183       if first=/=none then\r
1184         result:=first.p;\r
1185         if first.next=/=none then\r
1186           first:=first.next;\r
1187         else first:=none;last:=none;\r
1188         fi;\r
1189         if il>0 then\r
1190           il:=il-1;\r
1191         fi;\r
1192       fi;\r
1193    end firstq;\r
1194  \r
1195    unit endc:function:boolean;\r
1196      begin\r
1197       result:=(first=none);\r
1198    end endc;\r
1199  \r
1200    begin (* kolej *)\r
1201          il:=0;\r
1202    end kolej;\r
1203  \r
1204  \r
1205  unit road:class(distance,line,speed:integer);(* droga *)\r
1206      var cars       :integer;\r
1207  end road;\r
1208  \r
1209  \r
1210   unit rotime: function (d,s:integer):integer;(* czas pokonania danej drogi *);\r
1211    var min:integer;\r
1212      begin\r
1213        if s < roads(d).speed then min := s\r
1214        else min:=roads(d).speed;\r
1215        fi;\r
1216 (*result:=roads(d).distance*3.6*((1+.1*roads(d).cars)/10*roads(d).line)/min;*)\r
1217    result:=30;\r
1218    end rotime;\r
1219  \r
1220   unit car:simprocess class(max:integer);\r
1221    var stp,finp,old,where,nr,nero,wol:integer;\r
1222    var tim,bla,ble,zw:integer;\r
1223    var bol:boolean;\r
1224  \r
1225    unit jedziecar:procedure(d,t:integer);\r
1226    var j,k,tim:integer;\r
1227      begin\r
1228        case d\r
1229          when 1,2:j:=7;\r
1230          when 3,4,7,8:j:=16;\r
1231          when 5,6:j:=19;\r
1232          when 9,10,13,14,19,22:j:=8;\r
1233          when 17,18:j:=5;\r
1234          when 11,12,15,16:j:=9;\r
1235  \r
1236          when 20,21:j:=10;\r
1237          when 23,24,25,26:j:=7;\r
1238        esac ;\r
1239        tim:=t/j;\r
1240        for k:=j downto 1 do\r
1241          if not gr.drogi(d,k) then\r
1242            gr.drogi(d,k):=true;\r
1243            gr.drogi(d,k+1):=false;\r
1244            call gr.intoq(d,k+1,false);\r
1245            call gr.intoq(d,k,true);\r
1246            zw:=k;\r
1247          fi;\r
1248          call hold(tim);\r
1249        od;\r
1250    end jedziecar;\r
1251  \r
1252    begin  (*  algorytm   car *)\r
1253       do\r
1254          finp,stp:=random*5+5;  (*losowanie wjazdu *)\r
1255          while finp=stp do\r
1256              finp:=random*7+5;    (* losowanie wyjazdu *)\r
1257          od;\r
1258          tim:=360+random*360;   (* czas pierwszego pojawienia sie *)\r
1259          call schedule(this car,time+tim);\r
1260          old:=0;\r
1261          bol:=false;\r
1262          nr:=stp;\r
1263          where:=nr;             (* gdzie jest *)\r
1264          do\r
1265              nr:=where;\r
1266              if nr=finp then       (* czy dojechal do wyjazdu *)\r
1267                 if old=/=0  then\r
1268                     call gr.intoq(old,zw,false);\r
1269                     gr.drogi(old,zw):=false;\r
1270                 fi;\r
1271                 if nr>9 then call cros(nr) qua parking.park(this car);\r
1272                     if bol then call gr.parking(nr,false);\r
1273                       cros(nr) qua parking.cars:=cros(nr) qua parking.cars-1;\r
1274                     fi;\r
1275                 else exit\r
1276                 fi;\r
1277              fi;\r
1278              case nr     (* co robic w zaleznosci od miejsca pobytu *)\r
1279              when 1,2,3,4  : where:=cros(nr) qua cross.co(finp);\r
1280                 (*skrzyzowanie *)\r
1281                 nero:=cros(nr) qua cross.ro(where);\r
1282                 gr.ile(nr):=gr.ile(nr)+1;\r
1283              when 5,6,7,8,9: where:=cros(nr) qua wyjazd.co(finp);\r
1284                  (*wyjazd-wjazd *)\r
1285                  nero:=cros(nr) qua wyjazd.ro(where);\r
1286              when 10,11    : where:=cros(nr) qua parking.co(finp);\r
1287                   (*parking *)\r
1288                    nero:=cros(nr) qua parking.ro(where);\r
1289              esac;\r
1290              wol:=wolno(nr,old);\r
1291              if wol=/=0 then\r
1292                  call cros(nr) qua cross.qu(wol).insert(this car);\r
1293        call passivate;\r
1294      fi;\r
1295      tim:=rotime(nero,max);\r
1296      roads(nero).cars:=roads(nero).cars+1;\r
1297       if old=/=0 and nr=/=10 and nr=/=11 then\r
1298          call gr.intoq(old,zw,false);\r
1299          gr.drogi(old,zw):=false;\r
1300      fi;\r
1301  \r
1302      call jedziecar(nero,tim);\r
1303      old:=nero;\r
1304      roads(nero).cars:=roads(nero).cars-1;\r
1305     od;\r
1306   od;\r
1307   end car;\r
1308  \r
1309   unit tram:simprocess class(a:integer);\r
1310     var b,i,y,x1,x2:integer;\r
1311     var t:arrayof integer;\r
1312     unit jazda:procedure(d:integer);\r
1313       var x,p,i:integer;\r
1314       var bol:boolean;\r
1315       begin\r
1316         p:=8;\r
1317         if a=1 then\r
1318           bol:=true;\r
1319         else\r
1320           p:=-8;\r
1321         fi;\r
1322         case d\r
1323           when 1:d:=15;x:=125;\r
1324           when 2:d:=7;x:=10;\r
1325           when 3:d:=29;x:=349;\r
1326           when 4:d:=29;x:=58;\r
1327           when 5:d:=24;x:=533;\r
1328           when 6:d:=32;x:=282;\r
1329         esac;\r
1330         for i:=1 to d do\r
1331           call gr.move(x,y);\r
1332           call gr.putmap(gr.c(5));\r
1333           x:=x+p;\r
1334           call hold(2);\r
1335         od;\r
1336       end jazda;\r
1337     begin\r
1338       array t dim(1:5);\r
1339       if a=1 then\r
1340        t(1),t(4):=2;\r
1341        t(2):=1;\r
1342        t(3):=4;\r
1343        t(5):=6;\r
1344      else\r
1345        t(1):=5;\r
1346        t(2):=2;\r
1347        t(3):=3;\r
1348        t(4),t(5):=1;\r
1349      fi;\r
1350      if a=1 then y:=90;x2:=538\r
1351      else y:=83;x2:=21; fi;\r
1352      do\r
1353        b:=random*60+60;\r
1354        call schedule(this tram,time+b);\r
1355        call jazda(t(1));\r
1356        if wolno(t(2),t(1))=/=0 then\r
1357          cros(t(2)) qua cross.tr(a):=true;\r
1358          call passivate;\r
1359        fi;\r
1360        call jazda(t(3));\r
1361        call hold(30);\r
1362        if not cros(t(4)) qua cross.openz(1) then\r
1363          cros(t(4)) qua cross.tr(a):=true;\r
1364          call passivate;\r
1365        fi;\r
1366        call jazda(t(5));\r
1367        call gr.move(x2,y);\r
1368        call gr.putmap(gr.c(6));\r
1369        call hold(60);\r
1370      od;\r
1371   end tram;\r
1372  \r
1373  \r
1374   unit gencar:simprocess class;(* generator samochodow *);\r
1375     var t,i,b:integer;\r
1376     var p:car;\r
1377     begin\r
1378      for i:=1 to 10 do   (******?????bylo 20  ????*****)\r
1379       t:=random*36;\r
1380       b:=random*(41)+60;\r
1381       p:=new car(b);\r
1382       call schedule(p,t);\r
1383     readln ; (* to ja ???????????*)\r
1384     od;\r
1385     readln ; (* to ja ???????????*)\r
1386  \r
1387     for i:=1 to 4 do\r
1388       call schedule(cros(i),time+i);\r
1389     od;\r
1390     call schedule(tramm(1),time+3);\r
1391     call schedule(tramm(2),time+4);\r
1392     call hold(6000);\r
1393     call run(mainpr)\r
1394   end gencar;\r
1395  \r
1396   var i,j:integer,\r
1397       g:gencar,\r
1398       cros :arrayof simprocess,\r
1399       roads  :arrayof road,\r
1400       tramm:arrayof tram,\r
1401       gr:graf;\r
1402  \r
1403   unit prepkol:procedure;\r
1404   begin\r
1405    array cros(1) qua cross.qu dim(1:4);\r
1406    array cros(2) qua cross.qu dim(1:3);\r
1407    array cros(3) qua cross.qu dim(1:3);\r
1408    array cros(4) qua cross.qu dim(1:3);\r
1409    cros(1) qua cross.qu(1):=new kolej(2);\r
1410    cros(1) qua cross.qu(2):=new kolej(3);\r
1411    cros(1) qua cross.qu(3):=new kolej(10);\r
1412    cros(1) qua cross.qu(4):=new kolej(17);\r
1413    cros(2) qua cross.qu(1):=new kolej(4);\r
1414    cros(2) qua cross.qu(2):=new kolej(5);\r
1415    cros(2) qua cross.qu(3):=new kolej(14);\r
1416    cros(3) qua cross.qu(1):=new kolej(7);\r
1417    cros(3) qua cross.qu(2):=new kolej(12);\r
1418    cros(3) qua cross.qu(3):=new kolej(9);\r
1419    cros(4) qua cross.qu(1):=new kolej(8);\r
1420    cros(4) qua cross.qu(2):=new kolej(16);\r
1421    cros(4) qua cross.qu(3):=new kolej(13);\r
1422   end prepkol;\r
1423  \r
1424  \r
1425   unit preproad:procedure;\r
1426   begin\r
1427      array roads  dim(1:26);\r
1428      roads(1):=new road(90,1,90);\r
1429      roads(2):=new road(90,1,90);\r
1430      roads(3):=new road(400,1,80);\r
1431      roads(4):=new road(400,1,80);\r
1432      roads(5):=new road(400,1,90);\r
1433      roads(6):=new road(400,1,90);\r
1434      roads(7):=new road(400,1,70);\r
1435      roads(8):=new road(400,1,70);\r
1436      roads(9):=new road(200,1,70);\r
1437  \r
1438      roads(10):=new road(200,1,70);\r
1439     roads(11):=new road(220,1,70);\r
1440     roads(12):=new road(220,1,70);\r
1441     roads(13):=new road(200,1,70);\r
1442     roads(14):=new road(200,1,70);\r
1443     roads(15):=new road(220,1,70);\r
1444     roads(16):=new road(220,1,70);\r
1445     roads(17):=new road(100,1,70);\r
1446     roads(18):=new road(100,1,70);\r
1447     roads(19):=new road(160,1,90);\r
1448     roads(20):=new road(240,1,90);\r
1449     roads(21):=new road(240,1,90);\r
1450     roads(22):=new road(160,1,90);\r
1451     roads(23):=new road(200,1,70);\r
1452     roads(24):=new road(200,1,70);\r
1453     roads(25):=new road(200,1,70);\r
1454     roads(26):=new road(200,1,70);\r
1455   end preproad;\r
1456  \r
1457   begin\r
1458     gr:=new graf;\r
1459     array cros dim(1:11);\r
1460     for i:=1 to 4 do\r
1461       cros(i):=new cross;\r
1462     od;\r
1463     for i:=5 to 9 do\r
1464       cros(i):=new wyjazd;\r
1465     od;\r
1466     cros(10):=new parking(60);\r
1467     cros(11):=new parking(6);\r
1468     array tramm dim(1:2);\r
1469     tramm(1):=new tram(1);\r
1470     tramm(2):=new tram(2);\r
1471  \r
1472     call preproad;\r
1473     array cros(1) qua cross.sh dim(1:2);\r
1474     array cros(2) qua cross.sh dim(1:2);\r
1475     array cros(3) qua cross.sh dim(1:1);\r
1476     array cros(4) qua cross.sh dim(1:1);\r
1477     array cros(1) qua cross.sv dim(1:2);\r
1478     array cros(2) qua cross.sv dim(1:1);\r
1479     array cros(3) qua cross.sv dim(1:2);\r
1480     array cros(4) qua cross.sv dim(1:2);\r
1481     for i:=1 to 4 do\r
1482       cros(i) qua cross.hor:=1;\r
1483       cros(i) qua cross.ver:=2;\r
1484     od;\r
1485     cros(1) qua cross.hor:=2;\r
1486     cros(2) qua cross.hor:=2;\r
1487     cros(2) qua cross.ver:=1;\r
1488     cros(1) qua cross.sh(1):=8;\r
1489  \r
1490     cros(1) qua cross.sh(2):=10;\r
1491     cros(2) qua cross.sh(1):=9;\r
1492     cros(2) qua cross.sh(2):=11;\r
1493     cros(3) qua cross.sh(1):=12;\r
1494     cros(4) qua cross.sh(1):=13;\r
1495     cros(1) qua cross.sv(1):=1;\r
1496     cros(1) qua cross.sv(2):=4;\r
1497     cros(2) qua cross.sv(1):=7;\r
1498     cros(3) qua cross.sv(1):=2;\r
1499     cros(3) qua cross.sv(2):=3;\r
1500     cros(4) qua cross.sv(1):=5;\r
1501     cros(4) qua cross.sv(2):=6;\r
1502     for i:=1 to 4 do\r
1503       array cros(i) qua cross.co dim (5:11);\r
1504     od;\r
1505     for i:=5 to 9 do\r
1506       array cros(i) qua wyjazd.co dim (5:11);\r
1507     od;\r
1508     array cros(10) qua parking.co dim (5:11);\r
1509     array cros(11) qua parking.co dim (5:11);\r
1510     for i:=5 to 11 do\r
1511       cros(1) qua cross.co(i):=2;\r
1512       cros(2) qua cross.co(i):=1;\r
1513       cros(3) qua cross.co(i):=1;\r
1514       cros(4) qua cross.co(i):=2;\r
1515       cros(5) qua wyjazd.co(i):=3;\r
1516       cros(6) qua wyjazd.co(i):=4;\r
1517       cros(7) qua wyjazd.co(i):=2;\r
1518       cros(8) qua wyjazd.co(i):=1;\r
1519       cros(9) qua wyjazd.co(i):=1;\r
1520       cros(10) qua parking.co(i):=3;\r
1521       cros(11) qua parking.co(i):=2;\r
1522    od;\r
1523    cros(1) qua cross.co(5):=3;\r
1524    cros(1) qua cross.co(8):=8;\r
1525    cros(1) qua cross.co(9):=9;\r
1526    cros(1) qua cross.co(10):=3;\r
1527    cros(2) qua cross.co(6):=4;\r
1528    cros(2) qua cross.co(7):=7;\r
1529    cros(2) qua cross.co(10):=4;\r
1530    cros(2) qua cross.co(11):=11;\r
1531    cros(3) qua cross.co(5):=5;\r
1532    cros(3) qua cross.co(6):=4;\r
1533     cros(3) qua cross.co(10):=10;\r
1534     cros(4) qua cross.co(5):=3;\r
1535     cros(4) qua cross.co(6):=6;\r
1536     cros(4) qua cross.co(10):=10;\r
1537     cros(7) qua wyjazd.co(11):=11;\r
1538     cros(10) qua parking.co(6):=4;\r
1539     cros(10) qua parking.co(7):=4;\r
1540     cros(10) qua parking.co(11):=4;\r
1541     cros(11) qua parking.co(7):=7;\r
1542     array cros(1) qua cross.ro dim(2:9);\r
1543     array cros(2) qua cross.ro dim(1:11);\r
1544     array cros(3) qua cross.ro dim(1:10);\r
1545     array cros(4) qua cross.ro dim(2:10);\r
1546     array cros(5) qua wyjazd.ro dim(3:3);\r
1547  \r
1548    array cros(6) qua wyjazd.ro dim(4:4);\r
1549    array cros(7) qua wyjazd.ro dim(2:11);\r
1550    array cros(8) qua wyjazd.ro dim(1:1);\r
1551    array cros(9) qua wyjazd.ro dim(1:1);\r
1552    array cros(10) qua parking.ro dim(3:4);\r
1553    array cros(11) qua parking.ro dim(2:7);\r
1554    cros(1) qua cross.ro(2):=4;\r
1555    cros(1) qua cross.ro(3):=9;\r
1556    cros(1) qua cross.ro(8):=18;\r
1557    cros(1) qua cross.ro(9):=1;\r
1558    cros(2) qua cross.ro(1):=3;\r
1559    cros(2) qua cross.ro(4):=13;\r
1560    cros(2) qua cross.ro(7):=6;\r
1561    cros(2) qua cross.ro(11):=20;\r
1562    cros(3) qua cross.ro(1):=10;\r
1563    cros(3) qua cross.ro(4):=8;\r
1564    cros(3) qua cross.ro(5):=11;\r
1565    cros(3) qua cross.ro(10):=24;\r
1566    cros(4) qua cross.ro(2):=14;\r
1567    cros(4) qua cross.ro(3):=7;\r
1568    cros(4) qua cross.ro(6):=15;\r
1569    cros(4) qua cross.ro(10):=23;\r
1570  \r
1571    cros(5) qua wyjazd.ro(3):=12;\r
1572    cros(6) qua wyjazd.ro(4):=16;\r
1573    cros(7) qua wyjazd.ro(2):=5;\r
1574    cros(7) qua wyjazd.ro(11):=19;\r
1575         cros(8) qua wyjazd.ro(1):=17;\r
1576         cros(9) qua wyjazd.ro(1):=2;\r
1577         cros(10) qua parking.ro(3):=25;\r
1578         cros(10) qua parking.ro(4):=26;\r
1579         cros(11) qua parking.ro(2):=21;\r
1580         cros(11) qua parking.ro(7):=22;\r
1581         cros(1) qua cross.htim:=60;\r
1582         cros(1) qua cross.vtim:=30;\r
1583         cros(2) qua cross.htim:=60;\r
1584         cros(2) qua cross.vtim:=30;\r
1585         cros(3) qua cross.htim:=40;\r
1586         cros(3) qua cross.vtim:=50;\r
1587         cros(4) qua cross.htim:=40;\r
1588         cros(4) qua cross.vtim:=50;\r
1589         cros(1) qua cross.sigsta:=0;\r
1590         cros(2) qua cross.sigsta:=0;\r
1591         cros(3) qua cross.sigsta:=0;\r
1592         cros(4) qua cross.sigsta:=0;\r
1593         call prepkol;\r
1594         readln;\r
1595         g:=new gencar;\r
1596         readln;    (*??????? to ja  ????? *)\r
1597         call run(g);\r
1598    end droga;\r
1599  \r
1600 begin\r
1601   pref droga block\r
1602   begin\r
1603       call hold(6000);\r
1604       end;\r
1605   end;\r
1606   call gr.groff;\r
1607 end;\r
1608  \r