BLOCK
 
(*****************************************************************************)
(********************************** F I F O **********************************)
(*****************************************************************************)
 
unit FIFO : class ( type T);
 
     var HEAD,LAST : ELEM;
 
  unit   ELEM : class ( INFO : T);
      var NEXT : ELEM;
     begin
     end ELEM;
 
     unit EMPTY : function : boolean;
      begin
       result := (HEAD=NONE)
     end
 
     unit INTO : procedure ( INFO : T );
      begin
       if EMPTY then
        HEAD := new ELEM(INFO);
        LAST := HEAD
       else
       LAST.NEXT := new ELEM(INFO);
       LAST := LAST.NEXT
      (* fi *)
     end INTO;
 
     unit FIRST : function : T;
      begin
       result.a := HEAD.INFO   (*!!!!!!!!*)
     end FIRST;
 
     unit OUT_FIRST : procedure;
      var HLP : ELEM;
      begin
       if not EMPTY then
        HLP := HEAD;
        HEAD := HEAD.NEXT
       fi
     end OUT_FIRST;
 
     unit CARDINAL : function : integer;
      var HLP : ELEM;
      begin
      HLP := HEAD;
      while HLP <> NONE do
       result :=result + 1;
       HLP := HLP.NEXT
      od
     end CARDINAL;
 
 end FIFO;
 
 
(*****************************************************************************)
(************************** E N D      F I F O *******************************)
(*****************************************************************************)
 
(*                       *   *   *   *   *   *    *                          *)
 
(*****************************************************************************)
(************************* S I M U L A T I O N *******************************)
(*****************************************************************************)
 
UNIT PRIORITYQUEUE: IIUWGRAPH  CLASS;
 
     UNIT QUEUEHEAD: CLASS;
        (* HEAP ACCESING MODULE *)
             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,right usunieto*)  ROOT.LEFT,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;
     Z:=LAST.LEFT;
     IF LAST.NS =0 THEN
           Y:= Z.UP;
           if y<>none then Y.RIGHT:= LAST else root :=none fi; (**10-93***)
           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;
       (**** poprawka  10-93 ******)
       z.left.right := none;
       z.ns := 0;
       z.left, z.right, z.up := none;
       IF X.LESS(X.UP) THEN CALL CORRECT(X.EL,FALSE)
                       ELSE CALL CORRECT(X.EL,TRUE) 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 *)
(**** poprawka 10-93 *********)
hidden Mmainpr, curr, pq;
 
  VAR CURR: SIMPROCESS,  (*ACTIVE PROCESS *)
      PQ:QUEUEHEAD,  (* THE TIME AXIS *)
       MAINPR: MAINPROGRAM;
 
 
   unit
        SIMPROCESS: COROUTINE;
        (* USER PROCESS PREFIX *)
        (***** poprawka 10-93 **********)
        hidden event, eventaux, finish;
 
             VAR EVENT,  (* ACTIVATION MOMENT NOTICE *)
                 EVENTAUX: EVENTNOTICE,
                 (* THIS IS FOR AVOIDING MANY NEW CALLS AS AN RESULT OF *)
                 (* SUBSEQUENT PASSIVATIONS AND ACTIVATIONS             *)
                 FINISH: BOOLEAN;
 
             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 ERROR1; FI;
                    RESULT:= EVENT.EVENTTIME;
                  END EVTIME;
    handlers
       when ERROR1 :
               WRITELN(" AN ATTEMPT TO ACTIVATE AN IDLE PROCESS TIME");
               attach(main);
       when ERROR2 :
               WRITELN(" AN ATTEMPT TO ACTIVATE A TERMINATED PROCESS TIME");
               attach(MAIN);
   end handlers;
 
     BEGIN
             RETURN;
             INNER;
             FINISH:=TRUE;
             CALL PASSIVATE;
             raise ERROR2;
     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 PROGRAM 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 AND DEFINITION OF "PRIOR"- PRIORITY *)
 (* WITHIN TIME MOMENT T                                                  *)
      BEGIN
      (*** poprawka 10-93 *****)
      if p.terminated then raise ERROR2 fi;
 
      IF T<TIME THEN T:= TIME FI;
      IF P=CURRENT THEN CALL HOLD(T-TIME) ELSE
      IF P.IDLE AND P.EVENTAUX=NONE THEN (* HAS NOT BEEN SCHEDULED YET*)
                P.EVENT,P.EVENTAUX:= NEW EVENTNOTICE(RANDOM);
                P.EVENT.PROC:= P;
                                      ELSE
       IF P.IDLE (* P HAS ALREADY BEEN SCHEDULED *) THEN
               P.EVENT:= P.EVENTAUX;
               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 THE current 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.EVENTAUX=NONE THEN
            P.EVENT,P.EVENTAUX:=NEW EVENTNOTICE(0);
        ELSE
             P.EVENT:=P.EVENTAUX;
             P.EVENT.PRIOR:=0;
        fi;
             P.EVENT.EVENTTIME:=TIME;
             P.EVENT.PROC:=P;
             CALL PQ.INSERT(P.EVENT);
      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 *)
   BEGIN
  (**** poprawka 10-93 ****)
   CURR:= PQ.MIN QUA EVENTNOTICE.PROC;
    IF CURR=NONE THEN WRITE(" ERROR IN THE HEAP"); WRITELN;
                      ATTACH(MAIN);
                 ELSE ATTACH(CURR); FI;
