Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0135/10/qsim.sim
There are 4 other files named qsim.sim in the archive. Click here to see a list.
00100 BEGIN OPTIONS(/L); COMMENT display queue simulation;
00149 EXTERNAL TEXT PROCEDURE frontstrip, upcase, tmpin, conc;
00201 EXTERNAL TEXT PROCEDURE scanto, storbokstav, compress;
00300 EXTERNAL CHARACTER PROCEDURE insinglechar, fetchar;
00400 EXTERNAL PROCEDURE depchar, forceout, outstring, outche;
00500 EXTERNAL BOOLEAN PROCEDURE dotypeout, tmpout, meny, rescan;
00600 EXTERNAL INTEGER PROCEDURE trmop, gettab, checkreal, checkint;
00625 EXTERNAL INTEGER PROCEDURE scanint, iondx;
00650 EXTERNAL INTEGER PROCEDURE search, sscan;
00700 EXTERNAL REAL PROCEDURE clocktime;
00800 EXTERNAL PROCEDURE echo, abort, outchr, getvistaparameters;
00850 EXTERNAL REF (infile) PROCEDURE findinfile;
00900 EXTERNAL CLASS vista, form, termty;
01000 INTEGER width, height, open_duration, open_time, close_time,
01100 terminal_type, english;
01200 BOOLEAN monitorecho, sim_started;
01300 TEXT message_total, message_arrival, message_between,
01400 message_wait, terminal_message;
01500
01600 PROCEDURE inita_global;
01700 BEGIN CHARACTER c;
01750 getvistaparameters(width,height,terminal_type,terminal_message);
01900 monitorecho:= FALSE;
02000 open_duration:= 240; open_time:= 480;
02100 close_time:= open_time+open_duration;
02200 IF english = 0 THEN
02300 BEGIN
02400 ask: outtext("Swedish or English?"); outimage;
02500 inimage; c:= inchar;
02600 IF c = 'E' OR c = 'e' THEN english:= 1
02700 ELSE IF c = 'S' OR c = 's' THEN english := -1
02800 ELSE GOTO ask;
02900 message_total:- copy(IF english = 1 THEN
03000 "During the day" ELSE "Tot under dagen");
03100 message_arrival:- copy(IF english = 1 THEN
03200 "Patient arrival" ELSE "N{r pat. kommer");
03300 message_between:- copy(IF english = 1 THEN
03400 "Between 0 and 999" ELSE "Mellan 0 och 999");
03500 message_wait:- copy(IF english = 1 THEN
03600 "Idling cost" ELSE "V{ntekostnad");
03700 END;
03800 END;
03900 form CLASS queue_data;
04000 BEGIN
04100 REF (side_data) left, right;
04200 REF (statistics_field) doctor_value, patient_value;
04300
04400 CLASS side_data(wait_pos, cost_pos, offset);
04500 INTEGER wait_pos, cost_pos, offset;
04600 BEGIN
04700 CHARACTER last_name;
04800 INTEGER randno_doc, randno_pat;
04900 INTEGER room_left, room_mid, room_right;
05000 INTEGER numbers_at_open, doc_wait_sum, pat_wait_sum;
05100 REF (updatefield) arrival_interval, number_of_patients;
05200 PROCEDURE putstat;
05300 BEGIN
05400 move_the_cursor_to(wait_pos,16);
05500 outint(doc_wait_sum,5);
05600 move_the_cursor_to(wait_pos,17);
05700 outint(pat_wait_sum,5);
05800 move_the_cursor_to(wait_pos,19);
05900 outint(doc_wait_sum+pat_wait_sum,5);
06000 move_the_cursor_to(cost_pos,16);
06100 outint(doc_wait_sum*doctor_value.intvalue/60,6);
06200 move_the_cursor_to(cost_pos,17);
06300 outint(pat_wait_sum*patient_value.intvalue/60,6);
06400 move_the_cursor_to(cost_pos,19);
06500 outint((doc_wait_sum*doctor_value.intvalue
06600 + pat_wait_sum*patient_value.intvalue)/60,6);
06700 END;
06800 last_name:= 'z';
06900 room_left:= offset+6; room_right:= offset+15;
07000 room_mid:= offset+8;
07100 END;
07200
07300 PROCEDURE inita_sides;
07400 BEGIN
07500 left:- NEW side_data(7,0,0);
07600 right:- NEW side_data(25,31,20);
07700 left.arrival_interval:- NEW updatefield(1,3,NOTEXT,3,' ',
07800 message_arrival,0,999,message_between,left);
07900 right.arrival_interval:- NEW updatefield(27,3,NOTEXT,3,' ',
08000 message_arrival,0,999,message_between,right);
08100 left.number_of_patients:- NEW updatefield(1,4,NOTEXT,3,' ',
08200 message_total,0,999,message_between,left);
08300 right.number_of_patients:- NEW updatefield(30,4,NOTEXT,3,' ',
08400 message_total,0,999,message_between,right);
08500 doctor_value:- NEW statistics_field(24,13,NOTEXT,4,' ',
08600 message_wait,0,9999,message_between);
08700 patient_value:- NEW statistics_field(24,14,NOTEXT,4,' ',
08800 message_wait,0,9999,message_between);
08900 left.randno_doc:= clocktime;
09000 IF mod(left.randno_doc,2) = 0 THEN left.randno_doc:=
09100 left.randno_doc+1;
09200 right.randno_doc:= left.randno_doc;
09300 left.randno_pat:= left.randno_pat+2;
09400 right.randno_pat:= left.randno_pat;
09500 END;
09600
09700 PROCEDURE start_screen;
09800 IF english = 1 THEN
09900 BEGIN
10000 screen[00]:= "Sim-time 7:52 ";
10100 screen[01]:= "Open time 8.00 Close time 12:00 ";
10200 screen[02]:= "Mean treatment time 15 min/patient ";
10300 screen[03]:= " min Arrival interval min ";
10400 screen[04]:= " Number of pat. called ";
10500 screen[05]:= " Number of pat. at open ";
10600 screen[06]:= "------- ------- ------- -------";
10700 screen[07]:= "! ! ! !";
10800 screen[08]:= "! ! ! !";
10900 screen[09]:= "! ! ! !";
11000 screen[10]:= "-------===------- -------===-------";
11100 screen[11]:= "! O ! ! O !";
11200 screen[12]:= "------- ------- ------- -------";
11300 screen[13]:= "Value of doctor's time: $/hour ";
11400 screen[14]:= "Value of patient's time: $/hour ";
11500 screen[15]:= " $ min Wait time min $ ";
11600 screen[16]:= " Doctor ";
11700 screen[17]:= " Patients ";
11800 screen[18]:= "-------------------------------------";
11900 screen[19]:= " Sum ";
12000 END ELSE
12100 BEGIN
12200 screen[00]:= "Klockan: 7:52 ";
12300 screen[01]:= "@ppnas kl 8.00 St{ngs kl 12:00 ";
12400 screen[02]:= "Medelbehandlingstid 15 min/patient ";
12500 screen[03]:= " min Ankomstintervall min ";
12600 screen[04]:= " Antal kallade patienter ";
12700 screen[05]:= " Antal pat. vid `ppning ";
12800 screen[06]:= "------- ------- ------- -------";
12900 screen[07]:= "! ! ! !";
13000 screen[08]:= "! ! ! !";
13100 screen[09]:= "! ! ! !";
13200 screen[10]:= "-------===------- -------===-------";
13300 screen[11]:= "! O ! ! O !";
13400 screen[12]:= "------- ------- ------- -------";
13500 screen[13]:= "V{rde p} l{karens tid: kr/tim ";
13600 screen[14]:= "V{rde, patienternas tid: kr/tim ";
13700 screen[15]:= " kr min V{ntetid min kr";
13800 screen[16]:= " L{karen ";
13900 screen[17]:= " Patienterna ";
14000 screen[18]:= "-------------------------------------";
14100 screen[19]:= " Summa ";
14200 END;
14300
14400 intfield CLASS updatefield(side); REF (side_data) side;
14500 IF sim_started THEN GOTO start ELSE
14600 INSPECT side DO
14700 BEGIN COMMENT update dependent value when new data is input;
14800 numbers_at_open:= number_of_patients.intvalue
14900 - open_duration/arrival_interval.intvalue;
15000 move_the_cursor_to(number_of_patients.h,5);
15100 outint(numbers_at_open,3);
15200 END;
15300
15400 intfield CLASS statistics_field;
15500 BEGIN COMMENT update statistics when new weights are input;
15600 REF (side_data) side;
15700 FOR side:- left, right DO side.putstat;
15800 END;
15900
16000 PROCEDURE blip(c,h,v);
16100 INTEGER h, v; CHARACTER c;
16200 BEGIN
16300 set_char_on_screen(c,h,v);
16400 outchr(sysout,fill,10);
16500 set_char_on_screen(' ',h,v);
16600 END;
16700
16800 PROCEDURE bleep(c,h,v);
16900 INTEGER h, v; CHARACTER c;
17000 BEGIN
17100 set_char_on_screen(c,h,v);
17200 outchr(sysout,fill,50);
17300 set_char_on_screen(' ',h,v);
17400 END;
17500 END of queue_data;
17600 start:
17700 inita_global;
17800 queue_data
17900 (width, height, sysin, sysout, monitorecho, terminal_type,
18000 NOTEXT, terminal_message)
18100 BEGIN
18200 simulation CLASS sim_data;
18300 BEGIN
18400 REF (simulation_side) sim_left, sim_right, sim_side;
18500
18600 CLASS simulation_side(side); REF (side_data) side;
18700 BEGIN
18800 REF (head) waiting;
18900 REF (sided_process) doc;
19000 waiting:- NEW head;
19100 END;
19200
19300 process CLASS sided_process(side, sim_side);
19400 REF (side_data) side; REF(simulation_side) sim_side;
19500 BEGIN
19600 END;
19700
19800 sided_process CLASS doctor_data;
19900 BEGIN
20000 REAL start_of_wait;
20100 END;
20200
20300 sided_process CLASS patient_data;
20400 BEGIN
20500 INTEGER placeh, placev; REAL start_of_wait;
20600 CHARACTER myname;
20700 END;
20800
20900 PROCEDURE inita_sim_data;
21000 BEGIN
21100 sim_started:= FALSE;
21200 start_screen; inita_sides;
21300 show_page; restore_the_whole_screen;
21400 ask_page;
21500 hold(open_time-8); sim_started:= TRUE;
21600 sim_left:- NEW simulation_side(left);
21700 sim_right:- NEW simulation_side(right);
21800 END;
21900
22000 END of sim_data;
22100 sim_data CLASS sim_actions;
22200 BEGIN
22300
22400 BOOLEAN PROCEDURE none_is_waiting;
22500 none_is_waiting:= sim_left.waiting.empty AND
22600 sim_right.waiting.empty;
22700
22800 PROCEDURE close_office; ACTIVATE main;
22900
23000 doctor_data CLASS doctor_actions;
23100 BEGIN
23200
23300 PROCEDURE open_door;
23400 INSPECT side DO
23500 BEGIN
23600 bleep('*',room_mid,12); bleep('*',room_mid,11);
23700 set_char_on_screen('*',room_mid,11);
23800 hold(2.0); set_char_on_screen(' ',room_mid,11);
23900 blip('*',room_mid,10); blip('*',room_mid+1,10);
24000 blip('*',room_mid,10); blip('*',room_mid-1,10);
24100 bleep('*',room_mid-1,11); bleep('*',room_mid-2,11);
24200 bleep('*',room_mid-3,11); bleep('*',room_mid-4,11);
24300 set_char_on_screen('*',room_mid-6,11);
24400 END;
24500
24600 PROCEDURE treat_patient(patient, duration);
24700 REAL duration;
24800 REF (patient_actions) patient;
24900 BEGIN
25000 ACTIVATE patient; COMMENT into office;
25100 hold(duration); COMMENT hold during treatment;
25200 ACTIVATE patient; COMMENT out of office;
25300 END;
25400
25500 PROCEDURE doctor_wait;
25600 BEGIN
25700 IF time > close_time AND none_is_waiting
25800 THEN close_office;
25900 start_of_wait:= time;
26000 passivate;
26100 side.doc_wait_sum:=
26200 side.doc_wait_sum+time-start_of_wait;
26300 END;
26400 END of doctor_actions;
26500
26600 patient_data CLASS patient_actions;
26700 BEGIN
26800
26900 PROCEDURE find_seat;
27000 INSPECT side DO
27100 BEGIN INTEGER i;
27200 last_name:= IF last_name = 'z' THEN 'a'
27300 ELSE char(rank(last_name)+1);
27400 myname:= last_name;
27500 WHILE TRUE DO
27600 BEGIN
27700 FOR placev:= 7,9 DO
27800 FOR placeh:= offset+1 STEP 1 UNTIL room_left,
27900 offset+10 STEP 1 UNTIL room_right DO
28000 IF get_char_from_screen(placeh,placev) = ' ' THEN
28100 GOTO seat_found;
28200 hold(5);
28300 END;
28400 seat_found:
28500 bleep(myname,room_mid,6);
28600 blip(myname,room_mid,7);
28700 blip(myname,room_mid,8);
28800 FOR i:= room_mid STEP 1 UNTIL placeh DO
28900 blip(myname,i,8);
29000 FOR i:= room_mid STEP -1 UNTIL placeh DO
29100 blip(myname,i,8);
29200 set_char_on_screen(myname,placeh,placev);
29300 END of find_seat;
29400
29500 PROCEDURE patient_announce;
29600 ACTIVATE sim_side.doc DELAY 0;
29700
29800 PROCEDURE patient_wait;
29900 BEGIN
30000 start_of_wait:= time;
30100 wait(sim_side.waiting); out;
30200 side.pat_wait_sum:= side.pat_wait_sum
30300 + time - start_of_wait;
30400 side.putstat;
30500 END;
30600
30700 PROCEDURE to_doctor;
30800 INSPECT side DO
30900 BEGIN INTEGER i;
31000 set_char_on_screen(' ',placeh,placev);
31100 FOR i:= placeh STEP 1 UNTIL room_mid DO
31200 blip(myname,i,8);
31300 FOR i:= placeh STEP -1 UNTIL room_mid DO
31400 blip(myname,i,8);
31500 blip(myname,room_mid,8);
31600 blip(myname,room_mid,9);
31700 blip(myname,room_mid,10);
31800 blip(myname,room_mid,11);
31900 blip(myname,room_mid-1,11);
32000 set_char_on_screen(myname,room_mid-2,11);
32100 passivate;
32200 END;
32300
32400 PROCEDURE from_doctor;
32500 INSPECT side DO
32600 BEGIN
32700 set_char_on_screen(' ',room_mid-2,11);
32800 blip(myname,room_mid-1,11);
32900 blip(myname,room_mid,11);
33000 bleep(myname,room_mid,12);
33100 END;
33200 END of patient_actions;
33300
33400 PROCEDURE treat_results;
33500 BEGIN
33600 dotypeout(sysout);
33700 WHILE TRUE DO
33800 resume(doctor_value);
33900 END;
34000
34100 process CLASS clock;
34200 WHILE TRUE DO
34300 BEGIN move_the_cursor_to(9,0); outint(entier(time/60),2);
34400 outchar(':'); outint(mod(time,60),2);
34500 IF get_char_from_screen(12,0) = ' ' THEN
34600 set_char_on_screen('0',12,0);
34700 hold(1);
34800 END;
34900
35000 END of sim_actions;
40000 sim_actions
40100 BEGIN
40200 doctor_actions CLASS doctor;
40300 BEGIN open_door;
40400 WHILE TRUE DO
40500 INSPECT sim_side.waiting.first WHEN patient DO
40600 treat_patient(THIS patient, negexp(1/15,side.randno_doc))
40700 OTHERWISE doctor_wait;
40800 END;
40900
41000 sided_process CLASS door;
41100 INSPECT side DO
41200 BEGIN
41300 WHILE time < close_time DO
41400 BEGIN
41500 hold(arrival_interval.intvalue);
41600 ACTIVATE NEW patient(side,sim_side);
41700 hold(arrival_interval.intvalue);
41800 END;
41900 END of door;
42000
42100 patient_actions CLASS patient;
42200 BEGIN hold(normal(5,7,side.randno_pat));
42300 find_seat;
42400 patient_announce;
42500 patient_wait;
42600 to_doctor;
42700 from_doctor;
42800 END;
42900
43000 PROCEDURE perform_simulation;
43100 BEGIN
43200 start_simulation;
43300 treat_results;
43400 END;
43500
43600 PROCEDURE start_simulation;
43700 BEGIN
43800 inita_sim_data;
43900 FOR sim_side:- sim_left, sim_right DO
44000 INSPECT sim_side DO
44100 BEGIN INTEGER i;
44200 doc:- NEW doctor(side,sim_side);
44300 ACTIVATE doc DELAY 8;
44400 FOR i:= side.numbers_at_open STEP -1
44500 UNTIL 1 DO ACTIVATE NEW patient(side,sim_side);
44600 ACTIVATE NEW door(side,sim_side);
44700 END;
44800 ACTIVATE NEW clock;
44900 passivate;
45000 END;
45100
45200 perform_simulation;
45300 END of block prefixed by sim_actions;
45400 END of block prefixed by queue_data;
45500 END of the whole program;