6 (* symulacja windy wersja 5, 1 kwietnia 2000 *)
7 (*------------------------------------------------------------------------*)
8 (* klasa definiujaca procedury graficzne *)
9 (*------------------------------------------------------------------------*)
10 UNIT graph : IIUWGRAPH CLASS;
14 MaxX = 640, MaxY = 480,
15 minDx = 50,minDy=10,maxDx= 600,maxDy=450,
24 UNIT waitt : PROCEDURE;
28 IF INKEY =/= 0 THEN exit FI;
32 unit ludzik : procedure(x,y,k:integer);
39 call draw(x+2,y+10); call move(x-2,y+2);
47 unit COMMENT : procedure(ss: string);
49 call outstring(250,460,ss,cyklamen,15)
54 (*----------------------------------------------------------------------*)
57 UNIT EcRAN : graph process(node :integer);
59 H = 30,(* odleglosc miedzy pietrami*)
60 xMAXw = 400, xMINw =200, yMaxW =400,
61 xpp = 405, xpl = 195, (* poczatkowe pozycje ludzikow*)
64 PIETRA : arrayof etage,
65 MAP : arrayof integer;
68 var GORA, DOL : arrayof boolean;
70 array GORA dim(1:20); (* 20 maksymalna liczba pasazerow na pietrze*)
75 UNIT obrazWindy : procedure(pietro : integer);
77 call move(XminW,YmaxW-(pietro+1)*H);
78 MAP := getmap(XmaxW,YmaxW-pietro*H);
81 UNIT RysujWinde : procedure(Y,kolor: integer);
84 CALL patern (XminW,Y,XmaxW,Y+H,bialy,1)
89 (* i wszystkich jej pasazerow *)
92 UNIT DOM : procedure(kolor,ile_pieter:integer);
93 (* szyb windy i pietra *)
96 call patern(minDX,minDY,maxDX,maxDY,szary,1);
97 CALL patern (xMINw-2,yMaxW-(ile_pieter+1)*H,xMAXw+2,yMAXw,czarny,1);
99 for i := 0 to ile_pieter do
100 call move(minDX,yMaxW-i*H); call draw(maxDX,yMAXw-i*H);
101 (* call Guzik(true,szary,i);*)
102 (* call Guzik(false,szary,i);*)
105 call move(minDX,yMAXw-i*H); call draw(maxDX,yMAXw-i*H);
107 CALL patern (xMINw,yMAXw-i*H,xMAXw,yMAXw,bialy,1);
111 unit JESTEM : procedure(gora:boolean,k,z:integer;output i:integer);
116 if not PIETRA(z).gora(j) then
117 PIETRA(z).gora(j):= true;
118 call ludzik(xpp+10*j,yp-z*H-12,k);
124 if not PIETRA(z).dol(j) then
125 PIETRA(z).dol(j):= true;
126 call ludzik(xpl-10*j,yp-z*H-12,k);
134 unit usunZpietra: procedure(gora: boolean,pietro,i : integer);
137 PIETRA(pietro).gora(i) := false;
138 call ludzik(xpp+10*i,yp-pietro*H-12,szary);
140 PIETRA(pietro).dol(i):= false;
141 call ludzik(xpl-10*i,yp-pietro*H-12,szary);
145 unit Guzik : procedure(gora:boolean,k,i : integer);
148 call track(MaxDx-20,yMAXw-i*H-20,k,czarny,i)
150 call track(MinDx+20,yMAXw-i*H-20,k,czarny,i)
154 unit otworz : procedure(gora: boolean,i: integer);
157 call patern(xMAXw,yMAXw-(i+1)*H,xMAXw+2,yMAXw-(i)*H,szary,1)
159 call patern(xMINw,yMAXw-(i+1)*H,xMINw-2,yMAXw-(i)*H,szary,1)
163 unit zamknij : procedure(gora:boolean,i: integer);
166 call patern(xMAXw,yMAXw-(i+1)*H,xMAXw+2,yMAXw-(i)*H,czarny,1);
168 call patern(xMINw,yMAXw-(i+1)*H,xMINw-2,yMAXw-(i)*H,czarny,1)
173 unit Koniec: procedure;
176 for i:=1 to 2000 do i:=i od;
177 CALL GROFF; call ENDRUN
181 others call comment("handler EKRAN ");
186 array PIETRA dim(0:10);
187 for i := 0 to 10 do PIETRA(i) := new etage od;
188 CALL patern (xminW,yMaxW-H,xmaxW,yMaxW,szary,1);
189 call ObrazWindy(0); (* obraz windy pustej na parterze *)
192 accept RysujWinde, JESTEM, DOM, COMMENT,LUDZIK,
193 obrazWindy, GUZIK, usunZpietra, OTWORZ, ZAMKNIJ, KONIEC;
199 (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
202 UNIT LIFT : process(node,n,MAXp : integer, EKRAN : ecran);
203 (* n = ilosc pieter, MAXp = maxymalna ilosc pasazerow w windzie *)
204 (* ile = ilosc pasazerow aktualnie w windzie *)
206 minX =200, maxY = 400, maxX=400, H=30,
207 xMINw =200, xMAXw =400, yMAXw = 400,
214 VAR i,j,p,jedzNa, NaPietrze,ile : integer,
215 booo, kierunek, stoj : boolean,
216 PIETRA : arrayof guzik,
217 PRZYCISKI : arrayof boolean,
218 WWindzie : arrayof boolean;
220 UNIT opis : class( k,x,y : integer); (* opis pasazera*)
221 (* x,y odpowiada pozycji na pietrze lub w windzie *)
225 var WGORE, Wdol : boolean;
228 UNIT pauza : PROCEDURE(JakDlugo : integer);
231 for i :=1 to JakDlugo do i:=i od;
235 UNIT Wolam : procedure(Gora : boolean, pietro : integer);
238 PIETRA(pietro).wgore := true else PIETRA(pietro).wdol := true
240 call EKRAN.guzik(gora,czerwony,pietro)
243 UNIT PasazerWysiada : procedure(j : integer);
246 (* Wymazac go z windy *)
248 y := yMaxW - naPietrze*H;
249 call EKRAN.ludzik(xMINw+10*j,y-12,szary);
251 PRZYCISKI(naPietrze):= false;
252 call Ekran.ObrazWindy(naPietrze)
255 UNIT PasazerWsiada : procedure(z,na,k,poz:integer; output p:integer);
259 if not (naPietrze=z and kierunek=(z<na) and ile< maxP) then
262 (* Wymaz pasazera z pietra z=naPietrze*)
263 call EKRAN.UsunZpietra(z<na,naPIETRZE,poz);
264 y := yMaxw- naPietrze*H;
266 (* Wpisz go do windy *)
268 if not Wwindzie(j) then
274 call EKRAN.ludzik(xMAXw-10*i,y-12,k);
276 call EKRAN.ludzik(xMAXw-10*i,y-12,7);
279 call EKRAN.ludzik(xMINw+10*j,y-12,k);
285 call Ekran.RysujWinde(yMaxW-(naPietrze+1)*H,k);
286 call Ekran.Ludzik(xMinW+10*j,y-12,k);
287 PRZYCISKI(na):= true;
288 call Ekran.ObrazWindy(naPietrze)
292 UNIT PRZYJECHALA : function(p:integer) : boolean;
294 result := (naPietrze=p)
297 unit CZEKAM : procedure(i: integer);
299 call Ekran.Otworz(gora,i);
300 call Ekran.Otworz(dol,i);
301 enable PRZYJECHALA,PASAZERWSIADA, PASAZERWYSIADA;
303 call Ekran.Guzik(gora,czerwony,i);
304 call Ekran.Guzik(dol,czerwony,i);
305 (* return enable WOLAM,PRZYJECHALA,PASAZERWSIADA, PASAZERWYSIADA;*)
309 UNIT OtwieramDrzwi : procedure( i: integer);
311 call Ekran.Otworz(kierunek,i);
312 enable PRZYJECHALA,PASAZERWSIADA, PASAZERWYSIADA;
313 call Ekran.Guzik(kierunek,czerwony,i);
316 UNIT ZamykamDrzwi : procedure(gora:boolean, i: integer);
320 PIETRA(i).wgore := false else PIETRA(i).wdol := false
324 call Ekran.Zamknij(gora,i);
325 call Ekran.Guzik(gora,szary,i);
326 disable PRZYJECHALA,PASAZERwsIADA, PASAZERwySIADA;
329 UNIT KierunekJazdy : procedure;
334 if (kierunek= gora) then
335 for i := naPIETRZE+1 to n
337 if (PRZYCISKI(i) or PIETRA(i).wgore or PIETRA(i).wdol) then
340 if JedzNa=naPietrze then
341 for i := naPIETRZE-1 downto 0
343 if (PRZYCISKI(i) or PIETRA(i).wdol or PIETRA(i).wgore) then
347 else (*if kierunek= dol then *)
348 for i := naPIETRZE downto 0
350 if (PRZYCISKI(i) or PIETRA(i).wdol or PIETRA(i).wgore) then
353 if JedzNa= naPietrze then
354 for i := naPIETRZE+1 to n
356 if (PRZYCISKI(i) or PIETRA(i).wgore or PIETRA(i).wdol) then
361 stoj := (naPIETRZE=JEDZna);
362 if stoj then kierunek := not kierunek else
363 kierunek := naPietrze < JedzNa
368 unit JEDZ : procedure(gora:boolean);
371 call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H,7);
374 call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H -j,7);
376 call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H -j,15);
379 call EKRAN.RysujWinde(YmaxW-(naPietrze+2)*H,7)
382 call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H +j,7);
384 call EKRAN.RysujWinde(YmaxW-(naPietrze+1)*H +j,15);
387 call EKRAN.RysujWinde(YmaxW-(naPietrze)*H,7);
392 others call EKRAN.comment("handler LIFT");
398 array PIETRA dim(0:n);
399 for i:= 0 to n do PIETRA(i):= new guzik od;
400 array PRZYCISKI dim (0:n);
401 jedzNa := 0; naPietrze:=0;
402 array WWindzie dim(1: MAXp); (* 20 = max ilosc pasazerow *)
408 call EKRAN.RysujWinde(YmaxW-H, szary);
414 call CZEKAM(naPIETRZE);
415 for j := 1 to 10 do j := j od;
418 call ZamykamDrzwi(gora,naPIETRZE);
419 call ZamykamDrzwi(dol,naPIETRZE);
421 if kierunek = gora then
422 for i:= naPIETRZE+1 to JEDZna DO
423 (* jade na nastepne pietro *)
426 (*jezeli ktos czeka lub wysiada to zatrzymaj*)
427 if (PIETRA(i).wgore or PRZYCISKI(i)) then
429 call OtwieramDrzwi(i);
430 (* pasazerowie wsiadaja lub wysiadaja *)
431 for j := 1 to 1000 do j := j od;
432 call ZamykamDRZWI(gora,i);
436 (*if kierunek = dol*)
438 for i := naPIETRZE-1 downto jedzNA do
442 if ( PIETRA(i).wdol or PRZYCISKI(i)) then
444 call OtwieramDrzwi(i);
445 (* pasazerowie wsiadaja/ wysiadaja*)
447 call ZamykamDrzwi(dol,i);
450 od (* jedz w dol NA*);
453 OD (* zachowania windy *);
457 (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
460 UNIT PASAZER : process(node:integer,ss: string,z,na,kolor : integer,
461 winda: lift,EKRAN : ecran);
464 jest,przyjechala,Wgore,wsiadlem : boolean;
468 call EKRAN.comment("handler PASAZER");
472 BEGIN (*** opis zachowania pasazera ***)
476 call EKRAN.JESTEM(Wgore,kolor,z,i);
477 (*powinien otrzymac inormacje o swojej aktualnej pozycji na pietrze*)
478 wsiadlem := false; przyjechala:= false;
480 while not wsiadlem do
481 call Winda.Wolam(Wgore,z);
482 call WINDA.PasazerWsiada(z,na,kolor,i,j);
483 (* otrzymal od windy numerek j m lub 0 gdy nie wsiadl*)
486 while not przyjechala do
487 przyjechala := WINDA.PRZYJECHALA(na)
489 call WINDA.PasazerWysiada(j);
491 (*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
493 UNIT irandom : FUNCTION(a,b:INTEGER):INTEGER;
495 result := entier((b-a)*random + a)
501 (*===================================================================*)
502 VAR EKRAN : ecran, Winda : LIFT,
503 P : arrayof PASAZER,pp :PASAZER,
504 i,n,m,z,na,k : integer;
506 when signal1 : call EKRAN.comment("K O N I E C");
508 others call EKRAN.comment("handler PROGRAM GLOWNY ");
513 EKRAN := new Ecran(0);
515 n :=10; m := 1;(* calkowita ilosc pasazerow*)
520 Winda := new LIFT(0,n,10,EKRAN);
525 DO (* generowanie pasazerow *)
529 na,z := irandom (0,n);
530 while z=na do na := irandom(0,n) od;
532 while k=7 do k := irandom (0,14) od;
534 pp:= new pasazer(0,"aa",z,na,k,winda,EKRAN);
539 var boo : boolean, x,y,i,l,r,z : integer;
541 (* call init(1,1); call ShowCursor;*)
542 call EKRAN.comment("CONTINUE? (y/n)");
544 (* z:=0;boo:= false; i:=0;l:=0;r:=0;
545 while not (l= ord('y') or l= ord('n')) do
546 boo := getpress(x,y,i,l,r,z);
549 while not (l=ord('y') or l=ord('n')) do
552 call EKRAN.comment(" ");
554 if l= ord('n') then raise signal1 fi;
562 (***********************************************************************)
589 call ramka(420,310,480,335);
590 call ramka(422,312,478,333);
591 call ramka(421,311,479,334);
597 if j=60 then j:=0;i:=i+1 fi;
606 unit ramka:iiuwgraph procedure(x1,y1,x2,y2:integer);
617 unit virtual affichage : procedure;
622 var e: elem, next : box;
626 var premier, dernier : box;
628 unit virtual first : function : elem;
636 unit virtual insert : procedure( e: elem);
651 unit virtual delete : procedure;
655 premier := premier.next;
659 unit virtual empty : function : boolean;
661 result := (premier=none)
669 unit wstep:procedure;
672 call ramka(230,120,480,220);
673 call ramka(228,118,482,222);
674 call ramka(226,116,484,224);
676 call outstring("Symulacja windy przy pomocy procesow");
678 call outstring("GM");
680 call outstring(" Dabrowa kwiecien 2000");
686 (* Strona tytulowa *)
687 CONTINUE_IKONA := new IKONA(szary,400,400,550,430,3," CONTINUE");
688 CALL ramka (1,5,0,0,638,478,ciemnoszary,szary,bialy,czarny);
689 CALL ramka (3,3,230,30,390,80,niebieski,szary,bialy,granatowy);
690 CALL Tytul (1,270,50,czarny,szary," LIFT SIMULATION ");
692 call CONTINUE_IKONA.write_i;
695 boo := getpress(xx,yy,i,l,r,z);
696 if z=1 and CZY(xx,yy,CONTINUE_IKONA) then exit fi
698 call CONTINUE_IKONA.push;
703 when MEMERROR : call comment("Zabraklo pamieci");
704 call waitt; call GROFF;
705 when ACCERROR : call comment("Reference to none ");
706 call waitt; call GROFF;
707 when LOGERROR : call comment("Niepoprawny Attach");
708 call waitt;call GROFF;
709 when CONERROR : call comment(" Array-index error ");
710 call waitt; call GROFF;
711 when SYSERROR : call comment("input-output error");
712 call waitt; call GROFF;
713 when NUMERROR : call comment("blad numeryczny");
714 call waitt; call GROFF;
715 others : call comment("Jakis blad ");
716 call waitt; call GROFF;
727 unit restore : procedure;
728 (* odnawia kolory wierzcholkow na ekanie *)
734 lista(i).kolor := zolty;
738 UNIT strzalka : procedure(A,B : node);
739 var r : real, cx,cy,dx,dy,ex,ey,delt,del : integer;
747 r := sqrt((b.y-a.y)*(b.y-a.y)+(b.x-a.x)*(b.x-a.x));
748 cx := b.x- entier((b.x-a.x)*del/r );
749 cy := b.y- entier((b.y-a.y)*del/r );
750 dx := b.x- entier((b.x-a.x)*(del+delt)/r + (b.y-a.y)*delt/r);
751 dy := b.y- entier((b.y-a.y)*(del+delt)/r - (b.x-a.x)*delt/r);
752 ex := b.x- entier((b.x-a.x)*(del+delt)/r - (b.y-a.y)*delt/r);
753 ey := b.y- entier((b.y-a.y)*(del+delt)/r + (b.x-a.x)*delt/r);
754 call move(dx,dy); call draw(cx,cy);
755 call move(ex,ey); call draw(cx,cy);
759 unit print : procedure;
760 var aux, aux1 : node, i : integer;
762 call patern(MinX,MinY+40,MaxX,MaxY,7,1);
766 call aux.affichage(zolty);
767 if not aux.lista.empty
769 aux1 := aux.lista.first;
772 call strzalka(aux,aux1);
773 aux1 := aux.lista.next;
781 array lista dim(1:10);
785 (*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
786 (* NODE - wierzcholek grafu *)
787 (* x,y pozycja na ekranie, nr numer wierzcholka *)
788 (* lista - lista wierzcholkow incydentnych *)
789 (*----------------------------------------------------------------------*)
790 unit node : elem class(x,y,nr: integer);
794 unit affichage : procedure(c: integer);
796 call cirb(x+3,y+3,5,5,0,3600,c,1);
797 call track(x+5,y+5,nr,gris,noir);
800 unit wypisz : procedure(i: integer);
801 (* wypisz kolejnosc odwiedzania wierzcholkow *)
804 for j := 0 to 160 do j:=j; call affichage(j mod 16 ) od;
806 if k = gris then k := noir fi;
808 call track(piszX+delta,piszY,nr,gris,k);
816 unit visite : function : boolean;
817 (* Czy wierzcholek byl juz odwiedzony *)
818 (* Wierzcholek odwiedzony dostaje kolor czarny*)
820 if kolor=noir then result := true;
821 else result := false; kolor := noir
826 lista := new liste; kolor := zolty;
829 unit clear : procedure(col, minX,minY,maxX,maxY : integer);
830 var i, j, sr : integer;
833 sr := (minX+maxX) div 2;
834 for i := 0 to (maxX - minX) div 2
836 call move( sr, maxY);
837 call draw(sr +i, minY);
839 call draw(sr -i, minY);
840 for j:=1 to 100 do j:=j od;
842 for i := 0 to (maxY - minY)
844 call move( sr, maxY);
845 call draw(maxX, minY+i);
847 call draw(minX, minY+i);
848 for j:=1 to 100 do j:=j od;
854 unit clear_all : procedure(col, minX,minY,maxX,maxY : integer);
858 for i := 1 to ((maxY - minY) div 2)
860 call patern(minX+i,minY+i,maxX-i,maxY-i,3,0);
861 for j:=1 to 200 do j:=j od;
865 unit waittt : procedure;
866 var x,y,i,l,r,z : integer,boo : boolean;
868 call outstring(maxX-100,maxY+25, "CONTINUE",zielony,noir);
870 while z=0 do boo := getpress(x,y,i,l,r,z) od;
871 call outstring(maxX-100,maxY+25, " ",gris,gris);
875 unit YES : function : boolean;
876 var x,y,i,l,r,z : integer,boo : boolean;
879 while l=0 do boo := getpress(x,y,i,l,r,z) od;
880 if (l= ord('y') or l=ord('Y')) then
881 result := true else result := false
885 unit comment : procedure (s : string);
887 call patern(MinX+10,MaxY+2,MaxX,MaxY+50,gris,1);
888 call outstring(MinX+10,MaxY+16,s,noir,gris);