END CHOICEPROCESS;
 
BEGIN
  PQ:=NEW QUEUEHEAD;  (* SIMULATION TIME AXIS*)
  CURR,MAINPR:=NEW MAINPROGRAM;
  MAINPR.EVENT,MAINPR.EVENTAUX:=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;
 
(*****************************************************************************)
(************************ E N D      S I M U L A T I O N *********************)
(*****************************************************************************)
 
 
 
begin
  pref iiuwgraph block
 
   BEGIN
     PREF  SIMULATION BLOCK
     const pojemnosc=30;
     var
       autobusy:arrayof bus,
       przystan:arrayof przystanek,
       inf:info,cl:zegar,
       ws:integer,
       c:char,
       praz:boolean,
       i,j,p,czas_sym,czas,ilosc_przystankow,
       ilosc_auto,czestosc,odstep1,odstep2,podst1,podst2:integer;
 
     unit wsp:class(x,y,i:integer);
       begin
       end wsp;
 
     unit nast:function(w:wsp):wsp;
       var pom:wsp;
       begin
         if w.i <= ilosc_przystankow div 2
         then
           pom:=new wsp(w.x,w.y - odstep1,i mod ilosc_przystankow +1)
         else
           if w.x>550
           then
             pom:=new wsp(600-w.x,20,i mod ilosc_przystankow+1)
           else
             pom:=new wsp(w.x,w.y+odstep1,i mod ilosc_przystankow+1)
           fi
         fi;
         result:=pom
       end nast;
 
     unit bus:simprocess class;
       var i,j,kier,wolnych_miejsc:integer,
           ws:wsp,
           wsiadajacy:pasazer;
       begin
         wolnych_miejsc:=pojemnosc;
         praz:=true;
         i:=1;
         ws:=new wsp(480,320-odstep1,1);
         do
           if przystan(i).ws.x=510
           then ws.x:=480
           else ws.x:=420
           fi;
           ws.y:=przystan(i).ws.y;
           ws.i:=i;
           call ruch(ws,true) ;
           praz:=false;
           wolnych_miejsc:=wolnych_miejsc +
                 entier(random*(pojemnosc-wolnych_miejsc)*exp(i / pojemnosc));
           if wolnych_miejsc>pojemnosc then wolnych_miejsc:=pojemnosc fi;
           while (wolnych_miejsc > 0) and (not przystan(i).kolejka.empty)
           do
             wsiadajacy:=przystan(i).kolejka.first;
             if (ilosc_przystankow div 2-i)>=0 then kier:=1
             else kier:=-1
             fi;
             call usun(przystan(i).ws.x,przystan(i).ws.y,
                       kier*przystan(i).kolejka.cardinal);
             call przystan(i).kolejka.out_first;
             wolnych_miejsc:=wolnych_miejsc - 1;
             call run(wsiadajacy);
             call run(inf);
             kill(wsiadajacy)
           od;
         call ruch(ws,false);
         call hold(przystan(i).czas_do_nast);
         i:=i mod ilosc_przystankow + 1;
        od
     end bus;
 
     unit pasazer:simprocess class(nr:integer);
       var czas_przyjscia,czas_oczekiwania:integer;
       begin
         czas_przyjscia:=time;
         call passivate;
         czas_oczekiwania:=time-czas_przyjscia;
         przystan(nr).laczny_czas:=przystan(nr).laczny_czas +
                                   czas_oczekiwania;
         przystan(nr).sredniczas:=przystan(nr).laczny_czas /
                                  przystan(nr).total
       end pasazer;
 
 
     unit przystanek:simprocess class(nr:integer);
       var
         kolejka:FIFO,
         new_pas:pasazer,
         ws:wsp,
         kier,ilosc_pas,total,laczny_czas,czas_do_nast:integer,
         sredniczas:real;
       begin
         kolejka:=new FIFO(pasazer);
         czas_do_nast:=3;
         if nr<=ilosc_przystankow div 2 then
 
           ws:=new wsp(510,290-podst1-(nr-1)*odstep1,nr)
         else
 
           ws:=new wsp(390,podst2+(nr-ilosc_przystankow div 2-1)*odstep2,nr)
         fi;
         if ws.x>450 then call move(ws.x-15,ws.y+10)
         else call move(ws.x,ws.y+10) fi;
         call wypisz(ws.i);
         call hold(3*ilosc_przystankow);
         do
           call hold(2*abs(nr-ilosc_przystankow div 2)+1);
           new_pas:=new pasazer(nr);
           total:=total+1;
           call kolejka.into(new_pas);
           if (ilosc_przystankow div 2-nr)>=0 then kier:=1
           else kier:=-1
           fi;
           call kol(ws.x,ws.y,kier*kolejka.cardinal);
           call schedule(new_pas,time);
         od;
       end przystanek;
 
 
 (*------------------------------------------------------------------------*)
 (*--------------------  PROCEDURY POMOCNICZE  ----------------------------*)
 (*------------------------------------------------------------------------*)
 
   unit ludzik:procedure(x,y:integer);
     begin
       call move(x,y);
       call draw(x,y+6);
       call draw(x-2,y+10);
       call move(x,y+6);
       call draw(x+2,y+10);
       call move(x-2,y+2);
       call draw(x+2,y+2);
       call move(x-2,y+2);
       call draw(x-4,y+4);
       call move(x+2,y+2);
       call draw(x+4,y+4)
     end;
 
 
   unit usun:procedure(x,y,m:integer);
     var i:integer;
     begin
       if m<=15
       then
       call color(0);
       call ludzik(x+8*m,y);
       call color(1)
       fi
     end;
 
   unit kol:procedure(x,y,m:integer);
     var i:integer;
     begin
      if m<=15
      then
       call ludzik(x+8*m,y)
      fi
     end;
 
 
    unit wypisz:iiuwgraph procedure(x:integer);
        unit CHRTYP :function ( x:integer):string;
           (* zamiana liczby na tekst *)
          begin
          case x
            when 1 : result:="1";
            when 2 : result:="2";
            when 3 : result:="3";
            when 4 : result:="4";
            when 5 : result:="5";
            when 6 : result:="6";
            when 7 : result:="7";
            when 8 : result:="8";
            when 9 : result:="9";
            when 0 : result:="0"
         esac
       end;
     begin
       if x<0 then call outstring("ujemna liczba")
       else
         call outstring(chrtyp(x div 10));
         call outstring(chrtyp(x mod 10))
       fi
     end wypisz;
 
 
    unit zegar:simprocess class;
      var i,j:integer;
      begin
        do
          call ramka(420,310,480,335);
          call ramka(422,312,478,333);
          call ramka(421,311,479,334);
          call move(433,320);
          call wypisz(i);
          call outstring(":");
          call wypisz(j);
          j:=j+1;
          if j=60 then j:=0;i:=i+1 fi;
          call hold(1)
        od
      end zegar;
 
 
    unit info:simprocess class;
      var i:integer;
      begin
        call ramka(0,0,280,140+10*ilosc_przystankow);
        call ramka(1,1,281,141+10*ilosc_przystankow);
        call move(10,50);
        call outstring("Pojemnosc wozu:");
        call outstring("30 os.");
        call move(10,70);
        call outstring("Czas przejazdu miedzy");
        call move(10,80);
        call outstring("przystankami:");
        call outstring("  3 min.");
        call move(10,10);
        call outstring("Czas symulacji:");
        if czas_sym div 60=/=0
        then
          call wypisz(czas_sym div 60);
          call outstring(" godz. ")
        fi;
        call wypisz(czas_sym mod 60);
        call outstring(" min.");
        call move(10,30);
        call outstring("Czestotliwosc kursowania:");
        call wypisz(czestosc);
        call outstring(" min.");
        call move(140,100);
        call outstring("Sr. czas ");
        call move(140,110);
        call outstring("oczekiwania:");
        call move(30,100);
        call outstring("Przys.");
        call move(30,110);
        call outstring("nr");
        call outstring("  ");
        call move(90,100);
        call outstring("Ilosc");
        call move(90,110);
        call outstring("ludzi");
        call ramka(490,5,610,20);
        call move(500,10);
        call outstring("Esc - koniec.");
      do
      if inkey=27 then call run(mainpr) fi;
      for i:=1 to ilosc_przystankow
      do
        call move(30,120+i*10);
        call wypisz(i);
        call outstring("      ");
        call wypisz(przystan(i).kolejka.cardinal);
        call outstring("    ");
        call wypisz(entier(przystan(i).sredniczas));
        call outstring(".");
        call wypisz(entier(przystan(i).sredniczas*10) mod 10);
        call outstring(" min.  ")
      od;
      call hold(0.5)
    od
  end;
 
 
 
 unit ramka:iiuwgraph procedure(x1,y1,x2,y2:integer);
   begin
     call move(x1,y1);
     call draw(x2,y1);
     call draw(x2,y2);
     call draw(x1,y2);
     call draw(x1,y1)
   end ramka;
 
 
 unit pr:procedure(x,y,dx,dy:integer);
   begin
     call ramka(x-dx div 2,y-dy div 2,x+dx div 2,y+dy div 2)
   end pr;
 
 unit auto:procedure(x,y:integer);
   begin
     call pr(x,y,8,18);
     call pr(x,y,10,20);
     call pr(x,y,10,2)
   end auto;
 
 
 unit ruch:procedure(ws:wsp,jak:boolean);
   var j:integer;
   begin
      if jak
      then
        if praz andif ws.i=1 then call auto(ws.x+10,ws.y) fi;
        if ws.i>1 andif ws.i<=ilosc_przystankow div 2
        then
          call color(0);
          call auto(ws.x,ws.y+odstep1-odstep1 div 2);
          for j:=0 to odstep1-odstep1 div 2
          do
            call color(1);
            call auto(ws.x,ws.y+odstep1-odstep1 div 2-j);
            call color(0);
            call auto(ws.x,ws.y+odstep1-odstep1 div 2-j);
          od;
          call color(1);
          call auto(ws.x+10,ws.y);
        else
          if ws.i=ilosc_przystankow div 2 +1
          then
            call color(0);
            call auto(480,290-podst1-(ws.i-2)*odstep1-odstep1 div 2);
            call color(1);
            call auto(ws.x-10,ws.y);
          else
            if ws.i=1 andif (not praz)
            then
              call color(0);
              call auto(420,(ilosc_przystankow-ilosc_przystankow div 2-1)*
                             odstep2 + podst2 + odstep2 div 2);
              call color(1);
              call auto(ws.x+10,ws.y);
            else
              if ws.i>ilosc_przystankow div 2
              then
                call color(0);
                call auto(420,ws.y+odstep2 div 2-odstep2);
                for j:=1 to odstep2-odstep2 div 2
                do
                  call color(1);
                  call auto(ws.x,ws.y+j-odstep2+odstep2 div 2);
                  call color(0);
                  call auto(ws.x,ws.y+j-odstep2+odstep2 div 2);
                od;
                call color(1);
                call auto(ws.x-10,ws.y);
              fi
            fi
          fi
        fi;
        (*call color(1);
        call auto(ws.x,ws.y);*)
        write(chr(7))
     else
       write(chr(7));
       call color(0);
       if ws.i<=ilosc_przystankow div 2
       then
         call auto(ws.x+10,ws.y)
       else
         call auto(ws.x-10,ws.y)
       fi;
       if ws.i<= ilosc_przystankow div 2
       then
         for j:=0 to odstep1 div 2
         do
         call color(1);
         call auto(ws.x,ws.y-j);
         call color(0);
         call auto(ws.x,ws.y-j);
         od;
         call color(1);
         call auto(ws.x,ws.y-odstep1 div 2);
       else
         for j:=0 to odstep2 div 2
         do
         call color(1);
         call auto(ws.x,ws.y+j);
         call color(0);
         call auto(ws.x,ws.y+j)
         od;
         call color(1);
         call auto(ws.x,ws.y+odstep2 div 2);
       fi
      fi;
      call color(1)
   end ruch;
 
   unit zabij_pas:procedure(i:integer);
     var p:pasazer;
     begin
       while  przystan(i).kolejka.cardinal>0
       do
         p:=przystan(i).kolejka.first;
         call przystan(i).kolejka.out_first;
         if p.event=/=none then call cancel(p) fi;
         kill(p)
       od
     end zabij_pas;
 
   unit wstep:procedure;
     begin
        call gron(0);
        call ramka(230,120,480,220);
        call ramka(228,118,482,222);
        call ramka(226,116,484,224);
        call move(250,140);
        call outstring("Program zaliczeniowy nr 6 ");
        call move(250,160);
        call outstring("  Symulacja autobusowa    ");
        call move(250,180);
        call outstring("Autor: Nguyen  Tuan  Trung");
        call move(250,200);
        call outstring(" Warszawa 24 - 05 - 1990r.");
        WHILE INKEY=0 DO OD;
        call groff
      end wstep;
 
   (*-----------  PROGRAM GLOWNY---------------------------------------------*)
 
 
  begin
     call wstep;
     do
       do
         write("czas symulacji=");
         readln(czas_sym);
         if czas_sym > 0
         then exit
         else writeln("Musi byc dodatni !")
         fi
       od;
       do
         write("ilosc przystankow=");
         readln(ilosc_przystankow);
         if ilosc_przystankow>1 and ilosc_przystankow < 21 then exit
         else writeln("Musi byc wieksza niz 1 i mniejsza niz 20!")
         fi
       od;
       (*do
         write("ilosc autobusow=");
         readln(ilosc_auto);
         if ilosc_auto>0 then exit
         else writeln("Musi byc dodatnia !")
         fi
       od;*)
       do
       write("czestotliwosc=");
       readln(czestosc);
       if czestosc>=10 then exit
         else writeln("Musi byc niemniejsza niz 10 min. !")
       fi;
       od;
       ilosc_auto:=entier((3*ilosc_przystankow) / czestosc +0.5) ;
       if ilosc_auto=0 then ilosc_auto:=1 fi;
       call gron(0);
       call ramka(400,3,500,300);
       call ramka(395,0,505,305);
       odstep1:=290 div (ilosc_przystankow div 2 + 1);
       podst1:=(290- (ilosc_przystankow div 2-1)*odstep1) div 2;
       odstep2:=290 div (ilosc_przystankow -
                         ilosc_przystankow div 2 + 1);
       podst2:=(290- (ilosc_przystankow-
                      ilosc_przystankow div 2-1)*odstep2) div 2;
       for i:=1 to 7
       do
       call ramka(448,300-i*40,452,320-i*40);
       call ramka(449,300-i*40,451,320-i*40);
       call ramka(450,300-i*40,450,320-i*40);
       od;
 
       array autobusy dim(1:ilosc_auto);
       for i:=1 to ilosc_auto
       do
         autobusy(i):=new bus ;
         call schedule(autobusy(i),time+(i-1)*czestosc+0.6)
       od;
       array przystan dim(1:ilosc_przystankow);
       for i:=1 to ilosc_przystankow
       do
         przystan(i):=new przystanek(i);
         call schedule(przystan(i),time)
       od;
       cl:=new zegar;
       call schedule(cl,time);
       inf:=new info;
       call schedule(inf,time+0.5);
       call hold(czas_sym+0.7);
       do
        call ramka(420,290,615,345);
        call ramka(421,291,614,344);
        call move(430,300);
        call outstring("SYMULACJA ZAKONCZONA");
        call move(430,320);
        call outstring("Przedluzac?(t/n)");
        i:=inkey;
        while i=0 do i:=inkey od;
        if i=/=ord('t') then exit fi;
        call move(430,300);
        call outstring("Przedluzac symulacje");
        call move(430,320);
        call outstring(" o:                 ");
        call move(460,320);
        for p:=1 downto 0 do
        do
          i:=inkey;
          while i=0 do i:=inkey od;
          if i>=ord('0') andif i<=ord('9') then exit fi
        od;
        if p=0 then
          czas:=czas+(i-ord('0'))
        else
          czas:=10*(i-ord('0'))
        fi;
        call hascii(i);
        (*call hascii(32);*)
        od;
        call outstring(" min.");
        for j:=1 to 2000 do od;
        call color(0);
        call ramka(420,290,615,345);
        call ramka(421,291,614,344);
        call color(1);
        call move(430,300);
        call outstring("                     ");
        call move(430,320);
        call outstring("                     ");
        czas_sym:=czas_sym+czas;
        call move(10,10);
        call outstring("Czas symulacji:");
        if czas_sym div 60=/=0
        then
          call wypisz(czas_sym div 60);
          call outstring(" godz. ")
        fi;
        if czas_sym mod 60 =/= 0 then
        call wypisz(czas_sym mod 60);
        call outstring(" min.");
        else call outstring("        ")
        fi;
        call hold(czas)
      od;
 
        for i:=1 to ilosc_auto
          do
            call cancel(autobusy(i));
            kill (autobusy(i))
          od;
        for i:=1 to ilosc_przystankow
          do
            call zabij_pas(i);
            call cancel(przystan(i));
            kill (przystan(i))
          od;
        kill (autobusy);
        kill (przystan);
        call cancel(cl);
        kill (cl);
        call cancel(inf);
        kill (inf);
        call groff;
        write("Symulowac dalej ?(T/N)");
        read(c);
        if c=/='t' then exit fi
      od
    end
  end
end.
