Google
 

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;