block
(*_______________________________________________________*)
(*        SYMULACJA     RUCHU      ULICZNEGO             *)
(*_______________________________________________________*)
 
(* simulation class *)
 
 unit fifo:class;
   (* the type implementing fifo - queues *)
   hidden front, rear;
   signal fifoempty;
   var front, rear:fifoel;
 
 
   unit fifoel : class;
     var succ:fifoel;
 
     unit into:procedure(q:fifo);
       begin
         if q.front = none then
           q.front,q.rear := this fifoel
         else q.rear.succ, q.rear :=this fifoel
         fi
     end into;
 
   end fifoel;
 
 
 
   unit outfirst:procedure;
     begin
       if front = none then raise fifoempty
       else
         if rear = front then rear,front := none
         else front:=front.succ
         fi
       fi
   end outfirst;
 
 
 
   unit empty:function:boolean;
     begin
       result := front=none
   end empty;
 
 
 
   unit first:function:fifoel;
     begin
       result := front
   end first;
 
 
 
   unit cardinal:function:integer;
     var   i:integer,
         aux:fifoel;
     begin
       aux := front;
       while aux =/= none do
         i:=i+1;
         aux:=aux.succ
       od;
       result := i
   end cardinal;
 
 end fifo;
 
 
 
 unit priorityqueue: fifo class;
  (* heap as binary linked tree with father link*)
   hidden node;
 
   unit queuehead: class;
      (* heap accessing module *)
     hidden last, root;
     var last,root:node;
 
     unit min: function: elem;
       begin
         if root=/= none then result:=root.el fi;
     end min;
 
     unit insert: procedure(r:elem);
       (* insertion into heap *)
       var x,z:node;
       begin
         x:= r.lab;
         if last = none then
           root:=x;
           root.left,root.right,last:=root
         else
           if last.ns = 0 then
             last.ns:=1;
             z:= last.left;
             last.left:=x;
             x.up:= last;
             x.left:= z; z.right:=x
           else
             last.ns:=2;
             z:= last.right;
             last.right:=x;
             x.right:=z;
             x.up:= last;
             z.left:=x;
             last.left.right:=x;
             x.left:=last.left;
             last:= z;
           fi;
         fi;
         call correct(r,false);
     end insert;
 
 
 
     unit delete: procedure(r: elem);
       var x,y,z:node;
       begin
         x:=r.lab;
         if x=root and root.ns=0 then
           root,last:= none
         else
           z:=last.left;
           if last.ns =0 then
             y:= z.up;
             y.right:= last;
             last.left:=y;
             last:=y;
           else
             y:= z.left;
             y.right:= last;
             last.left:= y;
           fi;
           z.el.lab:=x;
           x.el:= z.el;
           last.ns:= last.ns-1;
           r.lab:=z;
           z.el:=r;
           if x.less(x.up) then
             call correct(x.el,false)
           else
             call correct(x.el,true)
           fi;
         fi;
     end delete;
 
 
     unit correct: procedure(r:elem,down:boolean);
            (* correction of the heap with structure broken by r *)
       var x,z:node,t:elem,fin,log:boolean;
       begin
         z:=r.lab;
         if down then
           while not fin do
             if z.ns =0 then
               fin:=true
             else
               if z.ns=1 then
                 x:=z.left
               else
                 if z.left.less(z.right) then
                   x:=z.left
                  else x:=z.right
                 fi
               fi;
               if z.less(x) then
                 fin:=true
               else
                 t:=x.el;
                 x.el:=z.el;
                 z.el:=t;
                 z.el.lab:=z;
                 x.el.lab:=x
               fi
             fi;
             z:=x;
           od
         else
           x:=z.up;
           if x=none then log:=true else log:=x.less(z); fi;
           while not log do
             t:=z.el;
             z.el:=x.el;
             x.el:=t;
             x.el.lab:=x;
             z.el.lab:=z;
             z:=x;
             x:=z.up;
             if x=none then log:=true else log:=x.less(z);fi;
           od;
         fi;
     end correct;
 
   end queuehead;
 
 
 
   unit node: class (el:elem);
       (* element of the heap *)
     var left,right,up: node, ns:integer;
     unit less: function(x:node): boolean;
       begin
         if x= none then result:=false
         else result:=el.less(x.el)
         fi;
     end less;
   end node;
 
   unit elem: class(prior:real);
       (* prefix of information to be stored in node *)
     var lab: node;
     unit virtual less: function(x:elem):boolean;
       begin
         if x=none then result:= false
         else
           result:= prior< x.prior
         fi;
     end less;
     begin
       lab:= new node(this elem);
   end elem;
 
 
 end priorityqueue;
