2 (*_______________________________________________________*)
\r
3 (* SYMULACJA RUCHU ULICZNEGO *)
\r
4 (*_______________________________________________________*)
\r
6 (* simulation class *)
\r
9 (* the type implementing fifo - queues *)
\r
12 var front, rear:fifoel;
\r
15 unit fifoel : class;
\r
18 unit into:procedure(q:fifo);
\r
20 if q.front = none then
\r
21 q.front,q.rear := this fifoel
\r
22 else q.rear.succ, q.rear :=this fifoel
\r
30 unit outfirst:procedure;
\r
32 if front = none then raise fifoempty
\r
34 if rear = front then rear,front := none
\r
35 else front:=front.succ
\r
42 unit empty:function:boolean;
\r
44 result := front=none
\r
49 unit first:function:fifoel;
\r
56 unit cardinal:function:integer;
\r
61 while aux =/= none do
\r
72 unit priorityqueue: fifo class;
\r
73 (* heap as binary linked tree with father link*)
\r
76 unit queuehead: class;
\r
77 (* heap accessing module *)
\r
81 unit min: function: elem;
\r
83 if root=/= none then result:=root.el fi;
\r
86 unit insert: procedure(r:elem);
\r
87 (* insertion into heap *)
\r
93 root.left,root.right,last:=root
\r
100 x.left:= z; z.right:=x
\r
108 last.left.right:=x;
\r
113 call correct(r,false);
\r
118 unit delete: procedure(r: elem);
\r
122 if x=root and root.ns=0 then
\r
138 last.ns:= last.ns-1;
\r
141 if x.less(x.up) then
\r
142 call correct(x.el,false)
\r
144 call correct(x.el,true)
\r
150 unit correct: procedure(r:elem,down:boolean);
\r
151 (* correction of the heap with structure broken by r *)
\r
152 var x,z:node,t:elem,fin,log:boolean;
\r
163 if z.left.less(z.right) then
\r
182 if x=none then log:=true else log:=x.less(z); fi;
\r
191 if x=none then log:=true else log:=x.less(z);fi;
\r
200 unit node: class (el:elem);
\r
201 (* element of the heap *)
\r
202 var left,right,up: node, ns:integer;
\r
203 unit less: function(x:node): boolean;
\r
205 if x= none then result:=false
\r
206 else result:=el.less(x.el)
\r
211 unit elem: class(prior:real);
\r
212 (* prefix of information to be stored in node *)
\r
214 unit virtual less: function(x:elem):boolean;
\r
216 if x=none then result:= false
\r
218 result:= prior< x.prior
\r
222 lab:= new node(this elem);
\r
227 (*______________________________________________________________*)
\r
232 unit simulation: priorityqueue class;
\r
233 (* the language for simulation purposes *)
\r
234 taken queuehead, elem, fifoel;
\r
235 hidden pq, curr, eventnotice, mainprogram, choiceprocess;
\r
236 var curr : simprocess, (*active process *)
\r
237 pq :queuehead, (* the time axis *)
\r
238 mainpr: mainprogram;
\r
240 unit simprocess:fifoel coroutine;
\r
241 (* user process prefix *)
\r
242 var event, (* activation moment notice *)
\r
243 eventpom: eventnotice,
\r
244 (* this is for avoiding many new calls as an result *)
\r
245 (* of subsequent passivations and activations *)
\r
247 signal termproc, idleproc;
\r
248 unit idle: function: boolean;
\r
250 result:= event= none;
\r
254 unit terminated: function :boolean;
\r
260 unit evtime: function: real;
\r
261 (* time of activation *)
\r
263 if idle then raise idleproc fi;
\r
264 result:= event.eventtime;
\r
267 (* default handlers for signals termproc and idleproc *)
\r
268 when termproc: writeln(" simprocess is terminated ");
\r
270 when idleproc: writeln(" simprocess is idle ");
\r
283 unit eventnotice: elem class;
\r
284 (* a process activation notice to be placed onto the time axis pq *)
\r
285 var eventtime: real, proc: simprocess;
\r
286 unit virtual less: function(x: eventnotice):boolean;
\r
287 (* overwrite the former version considering eventtime *)
\r
289 if x=none then result:= false
\r
291 result:=eventtime < x.eventtime or
\r
292 (eventtime=x.eventtime and prior < x.prior);
\r
298 unit mainprogram: simprocess class;
\r
299 (* implementing master programm as a process *)
\r
301 do attach(main) od;
\r
305 unit time:function:real;
\r
306 (* current value of simulation time *)
\r
308 result:=current.evtime
\r
312 unit current: function: simprocess;
\r
313 (* the first process on the time axis *)
\r
318 unit schedule: procedure(p:simprocess,t:real);
\r
319 (* activation of process p at time t *)
\r
321 if t<time then t:= time fi;
\r
325 if p.idle and p.eventpom=none then
\r
326 (* has not been scheduled yet *)
\r
327 p.event,p.eventpom:= new eventnotice(random);
\r
330 if p.idle (* p has been scheduled yet *) then
\r
331 p.event:= p.eventpom;
\r
332 p.event.prior:=random;
\r
334 (* new scheduling *)
\r
335 p.event.prior:=random;
\r
336 call pq.delete(p.event)
\r
339 p.event.eventtime:= t;
\r
340 call pq.insert(p.event);
\r
345 unit hold:procedure(t:real);
\r
346 (* move the active process t minutes back along pq *)
\r
347 (* redefine prior *)
\r
349 call pq.delete(current.event);
\r
350 current.event.prior:=random;
\r
351 if t<0 then t:=0; fi;
\r
352 current.event.eventtime:=time+t;
\r
353 call pq.insert(current.event);
\r
354 call choiceprocess;
\r
358 unit passivate: procedure;
\r
359 (* remove the actve process from pq and activate the next one *)
\r
361 call pq.delete(current.event);
\r
362 current.event:=none;
\r
367 unit run: procedure(p:simprocess);
\r
368 (* activate p immediately and delay former first process *)
\r
369 (* by redefining prior *)
\r
371 current.event.prior:=random;
\r
374 p.event.eventtime:=time;
\r
375 call pq.correct(p.event,false)
\r
377 if p.eventpom=none then
\r
378 p.event,p.eventpom:=new eventnotice(0);
\r
379 p.event.eventtime:=time;
\r
381 call pq.insert(p.event)
\r
383 p.event:=p.eventpom;
\r
385 p.event.eventtime:=time;
\r
387 call pq.insert(p.event);
\r
390 call choiceprocess;
\r
395 unit cancel:procedure(p: simprocess);
\r
396 (* remove process p from pq and continue simulation *)
\r
398 if p= current then call passivate
\r
400 call pq.delete(p.event);
\r
407 unit choiceprocess:procedure;
\r
408 (* choose the first process from pq to be activated *)
\r
412 if pq.min= none then
\r
413 writeln(" empty queue");
\r
414 mainpr.event:=mainpr.eventpom;
\r
415 mainpr.event.prior:=0;
\r
416 mainpr.event.eventtime:=time;
\r
417 call pq.insert(mainpr.event);
\r
421 curr:=pq.min qua eventnotice.proc;
\r
429 pq:=new queuehead; (* simulation time axis*)
\r
430 curr,mainpr:=new mainprogram;
\r
431 mainpr.event,mainpr.eventpom:=new eventnotice(0);
\r
432 mainpr.event.eventtime:=0;
\r
433 mainpr.event.proc:=mainpr;
\r
434 call pq.insert(mainpr.event);
\r
435 (* the first process to be activated is main program *)
\r
441 (*______________________________________________________________________*)
\r
442 (* grafika do symulacji *)
\r
443 (*______________________________________________________________________*)
\r
446 unit graf:iiuwgraph class; (* clasa graficzna *)
\r
447 var c:arrayof arrayof integer;
\r
448 var ile :arrayof integer;
\r
450 unit inchar:function:integer;
\r
458 unit outhline: procedure(a:arrayof char);
\r
459 (* wypisanie w trybie graficznym*)
\r
465 call hascii(ord(a(j)));
\r
472 unit inhline:function(xc:integer;yc,il:integer):arrayof char;
\r
473 var i,count,ik:integer;
\r
474 var ar:arrayof char;
\r
478 array ar dim(1:il);
\r
479 while ik=/=13 and count<il do
\r
481 if ik=8 and count>0 then
\r
484 call move(xc+(count)*8,yc);
\r
489 ar(count):=chr(ik);
\r
496 array result dim(1:count);
\r
497 for i:=1 to count do
\r
505 (* funkcja zamiany na liczbe liczby zapisanej znakowo *);
\r
506 unit cyfra:function(at:arrayof char):integer;
\r
507 var id,i,j,k:integer;
\r
512 for i:=id downto 1 do
\r
513 k:=k+((ord(at(i))-48)*j);
\r
520 unit daj:function(a:integer):arrayof char;
\r
521 var ta:arrayof char;
\r
522 var i,j,k,l,m:integer;
\r
527 if a>9999 then i:=5;
\r
536 if i=5 then m:=2;ta(1):=chr((a div 10000)+48); fi;
\r
537 for j:=i downto m do
\r
538 ta(j):=chr(((a mod k) div l)+48);
\r
545 unit mapa:procedure; (* rysowanie fragmentu miasta *)
\r
547 call cls; (* czyszczenie ekranu *)
\r
548 call move(9,5); (* rameczka *)
\r
550 call draw(719,333);
\r
554 call draw(590,333);
\r
556 call draw(589,333);
\r
557 call move(9,70); (* tu juz skrzyzowanie *)
\r
570 call draw(103,107);
\r
571 call draw(103,333);
\r
573 call draw(102,108);
\r
574 call draw(102,333);
\r
575 call move(124,107);
\r
576 call draw(124,204);
\r
577 call draw(331,204);
\r
578 call draw(331,107);
\r
579 call draw(124,107);
\r
580 call move(125,108);
\r
581 call draw(125,203);
\r
582 call draw(330,203);
\r
583 call draw(330,108);
\r
584 call draw(125,108);
\r
586 call move(124,333); (* "dolny" parking *)
\r
587 call draw(124,226);
\r
588 call draw(221,226);
\r
589 call draw(221,242);
\r
590 call draw(161,242);
\r
591 call draw(161,297);
\r
592 call draw(290,297);
\r
593 call draw(290,242);
\r
594 call draw(230,242);
\r
595 call draw(230,226);
\r
596 call draw(331,226);
\r
597 call draw(331,333);
\r
599 call move(125,333);
\r
600 call draw(125,227);
\r
601 call draw(220,227);
\r
602 call draw(220,241);
\r
603 call draw(160,241);
\r
604 call draw(160,298);
\r
605 call draw(291,298);
\r
606 call draw(291,241);
\r
607 call draw(231,241);
\r
608 call draw(231,227);
\r
609 call draw(330,227);
\r
610 call draw(330,333);
\r
612 call move(353,333); (* "gorny" parking *)
\r
613 call draw(353,107);
\r
614 call draw(488,107);
\r
615 call draw(488,123);
\r
616 call draw(463,123);
\r
617 call draw(463,143);
\r
618 call draw(522,143);
\r
619 call draw(522,123);
\r
620 call draw(497,123);
\r
621 call draw(497,107);
\r
622 call draw(590,107);
\r
624 call move(354,333);
\r
625 call draw(354,108);
\r
626 call draw(487,108);
\r
627 call draw(487,122);
\r
628 call draw(464,122);
\r
629 call draw(464,144);
\r
630 call draw(523,144);
\r
631 call draw(523,122);
\r
632 call draw(498,122);
\r
633 call draw(498,108);
\r
634 call draw(590,108);
\r
636 call move(9,84); (* tory tramwajowe *);
\r
645 call move(134,81); (* przystanki *)
\r
654 call move(600,20); (* poglodowka *)
\r
663 call outhline(unpack("1"));
\r
665 call outhline(unpack("2"));
\r
667 call outhline(unpack("3"));
\r
669 call outhline(unpack("4"));
\r
671 call outhline(unpack("przejechalo"));
\r
673 call outhline(unpack("pojazdow"));
\r
675 call move(595,300);
\r
676 call outhline(unpack("SPACJA-menu"));
\r
677 call move(595,310);
\r
678 call outhline(unpack("Q exit"));
\r
679 call move(595,320);
\r
680 call outhline(unpack("Z zmiany"));
\r
684 unit ilep:procedure;
\r
688 call move(595,90+i*10);
\r
689 call outhline(daj(i));
\r
690 call move(640,90+i*10);
\r
691 call outhline(daj(ile(i)));
\r
696 unit start:procedure;(* strona tytulowa oraz zapamietanie *)
\r
697 var i:integer; (* wygladu samochodow *)
\r
699 call cirb(100,100,20,1,1,1,1,1,1);
\r
700 call cirb(100,120,20,1,1,1,1,1,1);
\r
701 call cirb(150,100,20,1,1,1,1,1,1);
\r
702 call cirb(150,120,20,3.8,1.6,1,1,1,1);
\r
703 call move(101,101);
\r
704 c(1):= getmap(111,104); (* samochod poziomy *)
\r
705 call move(101,101);
\r
706 c(2):= getmap(106,108); (* samochod pionowy *)
\r
708 c(3):=getmap(11,4);
\r
712 call outhline(unpack("Symulacja"));
\r
718 unit grtram:procedure; (* rysowanie i zapamietanie tramwaju *)
\r
741 unit semafv:procedure(x,y:integer,upp:boolean);
\r
742 begin (* rysowanie pionowych sygnalizatorow "swiatel" *)
\r
743 if upp then y:=y+3 fi;
\r
746 call draw(x+9,y+27);
\r
750 call draw(x+9,y+9);
\r
752 call draw(x+9,y+18);
\r
756 call draw(x+9,y+27);
\r
759 call draw(x+9,y+30);
\r
761 call move(x+4,y+27);
\r
762 call draw(x+4,y+30);
\r
763 call move(x+5,y+27);
\r
764 call draw(x+5,y+30);
\r
768 unit semafh:procedure(x,y:integer,upp:boolean);
\r
769 begin (* rysowanie poziomych sygnalizatorow "swiatel" *)
\r
770 if upp then x:=x+3 fi;
\r
773 call draw(x+27,y+9);
\r
777 call draw(x+9,y+9);
\r
779 call draw(x+18,y+9);
\r
783 call draw(x+27,y+9);
\r
786 call draw(x+30,y+9);
\r
788 call move(x+27,y+4);
\r
789 call draw(x+30,y+4);
\r
790 call move(x+27,y+5);
\r
791 call draw(x+30,y+5);
\r
794 unit ser:class(og:boolean,x,y:integer);
\r
795 (* klasa sygnalizator swietlny*)
\r
798 (* 3 kolejne procedury to graficzne zapalanie swiatel na skrzyzowaniach *)
\r
800 unit semh:procedure(a:arrayof integer,s:integer);
\r
803 for i:=lower(a) to upper(a) do
\r
806 if not sem(a(i)).og then
\r
807 call seml(x,x+9,x+18,y,y,y,s);
\r
809 call seml(x,x-9,x-18,y,y,y,s);
\r
815 unit semv:procedure(a:arrayof integer,s:integer);
\r
818 for i:=lower(a) to upper(a) do
\r
821 if not sem(a(i)).og then
\r
822 call seml(x,x,x,y,y+9,y+18,s);
\r
824 call seml(x,x,x,y,y-9,y-18,s);
\r
830 unit seml :procedure(x1,x2,x3,y1,y2,y3,s:integer);
\r
833 when 0:call move(x1,y1);
\r
839 when 1:call move(x3,y3);
\r
843 when 2:call move(x2,y2);
\r
847 when 3:call move(x2,y2);
\r
853 unit parking:procedure(ni:integer,bol:boolean);
\r
854 var i,j,k,b,x,y:integer;
\r
856 if ni=11 then x:=457;y:=127;
\r
857 else x:=162;y:=286;
\r
861 while park(ni,k) do k:=k+1 od;
\r
865 while not park(ni,k) do k:=k+1 od;
\r
878 unit intoq:procedure(d,i:integer,bol:boolean);
\r
879 (* rysowanie samochodu *);
\r
880 var a,b,x,y:integer;
\r
881 unit los:procedure;
\r
884 when 1:y:=76;x:=-2+i*12;
\r
885 when 2:y:=99;x:=102-i*12;
\r
886 when 3:y:=76;x:=110+i*12;
\r
887 when 4:y:=99;x:=330-i*12;
\r
888 when 5:y:=76;x:=341+i*12;
\r
889 when 6:y:=99;x:=590-i*12;
\r
890 when 7:y:=208;x:=110+i*12;
\r
891 when 8:y:=218;x:=330-i*12;
\r
892 when 9:x:=105;y:=204-i*12;
\r
893 when 10:x:=117;y:=95+i*12;
\r
894 when 11:x:=105;y:=333-i*12;
\r
895 when 12:x:=117;y:=214+i*12;
\r
896 when 13:x:=333;y:=204-i*12;
\r
897 when 14:x:=343;y:=95+i*12;
\r
898 when 15:x:=333;y:=333-i*12;
\r
899 when 16:x:=343;y:=214+i*12;
\r
900 when 17:x:=105;y:=70-i*12;
\r
901 when 18:x:=117;y:=-6+i*12;
\r
902 when 19:y:=76;x:=485+i*12;
\r
903 when 20:y:=99;x:=488-i*12;
\r
904 when 21:y:=76;x:=341+i*12;
\r
905 when 22:y:=99;x:=590-i*12;
\r
906 when 23:y:=208;x:=218+i*12;
\r
907 when 24:y:=218;x:=221-i*12;
\r
908 when 25:y:=208;x:=110+i*12;
\r
909 when 26:y:=218;x:=330-i*12;
\r
918 if d>8 and d<19 then b:=2 else b:=1 fi;
\r
922 call putmap(c(b+2));
\r
927 var drogi,park:arrayof arrayof boolean;
\r
929 var sem:arrayof ser;
\r
932 array drogi dim (1:26);
\r
934 array drogi(i) dim(1:8);
\r
937 array drogi(i) dim(1:10);
\r
939 array drogi(1) dim(1:8);
\r
940 array drogi(2) dim(1:8);
\r
941 array drogi(3) dim(1:17);
\r
942 array drogi(4) dim(1:17);
\r
943 array drogi(5) dim(1:20);
\r
944 array drogi(6) dim(1:20);
\r
945 array drogi(7) dim(1:17);
\r
946 array drogi(8) dim(1:17);
\r
947 array drogi(9) dim(1:9);
\r
948 array drogi(10) dim(1:9);
\r
949 array drogi(13) dim(1:9);
\r
950 array drogi(14) dim(1:9);
\r
951 array drogi(17) dim(1:6);
\r
952 array drogi(18) dim(1:6);
\r
953 array drogi(19) dim(1:9);
\r
954 array drogi(20) dim(1:11);
\r
955 array drogi(21) dim(1:11);
\r
956 array drogi(22) dim(1:9);
\r
958 array sem dim(1:13);
\r
959 array ile dim(1:4);
\r
961 array c(i) dim(1:10);
\r
963 array c(5) dim(1:15);
\r
964 array c(6) dim(1:15);
\r
965 array park dim(10:11);
\r
966 array park(10) dim(1:60);
\r
967 array park(11) dim(1:6);
\r
968 call gron(1); (* rysowanie planu skrzyzowan oraz sygnalizatorow *)
\r
972 c(5):=getmap(56,4);
\r
975 c(6):=getmap(140,87);
\r
976 call semafv(90,35,true);
\r
977 sem(1):=new ser(true,91,57);
\r
978 call semafv(90,170,true);
\r
979 sem(2):=new ser(true,91,192);
\r
980 call semafv(127,229,false);
\r
981 sem(3):=new ser(false,128,230);
\r
982 call semafv(127,110,false);
\r
983 sem(4):=new ser(false,128,111);
\r
984 call semafv(318,170,true);
\r
985 sem(5):=new ser(true,319,192);
\r
986 call semafv(356,229,false);
\r
987 sem(6):=new ser(false,357,230);
\r
988 call semafv(356,110,false);
\r
989 sem(7):=new ser(false,357,111);
\r
990 call semafh(127,56,false);
\r
991 sem(8):=new ser(false,128,57);
\r
993 call semafh(356,56,false);
\r
994 sem(9):=new ser(false,357,57);
\r
995 call semafh(70,110,true);
\r
996 sem(10):=new ser(true,92,111);
\r
997 call semafh(298,110,true);
\r
998 sem(11):=new ser(true,320,111);
\r
999 call semafh(127,191,false);
\r
1000 sem(12):=new ser(false,128,192);
\r
1001 call semafh(298,229,true);
\r
1002 sem(13):=new ser(true,320,230);
\r
1007 unit droga:simulation class;
\r
1008 unit zmiany:procedure;
\r
1026 when qord:call gr.groff;
\r
1028 when zord:call change;
\r
1032 unit change:procedure;
\r
1033 var x,y,i:integer;
\r
1035 call gr.move(595,150);
\r
1036 call gr.outhline(unpack("ktore skrzyz."));
\r
1037 i:=gr.cyfra(gr.inhline(600,160,1));
\r
1038 if i>0 and i<5 then
\r
1039 call gr.move(595,170);
\r
1040 call gr.outhline(unpack("zielone ?"));
\r
1041 cros(i) qua cross.htim:=gr.cyfra(gr.inhline(600,180,2));
\r
1042 call gr.move(595,190);
\r
1043 call gr.outhline(unpack("zolte ?"));
\r
1044 cros(i) qua cross.otim:=gr.cyfra(gr.inhline(600,200,2));
\r
1045 call gr.move(595,210);
\r
1046 call gr.outhline(unpack("czerwone ?"));
\r
1047 cros(i) qua cross.vtim:=gr.cyfra(gr.inhline(600,220,2));
\r
1050 call gr.move(594,140+i*10);
\r
1051 call gr.outhline(unpack(" "));
\r
1056 unit cross:simprocess class;(* skrzyzowanie *);
\r
1057 var co,ro,sh,sv:arrayof integer;
\r
1058 var qu :arrayof kolej;
\r
1059 var openz,tr :arrayof boolean;
\r
1060 var vtim,htim,otim,sctim :integer;(* czas swiecenia sygnalizatora *);
\r
1061 var sigsta :integer;(* stan sygnalizatorow na skrzyzowaniu *);
\r
1062 var ver,hor :integer;(* liczba kolejek pionowych i poziomych *);
\r
1064 unit outfrom:procedure(a,b:integer);(* wypychanie samochodow z kolejek *);
\r
1069 while time<=sctim and ok do
\r
1072 if not qu(i).endc then call run (qu(i).firstq);ok:=true; fi;
\r
1079 array tr dim (1:2);
\r
1080 array openz dim(1:2);
\r
1083 if bzi=32 then call zmiany fi;;
\r
1084 sigsta:=(sigsta + 1) mod 4;(* zmiana swiatel*);
\r
1085 call gr.semh(sh,sigsta);
\r
1086 call gr.semv(sv,(sigsta+2)mod 4);
\r
1089 when 0:openz(1):=true;
\r
1090 if tr(1) then tr(1):=false;call run(tramm(1)) fi;
\r
1091 if tr(2) then tr(2):=false;call run(tramm(2)) fi;
\r
1093 call outfrom(1,hor);
\r
1094 when 1: openz(1):=false;
\r
1096 when 2: openz(2):=true;
\r
1098 call outfrom(hor+1,ver+hor);
\r
1099 when 3: openz(2):=false;
\r
1102 call schedule(this cross,sctim);
\r
1107 unit wolno:function(a,b:integer):integer;(* obliczenie miejsca *)
\r
1108 var bol:boolean; (* stania na skrzyzowaniu *)
\r
1110 if a>0 and a<5 then
\r
1112 when 1,2 :if b>8 and b<19 then
\r
1113 bol:=cros(a) qua cross.openz(2);
\r
1114 result:=b mod 2 +3
\r
1116 bol:=cros(a) qua cross.openz(1);
\r
1117 result:=b mod 2 +1;
\r
1119 when 3,4 :if (b<9 or b>18) and b=/=0 then
\r
1121 bol:=cros(a) qua cross.openz(1);
\r
1123 result:=b mod 2 +2;
\r
1124 bol:=cros(a) qua cross.openz(2);
\r
1127 if bol then (*and cros(a) qua cross.qu(result).endc*)
\r
1135 unit wyjazd:simprocess class;
\r
1136 var co,ro:arrayof integer;
\r
1139 unit parking:simprocess class(poj:integer);
\r
1140 var co,ro:arrayof integer;
\r
1142 unit park :procedure(a:car);
\r
1149 while a.finp=a.stp do
\r
1150 a.finp:=random*7+5; (* losowanie wyjazdu *)
\r
1152 call gr.parking(a.nr,true);
\r
1153 i:=150+random*360;
\r
1154 call schedule(a,time+i);
\r
1157 if a.nr=10 then a.finp:=11 else a.finp:=10 fi;
\r
1158 call schedule(a,time+2);
\r
1163 unit kolej:class(nr:integer);
\r
1165 unit elcar:class(p:car);
\r
1168 var first,last:elcar;
\r
1170 unit insert :procedure(p:car);
\r
1172 if first=none then
\r
1173 first,last:=new elcar(p);
\r
1175 last.next:=new elcar(p);
\r
1181 unit firstq:function:car;
\r
1183 if first=/=none then
\r
1185 if first.next=/=none then
\r
1186 first:=first.next;
\r
1187 else first:=none;last:=none;
\r
1195 unit endc:function:boolean;
\r
1197 result:=(first=none);
\r
1205 unit road:class(distance,line,speed:integer);(* droga *)
\r
1206 var cars :integer;
\r
1210 unit rotime: function (d,s:integer):integer;(* czas pokonania danej drogi *);
\r
1213 if s < roads(d).speed then min := s
\r
1214 else min:=roads(d).speed;
\r
1216 (*result:=roads(d).distance*3.6*((1+.1*roads(d).cars)/10*roads(d).line)/min;*)
\r
1220 unit car:simprocess class(max:integer);
\r
1221 var stp,finp,old,where,nr,nero,wol:integer;
\r
1222 var tim,bla,ble,zw:integer;
\r
1225 unit jedziecar:procedure(d,t:integer);
\r
1226 var j,k,tim:integer;
\r
1230 when 3,4,7,8:j:=16;
\r
1232 when 9,10,13,14,19,22:j:=8;
\r
1234 when 11,12,15,16:j:=9;
\r
1237 when 23,24,25,26:j:=7;
\r
1240 for k:=j downto 1 do
\r
1241 if not gr.drogi(d,k) then
\r
1242 gr.drogi(d,k):=true;
\r
1243 gr.drogi(d,k+1):=false;
\r
1244 call gr.intoq(d,k+1,false);
\r
1245 call gr.intoq(d,k,true);
\r
1252 begin (* algorytm car *)
\r
1254 finp,stp:=random*5+5; (*losowanie wjazdu *)
\r
1256 finp:=random*7+5; (* losowanie wyjazdu *)
\r
1258 tim:=360+random*360; (* czas pierwszego pojawienia sie *)
\r
1259 call schedule(this car,time+tim);
\r
1263 where:=nr; (* gdzie jest *)
\r
1266 if nr=finp then (* czy dojechal do wyjazdu *)
\r
1268 call gr.intoq(old,zw,false);
\r
1269 gr.drogi(old,zw):=false;
\r
1271 if nr>9 then call cros(nr) qua parking.park(this car);
\r
1272 if bol then call gr.parking(nr,false);
\r
1273 cros(nr) qua parking.cars:=cros(nr) qua parking.cars-1;
\r
1278 case nr (* co robic w zaleznosci od miejsca pobytu *)
\r
1279 when 1,2,3,4 : where:=cros(nr) qua cross.co(finp);
\r
1281 nero:=cros(nr) qua cross.ro(where);
\r
1282 gr.ile(nr):=gr.ile(nr)+1;
\r
1283 when 5,6,7,8,9: where:=cros(nr) qua wyjazd.co(finp);
\r
1285 nero:=cros(nr) qua wyjazd.ro(where);
\r
1286 when 10,11 : where:=cros(nr) qua parking.co(finp);
\r
1288 nero:=cros(nr) qua parking.ro(where);
\r
1290 wol:=wolno(nr,old);
\r
1292 call cros(nr) qua cross.qu(wol).insert(this car);
\r
1295 tim:=rotime(nero,max);
\r
1296 roads(nero).cars:=roads(nero).cars+1;
\r
1297 if old=/=0 and nr=/=10 and nr=/=11 then
\r
1298 call gr.intoq(old,zw,false);
\r
1299 gr.drogi(old,zw):=false;
\r
1302 call jedziecar(nero,tim);
\r
1304 roads(nero).cars:=roads(nero).cars-1;
\r
1309 unit tram:simprocess class(a:integer);
\r
1310 var b,i,y,x1,x2:integer;
\r
1311 var t:arrayof integer;
\r
1312 unit jazda:procedure(d:integer);
\r
1313 var x,p,i:integer;
\r
1323 when 1:d:=15;x:=125;
\r
1324 when 2:d:=7;x:=10;
\r
1325 when 3:d:=29;x:=349;
\r
1326 when 4:d:=29;x:=58;
\r
1327 when 5:d:=24;x:=533;
\r
1328 when 6:d:=32;x:=282;
\r
1331 call gr.move(x,y);
\r
1332 call gr.putmap(gr.c(5));
\r
1350 if a=1 then y:=90;x2:=538
\r
1351 else y:=83;x2:=21; fi;
\r
1354 call schedule(this tram,time+b);
\r
1356 if wolno(t(2),t(1))=/=0 then
\r
1357 cros(t(2)) qua cross.tr(a):=true;
\r
1362 if not cros(t(4)) qua cross.openz(1) then
\r
1363 cros(t(4)) qua cross.tr(a):=true;
\r
1367 call gr.move(x2,y);
\r
1368 call gr.putmap(gr.c(6));
\r
1374 unit gencar:simprocess class;(* generator samochodow *);
\r
1375 var t,i,b:integer;
\r
1378 for i:=1 to 10 do (******?????bylo 20 ????*****)
\r
1380 b:=random*(41)+60;
\r
1382 call schedule(p,t);
\r
1383 readln ; (* to ja ???????????*)
\r
1385 readln ; (* to ja ???????????*)
\r
1388 call schedule(cros(i),time+i);
\r
1390 call schedule(tramm(1),time+3);
\r
1391 call schedule(tramm(2),time+4);
\r
1398 cros :arrayof simprocess,
\r
1399 roads :arrayof road,
\r
1400 tramm:arrayof tram,
\r
1403 unit prepkol:procedure;
\r
1405 array cros(1) qua cross.qu dim(1:4);
\r
1406 array cros(2) qua cross.qu dim(1:3);
\r
1407 array cros(3) qua cross.qu dim(1:3);
\r
1408 array cros(4) qua cross.qu dim(1:3);
\r
1409 cros(1) qua cross.qu(1):=new kolej(2);
\r
1410 cros(1) qua cross.qu(2):=new kolej(3);
\r
1411 cros(1) qua cross.qu(3):=new kolej(10);
\r
1412 cros(1) qua cross.qu(4):=new kolej(17);
\r
1413 cros(2) qua cross.qu(1):=new kolej(4);
\r
1414 cros(2) qua cross.qu(2):=new kolej(5);
\r
1415 cros(2) qua cross.qu(3):=new kolej(14);
\r
1416 cros(3) qua cross.qu(1):=new kolej(7);
\r
1417 cros(3) qua cross.qu(2):=new kolej(12);
\r
1418 cros(3) qua cross.qu(3):=new kolej(9);
\r
1419 cros(4) qua cross.qu(1):=new kolej(8);
\r
1420 cros(4) qua cross.qu(2):=new kolej(16);
\r
1421 cros(4) qua cross.qu(3):=new kolej(13);
\r
1425 unit preproad:procedure;
\r
1427 array roads dim(1:26);
\r
1428 roads(1):=new road(90,1,90);
\r
1429 roads(2):=new road(90,1,90);
\r
1430 roads(3):=new road(400,1,80);
\r
1431 roads(4):=new road(400,1,80);
\r
1432 roads(5):=new road(400,1,90);
\r
1433 roads(6):=new road(400,1,90);
\r
1434 roads(7):=new road(400,1,70);
\r
1435 roads(8):=new road(400,1,70);
\r
1436 roads(9):=new road(200,1,70);
\r
1438 roads(10):=new road(200,1,70);
\r
1439 roads(11):=new road(220,1,70);
\r
1440 roads(12):=new road(220,1,70);
\r
1441 roads(13):=new road(200,1,70);
\r
1442 roads(14):=new road(200,1,70);
\r
1443 roads(15):=new road(220,1,70);
\r
1444 roads(16):=new road(220,1,70);
\r
1445 roads(17):=new road(100,1,70);
\r
1446 roads(18):=new road(100,1,70);
\r
1447 roads(19):=new road(160,1,90);
\r
1448 roads(20):=new road(240,1,90);
\r
1449 roads(21):=new road(240,1,90);
\r
1450 roads(22):=new road(160,1,90);
\r
1451 roads(23):=new road(200,1,70);
\r
1452 roads(24):=new road(200,1,70);
\r
1453 roads(25):=new road(200,1,70);
\r
1454 roads(26):=new road(200,1,70);
\r
1459 array cros dim(1:11);
\r
1461 cros(i):=new cross;
\r
1464 cros(i):=new wyjazd;
\r
1466 cros(10):=new parking(60);
\r
1467 cros(11):=new parking(6);
\r
1468 array tramm dim(1:2);
\r
1469 tramm(1):=new tram(1);
\r
1470 tramm(2):=new tram(2);
\r
1473 array cros(1) qua cross.sh dim(1:2);
\r
1474 array cros(2) qua cross.sh dim(1:2);
\r
1475 array cros(3) qua cross.sh dim(1:1);
\r
1476 array cros(4) qua cross.sh dim(1:1);
\r
1477 array cros(1) qua cross.sv dim(1:2);
\r
1478 array cros(2) qua cross.sv dim(1:1);
\r
1479 array cros(3) qua cross.sv dim(1:2);
\r
1480 array cros(4) qua cross.sv dim(1:2);
\r
1482 cros(i) qua cross.hor:=1;
\r
1483 cros(i) qua cross.ver:=2;
\r
1485 cros(1) qua cross.hor:=2;
\r
1486 cros(2) qua cross.hor:=2;
\r
1487 cros(2) qua cross.ver:=1;
\r
1488 cros(1) qua cross.sh(1):=8;
\r
1490 cros(1) qua cross.sh(2):=10;
\r
1491 cros(2) qua cross.sh(1):=9;
\r
1492 cros(2) qua cross.sh(2):=11;
\r
1493 cros(3) qua cross.sh(1):=12;
\r
1494 cros(4) qua cross.sh(1):=13;
\r
1495 cros(1) qua cross.sv(1):=1;
\r
1496 cros(1) qua cross.sv(2):=4;
\r
1497 cros(2) qua cross.sv(1):=7;
\r
1498 cros(3) qua cross.sv(1):=2;
\r
1499 cros(3) qua cross.sv(2):=3;
\r
1500 cros(4) qua cross.sv(1):=5;
\r
1501 cros(4) qua cross.sv(2):=6;
\r
1503 array cros(i) qua cross.co dim (5:11);
\r
1506 array cros(i) qua wyjazd.co dim (5:11);
\r
1508 array cros(10) qua parking.co dim (5:11);
\r
1509 array cros(11) qua parking.co dim (5:11);
\r
1511 cros(1) qua cross.co(i):=2;
\r
1512 cros(2) qua cross.co(i):=1;
\r
1513 cros(3) qua cross.co(i):=1;
\r
1514 cros(4) qua cross.co(i):=2;
\r
1515 cros(5) qua wyjazd.co(i):=3;
\r
1516 cros(6) qua wyjazd.co(i):=4;
\r
1517 cros(7) qua wyjazd.co(i):=2;
\r
1518 cros(8) qua wyjazd.co(i):=1;
\r
1519 cros(9) qua wyjazd.co(i):=1;
\r
1520 cros(10) qua parking.co(i):=3;
\r
1521 cros(11) qua parking.co(i):=2;
\r
1523 cros(1) qua cross.co(5):=3;
\r
1524 cros(1) qua cross.co(8):=8;
\r
1525 cros(1) qua cross.co(9):=9;
\r
1526 cros(1) qua cross.co(10):=3;
\r
1527 cros(2) qua cross.co(6):=4;
\r
1528 cros(2) qua cross.co(7):=7;
\r
1529 cros(2) qua cross.co(10):=4;
\r
1530 cros(2) qua cross.co(11):=11;
\r
1531 cros(3) qua cross.co(5):=5;
\r
1532 cros(3) qua cross.co(6):=4;
\r
1533 cros(3) qua cross.co(10):=10;
\r
1534 cros(4) qua cross.co(5):=3;
\r
1535 cros(4) qua cross.co(6):=6;
\r
1536 cros(4) qua cross.co(10):=10;
\r
1537 cros(7) qua wyjazd.co(11):=11;
\r
1538 cros(10) qua parking.co(6):=4;
\r
1539 cros(10) qua parking.co(7):=4;
\r
1540 cros(10) qua parking.co(11):=4;
\r
1541 cros(11) qua parking.co(7):=7;
\r
1542 array cros(1) qua cross.ro dim(2:9);
\r
1543 array cros(2) qua cross.ro dim(1:11);
\r
1544 array cros(3) qua cross.ro dim(1:10);
\r
1545 array cros(4) qua cross.ro dim(2:10);
\r
1546 array cros(5) qua wyjazd.ro dim(3:3);
\r
1548 array cros(6) qua wyjazd.ro dim(4:4);
\r
1549 array cros(7) qua wyjazd.ro dim(2:11);
\r
1550 array cros(8) qua wyjazd.ro dim(1:1);
\r
1551 array cros(9) qua wyjazd.ro dim(1:1);
\r
1552 array cros(10) qua parking.ro dim(3:4);
\r
1553 array cros(11) qua parking.ro dim(2:7);
\r
1554 cros(1) qua cross.ro(2):=4;
\r
1555 cros(1) qua cross.ro(3):=9;
\r
1556 cros(1) qua cross.ro(8):=18;
\r
1557 cros(1) qua cross.ro(9):=1;
\r
1558 cros(2) qua cross.ro(1):=3;
\r
1559 cros(2) qua cross.ro(4):=13;
\r
1560 cros(2) qua cross.ro(7):=6;
\r
1561 cros(2) qua cross.ro(11):=20;
\r
1562 cros(3) qua cross.ro(1):=10;
\r
1563 cros(3) qua cross.ro(4):=8;
\r
1564 cros(3) qua cross.ro(5):=11;
\r
1565 cros(3) qua cross.ro(10):=24;
\r
1566 cros(4) qua cross.ro(2):=14;
\r
1567 cros(4) qua cross.ro(3):=7;
\r
1568 cros(4) qua cross.ro(6):=15;
\r
1569 cros(4) qua cross.ro(10):=23;
\r
1571 cros(5) qua wyjazd.ro(3):=12;
\r
1572 cros(6) qua wyjazd.ro(4):=16;
\r
1573 cros(7) qua wyjazd.ro(2):=5;
\r
1574 cros(7) qua wyjazd.ro(11):=19;
\r
1575 cros(8) qua wyjazd.ro(1):=17;
\r
1576 cros(9) qua wyjazd.ro(1):=2;
\r
1577 cros(10) qua parking.ro(3):=25;
\r
1578 cros(10) qua parking.ro(4):=26;
\r
1579 cros(11) qua parking.ro(2):=21;
\r
1580 cros(11) qua parking.ro(7):=22;
\r
1581 cros(1) qua cross.htim:=60;
\r
1582 cros(1) qua cross.vtim:=30;
\r
1583 cros(2) qua cross.htim:=60;
\r
1584 cros(2) qua cross.vtim:=30;
\r
1585 cros(3) qua cross.htim:=40;
\r
1586 cros(3) qua cross.vtim:=50;
\r
1587 cros(4) qua cross.htim:=40;
\r
1588 cros(4) qua cross.vtim:=50;
\r
1589 cros(1) qua cross.sigsta:=0;
\r
1590 cros(2) qua cross.sigsta:=0;
\r
1591 cros(3) qua cross.sigsta:=0;
\r
1592 cros(4) qua cross.sigsta:=0;
\r
1596 readln; (*??????? to ja ????? *)
\r