4 (* SYMULACJA PRACY BANKU *)
5 (* dolaczone funkcje graficzne *)
7 (****************************************************************************)
9 unit kasa:procedure(nr:integer);
25 call outstring("Desk");
33 (****************************************************************************)
35 unit klient:procedure(nr,kasa:integer;inout kl:integer);
49 k:=kl div 10; p:=kl mod 10;
63 (****************************************************************************)
65 unit obsluzony:procedure(nr,kasa:integer);
66 var j:integer,pom:arrayof integer;
70 pom:=getmap(199,j+14);
78 (****************************************************************************)
97 call outstring(" SIMULATION PROGRAM - BANK ");
103 call outstring("This program simulates a bank department with 5 desks ");
104 call outstring("served by 5 cashiers ");
107 call outstring("Customers arrive at random. The service time is also random ");
110 call outstring("as well as its account and the sum to be paid ");
114 (****************************************************************************)
116 unit zwieksz:procedure(inout linia:integer);
117 var pom:arrayof integer;
122 pom:=getmap(718,325);
129 (****************************************************************************)
131 unit piszczas:procedure(t:real);
132 var d,p,i:integer,r,x:real;
139 call hascii(0);call hascii(d+48);
146 call hascii(0);call hascii(ord('.'));
155 call hascii(0); call hascii(d+48);
159 call move(x+32,inypos);
162 (****************************************************************************)
165 UNIT PRIORITYQUEUE: CLASS;
166 (* HEAP AS BINARY LINKED TREE WITH FATHER LINK*)
170 UNIT QUEUEHEAD: CLASS;
171 (* HEAP ACCESING MODULE *)
174 UNIT MIN: FUNCTION: ELEM;
176 IF ROOT=/= NONE THEN RESULT:=ROOT.EL FI;
179 UNIT INSERT: PROCEDURE(R:ELEM);
180 (* INSERTION INTO HEAP *)
186 ROOT.LEFT,ROOT.RIGHT,LAST:=ROOT
207 CALL CORRECT(R,FALSE)
210 UNIT DELETE: PROCEDURE(R: ELEM);
230 IF X.LESS(X.UP) THEN CALL CORRECT(X.EL,FALSE)
231 ELSE CALL CORRECT(X.EL,TRUE) FI;
234 UNIT CORRECT: PROCEDURE(R:ELEM,DOWN:BOOLEAN);
235 (* CORRECTION OF THE HEAP WITH STRUCTURE BROKEN BY R *)
236 VAR X,Z:NODE,T:ELEM,FIN,LOG:BOOLEAN;
241 IF Z.NS =0 THEN FIN:=TRUE ELSE
242 IF Z.NS=1 THEN X:=Z.LEFT ELSE
243 IF Z.LEFT.LESS(Z.RIGHT) THEN X:=Z.LEFT ELSE X:=Z.RIGHT
245 IF Z.LESS(X) THEN FIN:=TRUE ELSE
256 IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z); FI;
265 IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z);
274 UNIT NODE: CLASS (EL:ELEM);
275 (* ELEMENT OF THE HEAP *)
276 VAR LEFT,RIGHT,UP: NODE, NS:INTEGER;
277 UNIT LESS: FUNCTION(X:NODE): BOOLEAN;
279 IF X= NONE THEN RESULT:=FALSE
280 ELSE RESULT:=EL.LESS(X.EL) FI;
285 UNIT ELEM: CLASS(PRIOR:REAL);
286 (* PREFIX OF INFORMATION TO BE STORED IN NODE *)
288 UNIT VIRTUAL LESS: FUNCTION(X:ELEM):BOOLEAN;
290 IF X=NONE THEN RESULT:= FALSE ELSE
291 RESULT:= PRIOR< X.PRIOR FI;
294 LAB:= NEW NODE(THIS ELEM);
302 UNIT SIMULATION: PRIORITYQUEUE CLASS;
303 (* THE LANGUAGE FOR SIMULATION PURPOSES *)
305 VAR CURR: SIMPROCESS, (*ACTIVE PROCESS *)
306 PQ:QUEUEHEAD, (* THE TIME AXIS *)
310 UNIT SIMPROCESS: COROUTINE;
311 (* USER PROCESS PREFIX *)
312 VAR EVENT, (* ACTIVATION MOMENT NOTICE *)
313 EVENTAUX: EVENTNOTICE,
314 (* THIS IS FOR AVOIDING MANY NEW CALLS AS AN RESULT OF *)
315 (* SUBSEQUENT PASSIVATIONS AND ACTIVATIONS *)
318 UNIT IDLE: FUNCTION: BOOLEAN;
320 RESULT:= EVENT= NONE;
323 UNIT TERMINATED: FUNCTION :BOOLEAN;
328 UNIT EVTIME: FUNCTION: REAL;
329 (* TIME OF ACTIVATION *)
331 IF IDLE THEN CALL ERROR1;
333 RESULT:= EVENT.EVENTTIME;
336 UNIT ERROR1:PROCEDURE;
340 WRITELN(" AN ATTEMPT TO ACCESS AN IDLE PROCESS TIME");
343 UNIT ERROR2:PROCEDURE;
347 WRITELN(" AN ATTEMPT TO ACCESS A TERMINATED PROCESS TIME");
359 UNIT EVENTNOTICE: ELEM CLASS;
360 (* A PROCESS ACTIVATION NOTICE TO BE PLACED ONTO THE TIME AXIS PQ *)
361 VAR EVENTTIME: REAL, PROC: SIMPROCESS;
363 UNIT VIRTUAL LESS: FUNCTION(X: EVENTNOTICE):BOOLEAN;
364 (* OVERWRITE THE FORMER VERSION CONSIDERING EVENTTIME *)
366 IF X=NONE THEN RESULT:= FALSE ELSE
367 RESULT:= EVENTTIME< X.EVENTTIME OR
368 (EVENTTIME=X.EVENTTIME AND PRIOR< X.PRIOR); FI;
374 UNIT MAINPROGRAM: SIMPROCESS CLASS;
375 (* IMPLEMENTING MASTER PROGRAM AS A PROCESS *)
380 UNIT TIME:FUNCTION:REAL;
381 (* CURRENT VALUE OF SIMULATION TIME *)
383 RESULT:=CURRENT.EVTIME
386 UNIT CURRENT: FUNCTION: SIMPROCESS;
387 (* THE FIRST PROCESS ON THE TIME AXIS *)
392 UNIT SCHEDULE: PROCEDURE(P:SIMPROCESS,T:REAL);
393 (* ACTIVATION OF PROCESS P AT TIME T AND DEFINITION OF "PRIOR"- PRIORITY *)
394 (* WITHIN TIME MOMENT T *)
396 IF T<TIME THEN T:= TIME FI;
397 IF P=CURRENT THEN CALL HOLD(T-TIME) ELSE
398 IF P.IDLE AND P.EVENTAUX=NONE THEN (* HAS NOT BEEN SCHEDULED YET*)
399 P.EVENT,P.EVENTAUX:= NEW EVENTNOTICE(RANDOM);
402 IF P.IDLE (* P HAS ALREADY BEEN SCHEDULED *) THEN
403 P.EVENT:= P.EVENTAUX;
404 P.EVENT.PRIOR:=RANDOM;
407 P.EVENT.PRIOR:=RANDOM;
408 CALL PQ.DELETE(P.EVENT)
410 P.EVENT.EVENTTIME:= T;
411 CALL PQ.INSERT(P.EVENT) FI;
414 UNIT HOLD:PROCEDURE(T:REAL);
415 (* MOVE THE ACTIVE PROCESS T MINUTES BACK ALONG PQ *)
418 CALL PQ.DELETE(CURRENT.EVENT);
419 CURRENT.EVENT.PRIOR:=RANDOM;
420 IF T<0 THEN T:=0; FI;
421 CURRENT.EVENT.EVENTTIME:=TIME+T;
422 CALL PQ.INSERT(CURRENT.EVENT);
426 UNIT PASSIVATE: PROCEDURE;
427 (* REMOVE THE ACTVE PROCESS FROM PQ AND ACTIVATE THE NEXT ONE *)
429 CALL PQ.DELETE(CURRENT.EVENT);
434 UNIT RUN: PROCEDURE(P:SIMPROCESS);
435 (* ACTIVATE P IMMEDIATELY AND DELAY THE FORMER FIRST PROCESS BY REDEFINING*)
438 CURRENT.EVENT.PRIOR:=RANDOM;
441 P.EVENT.EVENTTIME:=TIME;
442 CALL PQ.CORRECT(P.EVENT,FALSE)
444 IF P.EVENTAUX=NONE THEN
445 P.EVENT,P.EVENTAUX:=NEW EVENTNOTICE(0);
446 P.EVENT.EVENTTIME:=TIME;
448 CALL PQ.INSERT(P.EVENT)
452 P.EVENT.EVENTTIME:=TIME;
454 CALL PQ.INSERT(P.EVENT);
459 UNIT CANCEL:PROCEDURE(P: SIMPROCESS);
460 (* REMOVE PROCESS P FROM PQ AND CONTINUE SIMULATION *)
462 IF P= CURRENT THEN CALL PASSIVATE ELSE
463 CALL PQ.DELETE(P.EVENT);
467 UNIT CHOICEPROCESS:PROCEDURE;
468 (* CHOOSE THE FIRST PROCESS FROM PQ TO BE ACTIVATED *)
472 CURR:= PQ.MIN QUA EVENTNOTICE.PROC;
475 WRITE(" ERROR IN THE HEAP"); WRITELN;
477 ELSE ATTACH(CURR); FI;
481 PQ:=NEW QUEUEHEAD; (* SIMULATION TIME AXIS*)
482 CURR,MAINPR:=NEW MAINPROGRAM;
483 MAINPR.EVENT,MAINPR.EVENTAUX:=NEW EVENTNOTICE(0);
484 MAINPR.EVENT.EVENTTIME:=0;
485 MAINPR.EVENT.PROC:=MAINPR;
486 CALL PQ.INSERT(MAINPR.EVENT);
487 (* THE FIRST PROCESS TO BE ACTIVATED IS MAIN PROGRAM *)
494 UNIT LISTS:SIMULATION CLASS;
495 (* WE WISH TO USE LISTS FOR QUEUEING PROCESSES DURING SIMULATION*)
498 (*WE WILL USE TWO WAY LISTS *)
499 VAR SUC1,PRED1:LINKAGE;
501 UNIT HEAD:LINKAGE CLASS;
502 (* EACH LIST WILL HAVE ONE ELEMENT ESTABLISHED *)
503 UNIT FIRST:FUNCTION:LINK;
505 IF SUC1 IN LINK THEN RESULT:=SUC1
506 ELSE RESULT:=NONE FI;
508 UNIT EMPTY:FUNCTION:BOOLEAN;
510 RESULT:=SUC1=THIS LINKAGE;
513 SUC1,PRED1:=THIS LINKAGE;
516 UNIT LINK:LINKAGE CLASS;
517 (* ORDINARY LIST ELEMENT PREFIX *)
525 UNIT INTO:PROCEDURE(S:HEAD);
530 IF S.SUC1=/=NONE THEN
533 PRED1.SUC1:=THIS LINKAGE;
534 S.PRED1:=THIS LINKAGE;
539 UNIT ELEM:LINK CLASS(SPROCESS:SIMPROCESS);
540 (* USER DEFINED PROCESS WILL BE JOINED INTO LISTS *)
549 (*poczatek symulacji pracy banku*)
552 UNIT OFFICE:LISTS CLASS; (*AN OFFICE*)
554 UNIT TILL:SIMPROCESS CLASS(QUEUE:HEAD);
555 (* TELLER WITH CUSTOMERS QUEUEING UP *)
556 UNIT VIRTUAL SERVICE:PROCEDURE;
557 (* SERVICE OF THIS TELLER WILL BE PRECISED LATER *)
559 VAR CSTM:CUSTOMER, (*THE CUSTOMER BEING SERVED*)
565 REST:=REST+TIME-PAUSE;
566 WHILE NOT QUEUE.EMPTY DO
567 (* SERVE ALL QUEUE *)
568 CSTM:=QUEUE.FIRST QUA ELEM.SPROCESS;
570 CALL SCHEDULE(CSTM,TIME);
577 UNIT CUSTOMER:SIMPROCESS CLASS;
579 VAR ELLIST:ELEM, K:INTEGER;
580 UNIT ARRIVAL:PROCEDURE(S:TILL);
581 (* ATTACHING TELLER S *)
584 ELLIST:=NEW ELEM(THIS CUSTOMER);
585 CALL ELLIST.INTO(S.QUEUE);
586 IF S.IDLE THEN CALL SCHEDULE(S,TIME) FI;
595 UNIT BANKDEPARTMENT:OFFICE CLASS;
598 UNIT COUNTER:TILL CLASS;
599 VAR PAYTIME:REAL; (*RANDOM SERVICE TIME*)
600 UNIT VIRTUAL SERVICE:PROCEDURE;
602 call move(205,linia);
603 call outstring(" Customer No");
604 p1:=cstm.k div 10; p2:=cstm.k mod 10;
606 call hascii(0); call hascii(p1+48);
607 call hascii(0);call hascii(p2+48);
609 call hascii(0);call hascii(p2+48);
611 call outstring(" has payed at the desk at time: ");
614 CALL CSTM.ELLIST.OUT;
621 UNIT TELLER:TILL CLASS(NUMBER:INTEGER);
622 VAR SERVICETIME:REAL;
623 UNIT VIRTUAL SERVICE:PROCEDURE;
626 call move(205,linia);
627 call outstring(" Cashier No ");
628 call hascii(0); call hascii(number+48);
629 call outstring(" was waiting a customer during ");
632 CALL CSTM.ELLIST.OUT;
633 N:=CSTM QUA BANKCUSTOMER.NO;
634 call move(205,linia);
635 call outstring(" Customer No ");
636 p1:=cstm.k div 10; p2:=cstm.k mod 10;
638 call hascii(0); call hascii(p1+48);
639 call hascii(0);call hascii(p2+48);
641 call hascii(0);call hascii(p2+48);
643 call outstring(" becomes to be served by cashier No ");
644 call hascii(0); call hascii(number+48);
646 call move(205,linia);
647 call outstring(" at time ");
650 ACCOUNT(N):=ACCOUNT(N)+CSTM QUA BANKCUSTOMER.AMOUNT;
651 IF ACCOUNT(N)<0 THEN CALL CSTM.ARRIVAL(CONTROL);FI;
652 SERVICETIME:=RANDOM*7+3;
653 CALL HOLD(SERVICETIME);
659 UNIT BANKCUSTOMER:CUSTOMER CLASS(NO:INTEGER,AMOUNT:REAL);
660 (* BANK CUSTOMER. AMOUNT- THE MONEY TO BE PAID AT THE BANK *)
661 VAR ARRIVALTIME,STAYTIME:REAL,CHOOSETELLER:INTEGER;
666 call move(205,linia);
667 call outstring(" Customer No ");
668 p1:=k div 10; p2:=k mod 10;
670 call hascii(0); call hascii(p1+48);
671 call hascii(0);call hascii(p2+48);
673 call hascii(0);call hascii(p2+48);
675 call outstring(" arrived at time ");
678 CHOOSETELLER:=RANDOM*5+1;
679 kasa(chooseteller):=kasa(chooseteller)+1;
680 call klient(kasa(chooseteller),chooseteller,kl);
681 CALL ARRIVAL(TELLERS(CHOOSETELLER));
682 IF AMOUNT<0 THEN CALL ARRIVAL(CTR); FI;
683 STAYTIME:=TIME-ARRIVALTIME;
684 call move(205,linia);
685 call outstring(" Customer No ");
686 p1:=k div 10; p2:=k mod 10;
688 call hascii(0); call hascii(p1+48);
689 call hascii(0);call hascii(p2+48);
691 call hascii(0);call hascii(p2+48);
693 call outstring(" left bank after ");
694 call piszczas(STAYTIME); (*STAN KONTA ",ACCOUNT(NO):10:4); *)
696 call obsluzony(kasa(chooseteller),chooseteller);
697 kasa(chooseteller):=kasa(chooseteller)-1
700 VAR TELLERS:ARRAYOF TELLER,ACCOUNT:ARRAYOF REAL;
701 VAR CTR:COUNTER, CONTROL:TILL,I:INTEGER;
702 var linia,p1,p2,kl:integer;
703 var kasa:arrayof integer;
705 BEGIN (* NEW BANK DEPARTMENT GENERATION *)
708 CTR:=NEW COUNTER(NEW HEAD);
709 ARRAY TELLERS DIM(1:5); (* WE DEAL WITH 5 TELLES *)
710 FOR I:=1 TO 5 DO TELLERS(I):=NEW TELLER(NEW HEAD,I); OD;
711 ARRAY ACCOUNT DIM(1:100);
712 (* WE DEAL WITH 100 ACOUNTS IN THIS BANK DEPARTMENT *)
713 FOR I:=1 TO 100 DO ACCOUNT(I):=RANDOM*901+100; OD;
714 (* AN ACCOUNT VALUE CAN FLUCTUATE FROM 100 TO 1000$ *)
720 BEGIN (* OF PROGRAM *)
721 PREF BANKDEPARTMENT BLOCK
722 UNIT GENERATOR:SIMPROCESS CLASS;
723 (* CUSTOMERS GENERATION *)
726 CALL SCHEDULE(NEW BANKCUSTOMER(RANDOM*100+1,
727 RANDOM*9996+5),TIME);
729 CALL SCHEDULE(NEW BANKCUSTOMER(RANDOM*100+1,
730 -(RANDOM*900+5)),TIME);
736 call hpage(1,720,347);
741 call outstring("Click the mouse in order to start simulation");
742 (* call track(719,349); *)
743 CALL SCHEDULE(NEW GENERATOR,TIME);
746 call outstring(" Click the mouse in order to finish ");
747 (* call track(719,349); *)
752 (****************************************************************************)