(*______________________________________________________________*)
 
 
 
 
 unit simulation: priorityqueue class;
   (* the language for simulation purposes *)
   taken queuehead, elem, fifoel;
   hidden pq, curr, eventnotice, mainprogram, choiceprocess;
   var curr  : simprocess,  (*active process *)
       pq    :queuehead,  (* the time axis *)
       mainpr: mainprogram;
 
   unit simprocess:fifoel coroutine;
         (* user process prefix *)
     var event,  (* activation moment notice *)
         eventpom: eventnotice,
                 (* this is for avoiding many new calls as an result *)
                 (* of subsequent passivations and activations             *)
         finish: boolean;
      signal termproc, idleproc;
      unit idle: function: boolean;
        begin
          result:= event= none;
      end idle;
 
 
      unit terminated: function :boolean;
        begin
          result:= finish;
      end terminated;
 
 
      unit evtime: function: real;
           (* time of activation *)
        begin
          if idle then raise idleproc  fi;
          result:= event.eventtime;
      end evtime;
      handlers
                (* default handlers for signals termproc and idleproc *)
          when termproc: writeln(" simprocess is terminated ");
                        attach(mainpr);
          when idleproc: writeln(" simprocess is idle ");
                        attach(mainpr);
      end handlers;
      begin
          return;
          inner;
          finish:=true;
          call passivate;
          raise termproc
   end simprocess;
 
 
 
   unit eventnotice: elem class;
        (* a process activation notice to be placed onto the time axis pq *)
     var eventtime: real, proc: simprocess;
     unit virtual less: function(x: eventnotice):boolean;
               (* overwrite the former version considering eventtime *)
       begin
         if x=none then result:= false
         else
           result:=eventtime < x.eventtime or
                   (eventtime=x.eventtime and prior < x.prior);
         fi;
     end less;
   end eventnotice;
 
 
   unit mainprogram: simprocess class;
      (* implementing master programm as a process *)
     begin
       do attach(main) od;
   end mainprogram;
 
 
   unit time:function:real;
      (* current value of simulation time *)
     begin
       result:=current.evtime
   end time;
 
 
   unit current: function: simprocess;
         (* the first process on the time axis *)
     begin
       result:=curr;
   end current;
 
    unit schedule: procedure(p:simprocess,t:real);
       (* activation of process p at time t *)
     begin
       if t<time then t:= time fi;
       if p=current then
         call hold(t-time)
       else
          if p.idle and p.eventpom=none then
              (* has not been scheduled yet *)
           p.event,p.eventpom:= new eventnotice(random);
           p.event.proc:= p;
         else
           if p.idle (* p has been scheduled yet *) then
             p.event:= p.eventpom;
             p.event.prior:=random;
           else
                    (* new scheduling *)
             p.event.prior:=random;
             call pq.delete(p.event)
           fi
         fi;
         p.event.eventtime:= t;
         call pq.insert(p.event);
       fi;
   end schedule;
 
 
   unit hold:procedure(t:real);
       (* move the active process t minutes back along pq *)
       (* redefine prior                                *)
     begin
       call pq.delete(current.event);
       current.event.prior:=random;
       if t<0 then t:=0; fi;
       current.event.eventtime:=time+t;
       call pq.insert(current.event);
       call choiceprocess;
   end hold;
 
 
   unit passivate: procedure;
        (* remove the actve process from pq and activate the next one *)
     begin
       call pq.delete(current.event);
       current.event:=none;
       call choiceprocess
   end passivate;
 
 
   unit run: procedure(p:simprocess);
        (* activate p immediately and delay former first process   *)
        (* by redefining prior                                    *)
     begin
       current.event.prior:=random;
       if not p.idle then
         p.event.prior:=0;
         p.event.eventtime:=time;
         call pq.correct(p.event,false)
       else
         if p.eventpom=none then
           p.event,p.eventpom:=new eventnotice(0);
           p.event.eventtime:=time;
           p.event.proc:=p;
           call pq.insert(p.event)
         else
           p.event:=p.eventpom;
           p.event.prior:=0;
           p.event.eventtime:=time;
           p.event.proc:=p;
           call pq.insert(p.event);
         fi
        fi;
       call choiceprocess;
   end run;
 
 
 
   unit cancel:procedure(p: simprocess);
      (* remove process p from pq and continue simulation *)
     begin
       if p= current then call passivate
       else
         call pq.delete(p.event);
         p.event:=none;
       fi;
   end cancel;
 
 
 
   unit choiceprocess:procedure;
       (* choose the first process from pq to be activated *)
      var p:simprocess;
     begin
       p:=curr;
       if pq.min= none then
         writeln(" empty queue");
         mainpr.event:=mainpr.eventpom;
         mainpr.event.prior:=0;
         mainpr.event.eventtime:=time;
         call pq.insert(mainpr.event);
         curr:=mainpr;
         attach(mainpr)
       else
         curr:=pq.min qua eventnotice.proc;
         attach(curr)
       fi;
   end choiceprocess;
 
 
 
   begin
     pq:=new queuehead;  (* simulation time axis*)
     curr,mainpr:=new mainprogram;
     mainpr.event,mainpr.eventpom:=new eventnotice(0);
     mainpr.event.eventtime:=0;
     mainpr.event.proc:=mainpr;
     call pq.insert(mainpr.event);
     (* the first process to be activated is main program *)
     inner;
     pq:=none;
 
 end simulation;
 
(*______________________________________________________________________*)
(*              grafika do symulacji                                    *)
(*______________________________________________________________________*)
 
 
unit graf:iiuwgraph class;    (* clasa graficzna  *)
var c:arrayof arrayof integer;
var ile :arrayof integer;
 
 unit inchar:function:integer;
 begin
   while result=0 do
     result:=inkey;
   od;
 end inchar;
 
 
 unit outhline: procedure(a:arrayof char);
 (* wypisanie w trybie graficznym*)
   var i,j:integer;
   begin
     i:=upper(a);
     for j:=1 to i do
       call hascii(0);
       call hascii(ord(a(j)));
     od;
     kill (a);
 end outhline;
 
 
 
 unit inhline:function(xc:integer;yc,il:integer):arrayof char;
   var i,count,ik:integer;
   var ar:arrayof char;
   begin
    call move(xc,yc);
    count:=0;
    array ar dim(1:il);
    while ik=/=13 and count<il do
      ik:=inchar;
      if ik=8 and count>0 then
        ar(count):=' ';
        count:=count-1;
        call move(xc+(count)*8,yc);
        call hascii(0);
      else
        if ik=/=13 then
          count:=count+1;
          ar(count):=chr(ik);
          call hascii(0);
          call hascii(ik);
        fi;
      fi;
    od;
    if count=/=0 then
      array result dim(1:count);
      for i:=1 to count do
        result(i):=ar(i);
      od;
    fi;
 end inhline;
 
 
 
(* funkcja zamiany na liczbe liczby zapisanej znakowo                     *);
 unit cyfra:function(at:arrayof char):integer;
   var id,i,j,k:integer;
   begin
    j:=1;
    k:=0;
    id:=upper(at);
    for i:=id downto 1 do
      k:=k+((ord(at(i))-48)*j);
      j:=j*10;
    od;
    result:=k;
 end cyfra;
 
 
 unit daj:function(a:integer):arrayof char;
   var ta:arrayof char;
   var i,j,k,l,m:integer;
   begin
     if a>9 then
       if a>99 then
         if a>999 then
           if a>9999 then i:=5;
           else i:=4; fi;
         else i:=3; fi;
       else i:=2; fi;
     else i:=1; fi;
     k:=10;
     l:=1;
     m:=1;
     array ta dim(1:i);
     if i=5 then m:=2;ta(1):=chr((a div 10000)+48); fi;
     for j:=i downto m do
       ta(j):=chr(((a mod k) div l)+48);
       k:=k*10;
       l:=l*10;
     od;
     result:=ta;
 end daj;
 
 unit mapa:procedure; (* rysowanie fragmentu miasta *)
   begin
     call cls;          (* czyszczenie ekranu *)
     call move(9,5);    (* rameczka *)
     call draw(719,5);
     call draw(719,333);
     call draw(9,333);
     call draw(9,5);
     call move(590,5);
     call draw(590,333);
     call move(589,5);
     call draw(589,333);
     call move(9,70);    (* tu juz skrzyzowanie *)
     call draw(102,70);
     call draw(102,5);
     call move(9,69);
     call draw(103,69);
     call draw(103,5);
     call move(124,5);
     call draw(124,69);
     call draw(590,69);
     call move(125,5);
     call draw(125,70);
     call draw(590,70);
     call move(9,107);
     call draw(103,107);
     call draw(103,333);
     call move(9,108);
     call draw(102,108);
     call draw(102,333);
     call move(124,107);
     call draw(124,204);
     call draw(331,204);
     call draw(331,107);
     call draw(124,107);
     call move(125,108);
     call draw(125,203);
     call draw(330,203);
     call draw(330,108);
     call draw(125,108);
 
     call move(124,333);   (* "dolny" parking *)
     call draw(124,226);
     call draw(221,226);
     call draw(221,242);
     call draw(161,242);
     call draw(161,297);
     call draw(290,297);
     call draw(290,242);
     call draw(230,242);
     call draw(230,226);
     call draw(331,226);
     call draw(331,333);
 
     call move(125,333);
     call draw(125,227);
     call draw(220,227);
     call draw(220,241);
     call draw(160,241);
     call draw(160,298);
     call draw(291,298);
     call draw(291,241);
     call draw(231,241);
     call draw(231,227);
     call draw(330,227);
     call draw(330,333);
 
     call move(353,333);   (* "gorny" parking *)
     call draw(353,107);
     call draw(488,107);
     call draw(488,123);
     call draw(463,123);
     call draw(463,143);
     call draw(522,143);
     call draw(522,123);
     call draw(497,123);
     call draw(497,107);
     call draw(590,107);
 
     call move(354,333);
     call draw(354,108);
     call draw(487,108);
     call draw(487,122);
     call draw(464,122);
     call draw(464,144);
     call draw(523,144);
     call draw(523,122);
     call draw(498,122);
     call draw(498,108);
     call draw(590,108);
 
     call move(9,84);          (* tory tramwajowe *);
     call draw(590,84);
     call move(9,86);
     call draw(590,86);
     call move(9,91);
     call draw(590,91);
     call move(9,93);
     call draw(590,93);
 
     call move(134,81);       (* przystanki *)
     call draw(174,81);
     call move(134,82);
     call draw(174,82);
     call move(288,95);
     call draw(328,95);
     call move(288,96);
     call draw(328,96);
 
     call move(600,20);      (* poglodowka *)
     call draw(715,20);
     call move(620,10);
     call draw(620,62);
     call move(680,20);
     call draw(680,62);
     call move(620,40);
     call draw(680,40);
     call move(617,16);
     call outhline(unpack("1"));
     call move(677,16);
     call outhline(unpack("2"));
     call move(617,36);
     call outhline(unpack("3"));
     call move(677,36);
     call outhline(unpack("4"));
     call move(595,80);
     call outhline(unpack("przejechalo"));
     call move(595,90);
     call outhline(unpack("pojazdow"));
     call ilep;
     call move(595,300);
     call outhline(unpack("SPACJA-menu"));
     call move(595,310);
     call outhline(unpack("Q   exit"));
     call move(595,320);
     call outhline(unpack("Z zmiany"));
 end mapa;
 
 
 unit ilep:procedure;
  var i:integer;
  begin
    for i:=1 to 4 do
      call move(595,90+i*10);
      call outhline(daj(i));
      call move(640,90+i*10);
      call outhline(daj(ile(i)));
    od;
 end ilep;
 
 
 unit start:procedure;(* strona tytulowa oraz zapamietanie   *)
   var i:integer;     (* wygladu samochodow                  *)
   begin
      call cirb(100,100,20,1,1,1,1,1,1);
      call cirb(100,120,20,1,1,1,1,1,1);
      call cirb(150,100,20,1,1,1,1,1,1);
      call cirb(150,120,20,3.8,1.6,1,1,1,1);
      call move(101,101);
      c(1):= getmap(111,104);  (* samochod poziomy  *)
      call move(101,101);
      c(2):= getmap(106,108);  (* samochod pionowy  *)
      call move(1,1);
      c(3):=getmap(11,4);
      call move(1,1);
      c(4):=getmap(6,8);
      call move(2,110);
      call outhline(unpack("Symulacja"));
      i:=inchar;
 end start;
 
 
 
 unit grtram:procedure;   (* rysowanie i zapamietanie tramwaju  *)
   begin
    call move(9,0);
    call draw(26,0);
    call move(0,1);
    call draw(27,1);
    call move(8,2);
    call draw(48,2);
    call move(0,3);
    call draw(27,3);
    call move(9,4);
    call draw(26,4);
    call move(30,0);
    call draw(47,0);
    call move(29,1);
    call draw(56,1);
    call move(29,3);
    call draw(56,3);
    call move(30,4);
    call draw(47,4);
 end grtram;
 
 
 unit semafv:procedure(x,y:integer,upp:boolean);
   begin   (* rysowanie pionowych sygnalizatorow "swiatel" *)
     if upp then y:=y+3 fi;
     call move(x,y);
     call draw(x+9,y);
     call draw(x+9,y+27);
     call draw(x,y+27);
     call draw(x,y);
     call move(x,y+9);
     call draw(x+9,y+9);
     call move(x,y+18);
     call draw(x+9,y+18);
     if upp then
       y:=y-30;
       call move(x,y+27);
       call draw(x+9,y+27);
     else
       call move(x,y+30);
       call draw(x+9,y+30);
     fi;
     call move(x+4,y+27);
     call draw(x+4,y+30);
     call move(x+5,y+27);
     call draw(x+5,y+30);
 end semafv;
 
 
 unit semafh:procedure(x,y:integer,upp:boolean);
   begin  (* rysowanie poziomych sygnalizatorow "swiatel" *)
     if upp then x:=x+3 fi;
     call move(x,y);
     call draw(x,y+9);
     call draw(x+27,y+9);
     call draw(x+27,y);
     call draw(x,y);
     call move(x+9,y);
     call draw(x+9,y+9);
     call move(x+18,y);
     call draw(x+18,y+9);
     if upp then
       x:=x-30;
       call move(x+27,y);
       call draw(x+27,y+9);
     else
       call move(x+30,y);
       call draw(x+30,y+9);
     fi;
     call move(x+27,y+4);
     call draw(x+30,y+4);
     call move(x+27,y+5);
     call draw(x+30,y+5);
 end semafh;
 
  unit ser:class(og:boolean,x,y:integer);
  (* klasa sygnalizator swietlny*)
  end ser;
 
(* 3 kolejne procedury to graficzne zapalanie swiatel na skrzyzowaniach *)
 
 unit semh:procedure(a:arrayof integer,s:integer);
   var x,y,i:integer;
     begin
       for i:=lower(a) to upper(a) do
         x:=sem(a(i)).x;
         y:=sem(a(i)).y;
         if not sem(a(i)).og then
           call seml(x,x+9,x+18,y,y,y,s);
         else
           call seml(x,x-9,x-18,y,y,y,s);
         fi;
      od;
 end semh;
 
 
 unit semv:procedure(a:arrayof integer,s:integer);
   var x,y,i:integer;
     begin
       for i:=lower(a) to upper(a) do
         x:=sem(a(i)).x;
         y:=sem(a(i)).y;
         if not sem(a(i)).og then
           call seml(x,x,x,y,y+9,y+18,s);
         else
           call seml(x,x,x,y,y-9,y-18,s);
         fi;
       od;
 end semv;
 
 
 unit seml :procedure(x1,x2,x3,y1,y2,y3,s:integer);
   begin
    case s
      when 0:call move(x1,y1);
             call hascii(0);
             call move(x2,y2);
             call hascii(0);
             call move(x3,y3);
             call hascii(42);
      when 1:call move(x3,y3);
             call hascii(0);
             call move(x2,y2);
             call hascii(42);
      when 2:call move(x2,y2);
             call hascii(0);
             call move(x1,y1);
             call hascii(42);
      when 3:call move(x2,y2);
             call hascii(42);
   esac;
end seml;
 
 
unit parking:procedure(ni:integer,bol:boolean);
  var i,j,k,b,x,y:integer;
  begin
   if ni=11 then x:=457;y:=127;
   else x:=162;y:=286;
   fi;
   k:=1;
   if bol then
     while park(ni,k) do k:=k+1 od;
     b:=2;
     park(ni,k):=true;
   else
     while not park(ni,k) do k:=k+1 od;
     b:=4;
     park(ni,k):=false;
   fi;
   j:=k div 15;
   i:=k mod 15;
   x:=x+9*i;
   y:=y-14*j;
   call move(x,y);
   call putmap(c(b));
end parking;
 
 
unit intoq:procedure(d,i:integer,bol:boolean);
                       (* rysowanie samochodu *);
  var a,b,x,y:integer;
  unit los:procedure;
    begin
    case d
      when  1:y:=76;x:=-2+i*12;
      when  2:y:=99;x:=102-i*12;
      when  3:y:=76;x:=110+i*12;
      when  4:y:=99;x:=330-i*12;
      when  5:y:=76;x:=341+i*12;
      when  6:y:=99;x:=590-i*12;
      when  7:y:=208;x:=110+i*12;
      when  8:y:=218;x:=330-i*12;
      when  9:x:=105;y:=204-i*12;
      when 10:x:=117;y:=95+i*12;
      when 11:x:=105;y:=333-i*12;
      when 12:x:=117;y:=214+i*12;
      when 13:x:=333;y:=204-i*12;
      when 14:x:=343;y:=95+i*12;
      when 15:x:=333;y:=333-i*12;
      when 16:x:=343;y:=214+i*12;
      when 17:x:=105;y:=70-i*12;
      when 18:x:=117;y:=-6+i*12;
      when 19:y:=76;x:=485+i*12;
      when 20:y:=99;x:=488-i*12;
      when 21:y:=76;x:=341+i*12;
      when 22:y:=99;x:=590-i*12;
      when 23:y:=208;x:=218+i*12;
      when 24:y:=218;x:=221-i*12;
      when 25:y:=208;x:=110+i*12;
      when 26:y:=218;x:=330-i*12;
    esac;
 
 end los;
 
  begin
    if i=/=0 then
      call los;
      call move(x,y);
      if d>8 and d<19 then b:=2 else b:=1 fi;
      if bol then
         call putmap(c(b));
      else
        call putmap(c(b+2));
      fi;
    fi;
  end intoq;
 
 var drogi,park:arrayof arrayof boolean;
 var i,j:integer;
 var sem:arrayof ser;
 
 begin
   array drogi dim (1:26);
   for i:=23 to 26 do
     array drogi(i) dim(1:8);
   od;
   for i:=11 to 16 do
     array drogi(i) dim(1:10);
   od;
   array drogi(1) dim(1:8);
   array drogi(2) dim(1:8);
   array drogi(3) dim(1:17);
   array drogi(4) dim(1:17);
   array drogi(5) dim(1:20);
   array drogi(6) dim(1:20);
   array drogi(7) dim(1:17);
   array drogi(8) dim(1:17);
   array drogi(9) dim(1:9);
   array drogi(10) dim(1:9);
   array drogi(13) dim(1:9);
   array drogi(14) dim(1:9);
   array drogi(17) dim(1:6);
   array drogi(18) dim(1:6);
   array drogi(19) dim(1:9);
   array drogi(20) dim(1:11);
   array drogi(21) dim(1:11);
   array drogi(22) dim(1:9);
   array c dim(1:6);
   array sem dim(1:13);
   array ile dim(1:4);
   for i:=1 to 4 do
      array c(i) dim(1:10);
   od;
   array c(5) dim(1:15);
   array c(6) dim(1:15);
   array park dim(10:11);
   array park(10) dim(1:60);
   array park(11) dim(1:6);
   call gron(1);    (* rysowanie planu skrzyzowan oraz sygnalizatorow *)
   call start;
   call grtram;
   call move(0,0);
   c(5):=getmap(56,4);
   call mapa;
   call move(100,83);
   c(6):=getmap(140,87);
   call semafv(90,35,true);
   sem(1):=new ser(true,91,57);
   call semafv(90,170,true);
   sem(2):=new ser(true,91,192);
   call semafv(127,229,false);
   sem(3):=new ser(false,128,230);
   call semafv(127,110,false);
   sem(4):=new ser(false,128,111);
   call semafv(318,170,true);
   sem(5):=new ser(true,319,192);
   call semafv(356,229,false);
   sem(6):=new ser(false,357,230);
   call semafv(356,110,false);
   sem(7):=new ser(false,357,111);
   call semafh(127,56,false);
   sem(8):=new ser(false,128,57);
 
   call semafh(356,56,false);
   sem(9):=new ser(false,357,57);
   call semafh(70,110,true);
   sem(10):=new ser(true,92,111);
   call semafh(298,110,true);
   sem(11):=new ser(true,320,111);
   call semafh(127,191,false);
   sem(12):=new ser(false,128,192);
   call semafh(298,229,true);
   sem(13):=new ser(true,320,230);
 end graf;
 
 
 
unit droga:simulation class;
 unit zmiany:procedure;
 const qord=113;
 const zord=122;
 const sord=115;
 const oord=111;
 const bord=98;
 var k,l:integer;
 var t:real;
 begin
   t:=time;
   k:=1;
   while k=/=0 do
     k:=gr.inkey;
   od;
   while k=0 do
     k:=gr.inkey;
   od;
   case k
     when qord:call gr.groff;
               call endrun;
     when zord:call change;
   esac;
 end zmiany;
 
 unit change:procedure;
 var x,y,i:integer;
 begin
   call gr.move(595,150);
   call gr.outhline(unpack("ktore skrzyz."));
   i:=gr.cyfra(gr.inhline(600,160,1));
   if i>0 and i<5 then
     call gr.move(595,170);
     call gr.outhline(unpack("zielone ?"));
     cros(i) qua cross.htim:=gr.cyfra(gr.inhline(600,180,2));
     call gr.move(595,190);
     call gr.outhline(unpack("zolte ?"));
     cros(i) qua cross.otim:=gr.cyfra(gr.inhline(600,200,2));
     call gr.move(595,210);
     call gr.outhline(unpack("czerwone ?"));
     cros(i) qua cross.vtim:=gr.cyfra(gr.inhline(600,220,2));
   fi;
   for i:=1 to 8 do
     call gr.move(594,140+i*10);
     call gr.outhline(unpack("              "));
   od;
 end change;
 
 
 unit cross:simprocess class;(* skrzyzowanie *);
   var co,ro,sh,sv:arrayof integer;
   var qu         :arrayof kolej;
   var openz,tr    :arrayof boolean;
   var vtim,htim,otim,sctim   :integer;(* czas swiecenia sygnalizatora *);
   var sigsta     :integer;(* stan sygnalizatorow na skrzyzowaniu *);
   var ver,hor    :integer;(* liczba kolejek pionowych  i poziomych *);
   var bzi        :integer;
     unit outfrom:procedure(a,b:integer);(* wypychanie samochodow z kolejek *);
       var i:integer;
       var ok :boolean;
       begin
        ok:=true;
        while time<=sctim and ok do
          ok:=false;
          for i:=a to b do
            if not qu(i).endc then call run (qu(i).firstq);ok:=true; fi;
          od;
        od;
     end outfrom;
 
     begin
      otim:=5;
      array tr dim (1:2);
      array openz dim(1:2);
      do
       bzi:=gr.inkey;
       if bzi=32 then call zmiany fi;;
       sigsta:=(sigsta + 1) mod 4;(* zmiana swiatel*);
       call gr.semh(sh,sigsta);
       call gr.semv(sv,(sigsta+2)mod 4);
       call gr.ilep;
       case sigsta
          when 0:openz(1):=true;
                if tr(1) then tr(1):=false;call run(tramm(1)) fi;
                if tr(2) then tr(2):=false;call run(tramm(2)) fi;
                sctim:=time+htim;
                call outfrom(1,hor);
         when 1: openz(1):=false;
                 sctim:=time+otim;
         when 2: openz(2):=true;
                 sctim:=time+vtim;
                 call outfrom(hor+1,ver+hor);
         when 3: openz(2):=false;
                 sctim:=time+otim;
       esac;
       call schedule(this cross,sctim);
     od;
   end cross;
 
 
   unit wolno:function(a,b:integer):integer;(* obliczenie miejsca     *)
     var bol:boolean;                       (* stania na skrzyzowaniu *)
       begin
       if a>0 and a<5 then
         case a
           when 1,2 :if b>8 and b<19 then
                       bol:=cros(a) qua cross.openz(2);
                       result:=b mod 2 +3
                     else
                       bol:=cros(a) qua cross.openz(1);
                       result:=b mod 2 +1;
                     fi;
           when 3,4 :if (b<9 or b>18) and b=/=0 then
                       result:=1;
                       bol:=cros(a) qua cross.openz(1);
                     else
                       result:=b mod 2 +2;
                       bol:=cros(a) qua cross.openz(2);
                     fi;
         esac;
         if bol then  (*and cros(a) qua cross.qu(result).endc*)
           result:=0;
         fi;
       else result:=0;
       fi;
   end wolno;
 
 
   unit wyjazd:simprocess class;
     var co,ro:arrayof integer;
   end wyjazd;
 
   unit parking:simprocess class(poj:integer);
     var co,ro:arrayof integer;
     var cars:integer;
     unit park :procedure(a:car);
       var i:integer;
       begin
         if cars<poj then
           cars:=cars+1;
           a.bol:=true;
           a.stp:=a.nr;
           while a.finp=a.stp do
             a.finp:=random*7+5;    (* losowanie wyjazdu *)
           od;
           call gr.parking(a.nr,true);
           i:=150+random*360;
           call schedule(a,time+i);
         else
           a.bol:=false;
           if a.nr=10 then a.finp:=11 else  a.finp:=10 fi;
           call schedule(a,time+2);
         fi;
     end park;
   end parking;
 
   unit kolej:class(nr:integer);
   var il:integer;
    unit elcar:class(p:car);
      var next:elcar;
    end elcar;
    var first,last:elcar;
 
    unit insert :procedure(p:car);
    begin
      if first=none then
        first,last:=new elcar(p);
      else
         last.next:=new elcar(p);
        last:=last.next;
      fi;
      il:=il+1;
    end insert;
 
    unit firstq:function:car;
     begin
      if first=/=none then
        result:=first.p;
        if first.next=/=none then
          first:=first.next;
        else first:=none;last:=none;
        fi;
        if il>0 then
          il:=il-1;
        fi;
      fi;
   end firstq;
 
   unit endc:function:boolean;
     begin
      result:=(first=none);
   end endc;
 
   begin (* kolej *)
         il:=0;
   end kolej;
 
 
 unit road:class(distance,line,speed:integer);(* droga *)
     var cars       :integer;
 end road;
 
 
  unit rotime: function (d,s:integer):integer;(* czas pokonania danej drogi *);
   var min:integer;
     begin
       if s < roads(d).speed then min := s
       else min:=roads(d).speed;
       fi;
(*result:=roads(d).distance*3.6*((1+.1*roads(d).cars)/10*roads(d).line)/min;*)
   result:=30;
   end rotime;
 
  unit car:simprocess class(max:integer);
   var stp,finp,old,where,nr,nero,wol:integer;
   var tim,bla,ble,zw:integer;
   var bol:boolean;
 
   unit jedziecar:procedure(d,t:integer);
   var j,k,tim:integer;
     begin
       case d
         when 1,2:j:=7;
         when 3,4,7,8:j:=16;
         when 5,6:j:=19;
         when 9,10,13,14,19,22:j:=8;
         when 17,18:j:=5;
         when 11,12,15,16:j:=9;
 
         when 20,21:j:=10;
         when 23,24,25,26:j:=7;
       esac ;
       tim:=t/j;
       for k:=j downto 1 do
         if not gr.drogi(d,k) then
           gr.drogi(d,k):=true;
           gr.drogi(d,k+1):=false;
           call gr.intoq(d,k+1,false);
           call gr.intoq(d,k,true);
           zw:=k;
         fi;
         call hold(tim);
       od;
   end jedziecar;
 
   begin  (*  algorytm   car *)
      do
         finp,stp:=random*5+5;  (*losowanie wjazdu *)
         while finp=stp do
             finp:=random*7+5;    (* losowanie wyjazdu *)
         od;
         tim:=360+random*360;   (* czas pierwszego pojawienia sie *)
         call schedule(this car,time+tim);
         old:=0;
         bol:=false;
         nr:=stp;
         where:=nr;             (* gdzie jest *)
         do
             nr:=where;
             if nr=finp then       (* czy dojechal do wyjazdu *)
                if old=/=0  then
                    call gr.intoq(old,zw,false);
                    gr.drogi(old,zw):=false;
                fi;
                if nr>9 then call cros(nr) qua parking.park(this car);
                    if bol then call gr.parking(nr,false);
                      cros(nr) qua parking.cars:=cros(nr) qua parking.cars-1;
                    fi;
                else exit
                fi;
             fi;
             case nr     (* co robic w zaleznosci od miejsca pobytu *)
             when 1,2,3,4  : where:=cros(nr) qua cross.co(finp);
                (*skrzyzowanie *)
                nero:=cros(nr) qua cross.ro(where);
                gr.ile(nr):=gr.ile(nr)+1;
             when 5,6,7,8,9: where:=cros(nr) qua wyjazd.co(finp);
                 (*wyjazd-wjazd *)
                 nero:=cros(nr) qua wyjazd.ro(where);
             when 10,11    : where:=cros(nr) qua parking.co(finp);
                  (*parking *)
                   nero:=cros(nr) qua parking.ro(where);
             esac;
             wol:=wolno(nr,old);
             if wol=/=0 then
                 call cros(nr) qua cross.qu(wol).insert(this car);
       call passivate;
     fi;
     tim:=rotime(nero,max);
     roads(nero).cars:=roads(nero).cars+1;
      if old=/=0 and nr=/=10 and nr=/=11 then
         call gr.intoq(old,zw,false);
         gr.drogi(old,zw):=false;
     fi;
 
     call jedziecar(nero,tim);
     old:=nero;
     roads(nero).cars:=roads(nero).cars-1;
    od;
  od;
  end car;
 
  unit tram:simprocess class(a:integer);
    var b,i,y,x1,x2:integer;
    var t:arrayof integer;
    unit jazda:procedure(d:integer);
      var x,p,i:integer;
      var bol:boolean;
      begin
        p:=8;
        if a=1 then
          bol:=true;
        else
          p:=-8;
        fi;
        case d
          when 1:d:=15;x:=125;
          when 2:d:=7;x:=10;
          when 3:d:=29;x:=349;
          when 4:d:=29;x:=58;
          when 5:d:=24;x:=533;
          when 6:d:=32;x:=282;
        esac;
        for i:=1 to d do
          call gr.move(x,y);
          call gr.putmap(gr.c(5));
          x:=x+p;
          call hold(2);
        od;
      end jazda;
    begin
      array t dim(1:5);
      if a=1 then
       t(1),t(4):=2;
       t(2):=1;
       t(3):=4;
       t(5):=6;
     else
       t(1):=5;
       t(2):=2;
       t(3):=3;
       t(4),t(5):=1;
     fi;
     if a=1 then y:=90;x2:=538
     else y:=83;x2:=21; fi;
     do
       b:=random*60+60;
       call schedule(this tram,time+b);
       call jazda(t(1));
       if wolno(t(2),t(1))=/=0 then
         cros(t(2)) qua cross.tr(a):=true;
         call passivate;
       fi;
       call jazda(t(3));
       call hold(30);
       if not cros(t(4)) qua cross.openz(1) then
         cros(t(4)) qua cross.tr(a):=true;
         call passivate;
       fi;
       call jazda(t(5));
       call gr.move(x2,y);
       call gr.putmap(gr.c(6));
       call hold(60);
     od;
  end tram;
 
 
  unit gencar:simprocess class;(* generator samochodow *);
    var t,i,b:integer;
    var p:car;
    begin
     for i:=1 to 10 do   (******?????bylo 20  ????*****)
      t:=random*36;
      b:=random*(41)+60;
      p:=new car(b);
      call schedule(p,t);
    readln ; (* to ja ???????????*)
    od;
    readln ; (* to ja ???????????*)
 
    for i:=1 to 4 do
      call schedule(cros(i),time+i);
    od;
    call schedule(tramm(1),time+3);
    call schedule(tramm(2),time+4);
    call hold(6000);
    call run(mainpr)
  end gencar;
 
  var i,j:integer,
      g:gencar,
      cros :arrayof simprocess,
      roads  :arrayof road,
      tramm:arrayof tram,
      gr:graf;
 
  unit prepkol:procedure;
  begin
   array cros(1) qua cross.qu dim(1:4);
   array cros(2) qua cross.qu dim(1:3);
   array cros(3) qua cross.qu dim(1:3);
   array cros(4) qua cross.qu dim(1:3);
   cros(1) qua cross.qu(1):=new kolej(2);
   cros(1) qua cross.qu(2):=new kolej(3);
   cros(1) qua cross.qu(3):=new kolej(10);
   cros(1) qua cross.qu(4):=new kolej(17);
   cros(2) qua cross.qu(1):=new kolej(4);
   cros(2) qua cross.qu(2):=new kolej(5);
   cros(2) qua cross.qu(3):=new kolej(14);
   cros(3) qua cross.qu(1):=new kolej(7);
   cros(3) qua cross.qu(2):=new kolej(12);
   cros(3) qua cross.qu(3):=new kolej(9);
   cros(4) qua cross.qu(1):=new kolej(8);
   cros(4) qua cross.qu(2):=new kolej(16);
   cros(4) qua cross.qu(3):=new kolej(13);
  end prepkol;
 
 
  unit preproad:procedure;
  begin
     array roads  dim(1:26);
     roads(1):=new road(90,1,90);
     roads(2):=new road(90,1,90);
     roads(3):=new road(400,1,80);
     roads(4):=new road(400,1,80);
     roads(5):=new road(400,1,90);
     roads(6):=new road(400,1,90);
     roads(7):=new road(400,1,70);
     roads(8):=new road(400,1,70);
     roads(9):=new road(200,1,70);
 
     roads(10):=new road(200,1,70);
    roads(11):=new road(220,1,70);
    roads(12):=new road(220,1,70);
    roads(13):=new road(200,1,70);
    roads(14):=new road(200,1,70);
    roads(15):=new road(220,1,70);
    roads(16):=new road(220,1,70);
    roads(17):=new road(100,1,70);
    roads(18):=new road(100,1,70);
    roads(19):=new road(160,1,90);
    roads(20):=new road(240,1,90);
    roads(21):=new road(240,1,90);
    roads(22):=new road(160,1,90);
    roads(23):=new road(200,1,70);
    roads(24):=new road(200,1,70);
    roads(25):=new road(200,1,70);
    roads(26):=new road(200,1,70);
  end preproad;
 
  begin
    gr:=new graf;
    array cros dim(1:11);
    for i:=1 to 4 do
      cros(i):=new cross;
    od;
    for i:=5 to 9 do
      cros(i):=new wyjazd;
    od;
    cros(10):=new parking(60);
    cros(11):=new parking(6);
    array tramm dim(1:2);
    tramm(1):=new tram(1);
    tramm(2):=new tram(2);
 
    call preproad;
    array cros(1) qua cross.sh dim(1:2);
    array cros(2) qua cross.sh dim(1:2);
    array cros(3) qua cross.sh dim(1:1);
    array cros(4) qua cross.sh dim(1:1);
    array cros(1) qua cross.sv dim(1:2);
    array cros(2) qua cross.sv dim(1:1);
    array cros(3) qua cross.sv dim(1:2);
    array cros(4) qua cross.sv dim(1:2);
    for i:=1 to 4 do
      cros(i) qua cross.hor:=1;
      cros(i) qua cross.ver:=2;
    od;
    cros(1) qua cross.hor:=2;
    cros(2) qua cross.hor:=2;
    cros(2) qua cross.ver:=1;
    cros(1) qua cross.sh(1):=8;
 
    cros(1) qua cross.sh(2):=10;
    cros(2) qua cross.sh(1):=9;
    cros(2) qua cross.sh(2):=11;
    cros(3) qua cross.sh(1):=12;
    cros(4) qua cross.sh(1):=13;
    cros(1) qua cross.sv(1):=1;
    cros(1) qua cross.sv(2):=4;
    cros(2) qua cross.sv(1):=7;
    cros(3) qua cross.sv(1):=2;
    cros(3) qua cross.sv(2):=3;
    cros(4) qua cross.sv(1):=5;
    cros(4) qua cross.sv(2):=6;
    for i:=1 to 4 do
      array cros(i) qua cross.co dim (5:11);
    od;
    for i:=5 to 9 do
      array cros(i) qua wyjazd.co dim (5:11);
    od;
    array cros(10) qua parking.co dim (5:11);
    array cros(11) qua parking.co dim (5:11);
    for i:=5 to 11 do
      cros(1) qua cross.co(i):=2;
      cros(2) qua cross.co(i):=1;
      cros(3) qua cross.co(i):=1;
      cros(4) qua cross.co(i):=2;
      cros(5) qua wyjazd.co(i):=3;
      cros(6) qua wyjazd.co(i):=4;
      cros(7) qua wyjazd.co(i):=2;
      cros(8) qua wyjazd.co(i):=1;
      cros(9) qua wyjazd.co(i):=1;
      cros(10) qua parking.co(i):=3;
      cros(11) qua parking.co(i):=2;
   od;
   cros(1) qua cross.co(5):=3;
   cros(1) qua cross.co(8):=8;
   cros(1) qua cross.co(9):=9;
   cros(1) qua cross.co(10):=3;
   cros(2) qua cross.co(6):=4;
   cros(2) qua cross.co(7):=7;
   cros(2) qua cross.co(10):=4;
   cros(2) qua cross.co(11):=11;
   cros(3) qua cross.co(5):=5;
   cros(3) qua cross.co(6):=4;
    cros(3) qua cross.co(10):=10;
    cros(4) qua cross.co(5):=3;
    cros(4) qua cross.co(6):=6;
    cros(4) qua cross.co(10):=10;
    cros(7) qua wyjazd.co(11):=11;
    cros(10) qua parking.co(6):=4;
    cros(10) qua parking.co(7):=4;
    cros(10) qua parking.co(11):=4;
    cros(11) qua parking.co(7):=7;
    array cros(1) qua cross.ro dim(2:9);
    array cros(2) qua cross.ro dim(1:11);
    array cros(3) qua cross.ro dim(1:10);
    array cros(4) qua cross.ro dim(2:10);
    array cros(5) qua wyjazd.ro dim(3:3);
 
   array cros(6) qua wyjazd.ro dim(4:4);
   array cros(7) qua wyjazd.ro dim(2:11);
   array cros(8) qua wyjazd.ro dim(1:1);
   array cros(9) qua wyjazd.ro dim(1:1);
   array cros(10) qua parking.ro dim(3:4);
   array cros(11) qua parking.ro dim(2:7);
   cros(1) qua cross.ro(2):=4;
   cros(1) qua cross.ro(3):=9;
   cros(1) qua cross.ro(8):=18;
   cros(1) qua cross.ro(9):=1;
   cros(2) qua cross.ro(1):=3;
   cros(2) qua cross.ro(4):=13;
   cros(2) qua cross.ro(7):=6;
   cros(2) qua cross.ro(11):=20;
   cros(3) qua cross.ro(1):=10;
   cros(3) qua cross.ro(4):=8;
   cros(3) qua cross.ro(5):=11;
   cros(3) qua cross.ro(10):=24;
   cros(4) qua cross.ro(2):=14;
   cros(4) qua cross.ro(3):=7;
   cros(4) qua cross.ro(6):=15;
   cros(4) qua cross.ro(10):=23;
 
   cros(5) qua wyjazd.ro(3):=12;
   cros(6) qua wyjazd.ro(4):=16;
   cros(7) qua wyjazd.ro(2):=5;
   cros(7) qua wyjazd.ro(11):=19;
        cros(8) qua wyjazd.ro(1):=17;
        cros(9) qua wyjazd.ro(1):=2;
        cros(10) qua parking.ro(3):=25;
        cros(10) qua parking.ro(4):=26;
        cros(11) qua parking.ro(2):=21;
        cros(11) qua parking.ro(7):=22;
        cros(1) qua cross.htim:=60;
        cros(1) qua cross.vtim:=30;
        cros(2) qua cross.htim:=60;
        cros(2) qua cross.vtim:=30;
        cros(3) qua cross.htim:=40;
        cros(3) qua cross.vtim:=50;
        cros(4) qua cross.htim:=40;
        cros(4) qua cross.vtim:=50;
        cros(1) qua cross.sigsta:=0;
        cros(2) qua cross.sigsta:=0;
        cros(3) qua cross.sigsta:=0;
        cros(4) qua cross.sigsta:=0;
        call prepkol;
        readln;
        g:=new gencar;
        readln;    (*??????? to ja  ????? *)
        call run(g);
   end droga;
 
begin
  pref droga block
  begin
      call hold(6000);
      end;
  end;
  call gr.groff;
end;