2 (*****************************************************************************)
\r
4 (* Program autorstwa Tomasza Michalaka i Piotra Miekusa. *)
\r
5 (* Coroutiny biorace udzial w grze sa sparametryzowana coroutina jednego *)
\r
6 (* typu.Dokonano rowniez wielu zmian i poprawek w wspolprogramie arbitra *)
\r
8 (*****************************************************************************)
\r
10 var kostka,i,ia:integer;
\r
11 var tab: arrayof arrayof integer;
\r
12 var gracz: arrayof coroutine;
\r
16 unit player:iiuwgraph coroutine(g:integer);
\r
17 var x,y,i,j,k,l:integer;
\r
24 call A.outhline("use curcors to point pawn");
\r
26 call A.outhline(" and press END");
\r
29 call track(360,230);
\r
33 call A.outhline(" ");
\r
35 call A.outhline(" ");
\r
49 if k>0 andif l>0 andif k<47 andif l<36 then b:=true; exit fi;
\r
51 if b then call A.przesunpion(i);
\r
52 else call A.przesunpion(0);
\r
59 unit gracz1:coroutine(g,eh,spp:integer);
\r
61 var stran :arrayof integer;
\r
62 var pp,j,i,nrkil,witch :integer;
\r
63 var home :arrayof boolean;
\r
64 var polepos :boolean;
\r
66 unit man:class; (* pawn *)
\r
67 var ple,saf,rsa :integer;
\r
68 var kil,hun,fin,mov :boolean;
\r
71 var pawn :arrayof man;
\r
73 unit pawns:procedure;
\r
77 pawn(i).ple:=tab(g,i);
\r
81 for i:=1 to 4 do home(i):=false; od;
\r
84 if h=0 then pp:=pp+1 fi;
\r
85 if h=spp then polepos:=false fi;
\r
86 if h>100 then home(h-100):=true fi;
\r
88 if pp=0 then polepos:=false fi;
\r
91 unit finish:function:boolean;
\r
92 unit inhome:function(a:integer):boolean;
\r
95 if a>1 andif a<=eh andif a+kostka>eh then
\r
96 if a+kostka-eh<5 andif not home(a+kostka-eh) then
\r
100 pawn(i).mov:=false;
\r
103 pawn(i).mov:=true;
\r
109 pawn(i).fin:=false;
\r
110 if pawn(i).ple>0 andif pawn(i).ple<99 then
\r
111 if inhome(pawn(i).ple) then
\r
116 pawn(i).mov:=false;
\r
121 unit killer:function:integer;
\r
124 pawn(i).kil:=false;
\r
125 pawn(i).hun:=false;
\r
127 if j>0 andif j<50 then
\r
129 if j>40 then j:=j-40 fi;
\r
130 if stran(j)=/=0 then
\r
131 if stran(j)=/=g then
\r
135 pawn(i).mov:=false;
\r
143 unit strangers:procedure;
\r
145 for i:=1 to 40 do stran(i):=0;od;
\r
148 if tab(i,j)>0 andif tab(i,j)<50 then
\r
149 stran(tab(i,j)):=i;
\r
155 unit safety:procedure;
\r
156 unit rafset:function(a:integer):integer;
\r
158 var finplo :boolean;
\r
160 if a>40 then a:=a mod 40 fi;
\r
164 if (a+9) div 10 =/=g then result:=1 fi;
\r
167 if a = 1 then a:=40;
\r
171 if a mod 10 =0 then finplo:=true fi;
\r
172 if b=/=0 andif b=/=g then
\r
174 c:=(((a-1) div 10)+2) mod 4;
\r
175 if c=0 then c:=4 fi;
\r
176 if c=/=g then result:=result+1 fi;
\r
185 if pawn(i).ple>0 andif pawn(i).ple<99 then
\r
186 pawn(i).saf:=rafset(pawn(i).ple);
\r
187 pawn(i).rsa:=pawn(i).saf-rafset(pawn(i).ple+kostka);
\r
195 unit move:procedure;
\r
197 var moves:arrayof boolean;
\r
202 array moves dim(1:4);
\r
205 if not pawn(i).kil andif pawn(i).hun then
\r
211 if not pawn(i).kil andif pawn(i).ple>0 andif pawn(i).mov then
\r
212 if speed orif moves(i) then
\r
213 if pawn(i).rsa>j then
\r
221 if witch>4 then witch:=0 fi;
\r
225 array pawn dim(1:4);
\r
226 array home dim(1:4);
\r
227 array stran dim(1:40);
\r
237 if pawn(i).fin then witch:=i fi;
\r
240 if polepos and kostka=6 then
\r
242 while tab(g,i)=/=0 do i:=i+1; od;
\r
243 if i>4 then i:=4 fi;
\r
248 if nrkil=/=4-pp then
\r
254 call A.przesunpion(witch);
\r
261 unit gracz3:coroutine;
\r
263 unit possible_pool:function(gracz,pion,kostka:integer):integer;
\r
264 var beg,dom,i:integer,b:boolean;
\r
266 beg:=(gracz-1)*10+1;
\r
267 if tab(gracz)(pion)=0 then
\r
268 if kostka=6 then result:=beg;
\r
272 if tab(gracz)(pion)>=100 then result:=0;
\r
274 if tab(gracz)(pion)<beg and tab(gracz)(pion)+kostka>=beg then
\r
275 dom:=kostka+tab(gracz)(pion)+100;
\r
278 if tab(gracz)(i)=dom then b:=true; fi;
\r
279 if b then result:=0; else result:=100; fi;
\r
284 if i<>pion andif tab(gracz)(pion)+kostka=tab(gracz)(i) then
\r
288 if b then result:=0;
\r
289 else result:=tab(gracz)(pion)+kostka;
\r
296 unit inni_w_domu:function(gracz:integer):integer;
\r
301 if tab(gracz)(i)>=100 then result:=result+1;
\r
306 unit inni_jeszcze_w_domu:function(gracz:integer):integer;
\r
311 if tab(gracz)(i)=0 then result:=result+1;
\r
314 end inni_jeszcze_w_domu;
\r
316 unit wyjscie_z_domu:function(pion:integer):integer;
\r
318 if tab(3)(pion)=0 and kostka=6 then result:=1;
\r
321 end wyjscie_z_domu;
\r
323 unit state_of_player:function(player:integer):integer;
\r
328 if tab(player,i)=0 then result:=result-1;
\r
330 if tab(player,i)>=100 then result:=result+2;
\r
334 if result<0 then result:=0;
\r
336 end state_of_player;
\r
338 unit pod_biciem:function(pool:integer):integer;
\r
341 if pool=0 or pool>=100 then result:=0;
\r
347 if possible_pool(i,j,k)=pool then result:=result+1;
\r
356 unit wyjscie_spod_bicia:function(pion:integer):integer;
\r
359 p:=pod_biciem(tab(3)(pion));
\r
361 k:=pod_biciem(possible_pool(3,pion,kostka));
\r
362 if p-k>0 then result:=p-k;
\r
364 if p=k then result:=spodmn*p;
\r
369 end wyjscie_spod_bicia;
\r
371 unit wejscie_pod_bicie:function(pion:integer):integer;
\r
373 result:=pod_biciem(possible_pool(3,pion,kostka));
\r
374 end wejscie_pod_bicie;
\r
376 unit bicie:function(pion:integer):integer;
\r
380 p:=possible_pool(3,pion,kostka);
\r
385 if tab(i,j)=p then result:=state_of_player(i)*3;
\r
393 unit stoi_moj:function(pole:integer):boolean;
\r
397 for pion:=1 to 4 do
\r
398 if tab(3,pion)=pole then result:=true; fi;
\r
402 unit dom:function(pion:integer):integer;
\r
404 if tab(3)(pion)<100 and possible_pool(3,pion,kostka)>=100 then
\r
410 var turniej:arrayof integer;
\r
412 var spodmn,inni,innij:integer;
\r
415 array turniej dim(1:4);
\r
419 (* call A.gdziepiony; *)
\r
420 for ii:=1 to 4 do turniej(ii):=0; od;
\r
421 inni:=inni_w_domu(1);
\r
422 inni:=inni+inni_w_domu(2);
\r
423 inni:=inni+inni_w_domu(4);
\r
424 innij:=inni_jeszcze_w_domu(1);
\r
425 innij:=innij+inni_jeszcze_w_domu(2);
\r
426 innij:=innij+inni_jeszcze_w_domu(4);
\r
428 turniej(ii):=turniej(ii)+dom(ii)*inni*3;
\r
429 turniej(ii):=turniej(ii)+wyjscie_z_domu(ii)*(inni+innij);
\r
430 turniej(ii):=turniej(ii)+bicie(ii);
\r
431 turniej(ii):=turniej(ii)-wejscie_pod_bicie(ii);
\r
432 turniej(ii):=turniej(ii)+wyjscie_spod_bicia(ii);
\r
435 if possible_pool(3,ii,kostka)=0
\r
436 orif stoi_moj(possible_pool(3,ii,kostka))
\r
437 then turniej(ii):=-1; fi;
\r
441 if turniej(ii)>turniej(j) then j:=ii;
\r
443 if turniej(ii)=turniej(j) then
\r
444 if tab(3)(ii)>tab(3)(j) then j:=ii;
\r
448 if turniej(j)>=0 then
\r
449 call A.przesunpion(j);
\r
455 (***************************************************************)
\r
458 unit gracz4: coroutine;
\r
463 var players : arrayof boy;
\r
466 var pos,back : integer;
\r
467 var suicide,stab,finish,moveout : boolean;
\r
470 unit playerinit:procedure;
\r
474 players(i).pos:=tab(g,i);
\r
478 unit finishing:function(nr:integer):boolean;
\r
482 i:=players(nr).pos;
\r
485 if i+kostka>endpos and i+kostka<endpos+5 and i<=endpos
\r
492 if (players(j).pos-100+1)=i+kostka-endpos
\r
493 then result:=false;
\r
501 unit suiciding:function(nr:integer):boolean;
\r
505 if players(nr).pos<>0
\r
511 if (players(nr).pos+kostka-1) mod 40 + 1 = players(i).pos
\r
512 andif players(i).pos<100
\r
522 if i<>nr andif players(i).pos=start
\r
530 unit stabing:function(nr:integer):boolean;
\r
541 if players(nr).pos > 0 and players(nr).pos <100
\r
543 b1:=(players(nr).pos+kostka-1) mod 40 +1 =tab(i,j) ;
\r
544 b2:=players(nr).pos>=start and b1;
\r
545 if b1 and (players(nr).pos+kostka-1) mod 40 + 1<=endpos orif b2
\r
551 result:=(kostka=6 and players(nr).pos=0 and tab(i,j)=start);
\r
559 unit atback:function(nr:integer):integer;
\r
560 var i,j,np:integer;
\r
562 np:=players(nr).pos;
\r
577 then result:=result+1;
\r
580 if tab(i,j) > 40-(6-np)
\r
581 then result:=result+1;
\r
595 andif tab(i,j) > np-7
\r
596 then result:=result +1;
\r
605 unit begining : function(nr:integer):boolean;
\r
607 result:=players(nr).pos=0 and kostka=6;
\r
610 unit move:function:integer;
\r
611 var i,j,k : integer;
\r
616 players(i).back:=atback(i);
\r
617 players(i).suicide:=suiciding(i);
\r
618 players(i).stab:=stabing(i);
\r
619 players(i).finish:=finishing(i);
\r
620 players(i).moveout:=begining(i);
\r
623 (********************* bije i wychodzi ************)
\r
626 if players(i).moveout
\r
637 ok:=true; exit exit exit;
\r
644 (******************** gonia go i konczy **************)
\r
649 if players(i).pos>0
\r
650 andif players(i).pos<100
\r
651 andif players(i).finish
\r
652 andif players(i).back > 0
\r
659 (******************** gonia go i bije ******************)
\r
664 if players(i).pos<100
\r
665 andif players(i).back>0
\r
666 andif players(i).stab
\r
673 (******************* bije ********************************)
\r
685 (******************** goni go conajmniej dwoch **********)
\r
690 if players(i).pos<100
\r
691 andif players(i).back>=2
\r
692 andif not players(i).suicide
\r
699 (******************* wychodzi ****************************)
\r
704 if players(i).moveout
\r
705 andif not players(i).suicide
\r
713 (******************* konczy *******************************)
\r
718 if players(i).finish
\r
726 (******************** gonia go **********)
\r
731 if players(i).pos<100
\r
732 andif players(i).pos>0
\r
733 andif players(i).back>0
\r
734 andif not players(i).suicide
\r
741 (******************* nie bije swojego *********************)
\r
746 if players(i).pos<100
\r
747 andif players(i).pos>0
\r
748 andif not players(i).suicide
\r
755 (******************* bije swojego *********************)
\r
760 if players(i).suicide
\r
769 if not ok then result:=0 fi;
\r
779 (****** MAIN *****)
\r
780 (*****************)
\r
785 array players dim(1:4);
\r
788 players(i):=new boy;
\r
794 call A.przesunpion(m);
\r
801 (********* * * * * * * * * * * * *************)
\r
804 unit arbiter:iiuwgraph coroutine;
\r
806 var x,y,zawod,i,j,ktory,sk : integer;
\r
807 var polestartu,skon,zero,wejscie,plansza: arrayof integer;
\r
808 var dom,old,tabcub : arrayof arrayof integer;
\r
809 var tabpi : arrayof arrayof arrayof integer;
\r
810 var dtab : arrayof arrayof string;
\r
811 var ctabs : arrayof string;
\r
814 (********** plan **************)
\r
816 unit line:class(x1,y1,x2,y2:integer);
\r
819 unit inchar : function: integer;
\r
824 if i <> 0 then exit fi;
\r
829 unit OUTHLINE: procedure(b:string);
\r
831 var a :arrayof char;
\r
838 call hascii(ord(a(j)));
\r
842 unit sdrp:procedure(a,b,c,d:integer);
\r
851 unit sdrp1:procedure;
\r
853 call sdrp(45,76,23,49);
\r
861 unit sdrp2:procedure;
\r
863 call sdrp(48,82,23,49);
\r
871 unit sdrp3:procedure;
\r
873 call sdrp(48,82,26,52);
\r
881 unit sdrp4:procedure;
\r
883 call sdrp(45,76,26,52);
\r
892 unit drp1:procedure(a,b:integer,t:arrayof string);
\r
895 call outhline(t(1));
\r
897 call outhline(t(2));
\r
899 call outhline(t(3));
\r
902 unit drp11:procedure(d:integer);
\r
905 call drp1(51,25,dtab(d));
\r
908 unit drp21:procedure(d:integer);
\r
911 call drp1(53,25,dtab(d));
\r
914 unit drp31:procedure(d:integer);
\r
917 call drp1(53,28,dtab(d));
\r
920 unit drp41:procedure(d:integer);
\r
923 call drp1(51,28,dtab(d));
\r
926 unit mktab:procedure;
\r
929 array tabpi dim(1:4);
\r
931 array tabpi(i) dim(1:4);
\r
933 array tabpi(i,j) dim(1:200);
\r
940 tabpi(i,1):=getmap(84,54);
\r
947 tabpi(i,2):=getmap(84,54);
\r
954 tabpi(i,3):=getmap(84,54);
\r
961 tabpi(i,4):=getmap(84,54);
\r
965 unit piszpion:coroutine(x,y,k:integer);
\r
972 call putmap(tabpi(ktory,k));
\r
973 for j:=1 to 30 do od;
\r
975 for j:=1 to 30 do od;
\r
977 call putmap(tabpi(ktory,k));
\r
981 var pl:arrayof arrayof arrayof piszpion;
\r
984 unit mkpl:procedure;
\r
985 var a,b,c,i,j:integer;
\r
988 array pl dim(0:104);
\r
989 array pl(0) dim(1:4);
\r
991 array pl(0,i) dim (1:4);
\r
992 array pl(100+i) dim (1:4);
\r
994 array pl(100+i,j) dim (1:1);
\r
998 array pl(i) dim(1:1);
\r
999 array pl(i,1) dim(1:1);
\r
1002 open(f,integer,unpack("pola"));
\r
1009 pl(i,1,1):=new piszpion(a,b,c);
\r
1017 pl(0,i,j):=new piszpion(a,b,c);
\r
1022 for j:=101 to 104 do
\r
1026 pl(j,i,1):=new piszpion(a,b,c);
\r
1031 unit sq:procedure(x,y:integer);
\r
1033 call move(c*(x+1)+40,20+y+1);
\r
1034 call draw(c*(x+35)+40,20+y+1);
\r
1035 call draw(c*(x+35)+40,20+y+35);
\r
1036 call draw(c*(x+1)+40,20+y+35);
\r
1037 call draw(c*(x+1)+40,20+y+1);
\r
1040 unit cube:procedure;
\r
1055 unit cubes:procedure(i,a,b,c:integer);
\r
1059 call outhline(ctabs(a));
\r
1061 call outhline(ctabs(b));
\r
1063 call outhline(ctabs(c));
\r
1065 tabcub(i):=getmap(41,34);
\r
1069 unit cu:procedure(i,j:integer);
\r
1071 call move(310,70);
\r
1072 call outhline("PLAYER : ");
\r
1074 when 1: call outhline("1");
\r
1075 when 2: call outhline("2");
\r
1076 when 3: call outhline("3");
\r
1077 when 4: call outhline("4");
\r
1079 call move(360,80);
\r
1080 call putmap(tabcub(i));
\r
1083 unit hjm:procedure(nw:arrayof arrayof integer);
\r
1084 var i,j,x:integer;
\r
1086 unit drp:procedure(i,j:integer);
\r
1087 var b1,b2:boolean;
\r
1090 if not b1 then b2:=plansza(old(i,j))=0 fi;
\r
1093 attach(pl(0,i,j));
\r
1095 attach(pl(old(i,j),1,1));
\r
1097 call putmap(zero); fi;
\r
1098 if nw(i,j)=0 then x:=ktory;
\r
1100 attach(pl(0,i,j));
\r
1103 if nw(i,j)>100 then attach(pl(nw(i,j),i,1));
\r
1104 else attach(pl(nw(i,j),1,1));
\r
1112 if old(i,j)<>nw(i,j) then call drp(i,j); fi;
\r
1113 old(i,j):=nw(i,j);
\r
1116 if i=ktory then exit fi;
\r
1120 unit drpl:procedure;
\r
1121 var i,x,y,x1,x2,y1,y2:integer;
\r
1124 open(f,integer,unpack("plan"));
\r
1161 unit starter:procedure;
\r
1164 array zero dim(1:1300);
\r
1167 zero:=getmap(42,32);
\r
1168 call cubes(1,1,2,1);
\r
1169 call cubes(2,3,1,4);
\r
1170 call cubes(3,3,2,4);
\r
1171 call cubes(4,5,1,5);
\r
1172 call cubes(5,5,2,5);
\r
1173 call cubes(6,5,5,5);
\r
1184 attach(pl(0,i,j));
\r
1191 (************** end plan ***********)
\r
1194 unit przesunpion:procedure(co:integer);
\r
1195 var g,s,t:integer;
\r
1197 unit start:procedure;
\r
1199 g:=polestartu(ktory);
\r
1201 if plansza(g)=/=0 then
\r
1202 tab((plansza(g)/10),(plansza(g) mod 10)):=0;
\r
1204 plansza(g):=ktory*10+co;
\r
1207 if co<1 orif co>4 then return fi;
\r
1208 if ktory<1 orif ktory>4 then return fi;
\r
1211 if s>100 then return fi;
\r
1213 if kostka=6 then call start fi;
\r
1216 t:=wejscie(ktory);
\r
1217 if s<=t andif g>t then
\r
1219 if t<5 andif dom(ktory,t)=0 then
\r
1221 tab(ktory,co):=100+t;
\r
1226 if g>40 then g:=g-40 fi;
\r
1227 if plansza(g)=/=0 then
\r
1228 tab((plansza(g)/10),(plansza(g) mod 10)):=0;
\r
1231 plansza(g):=plansza(s);
\r
1236 unit koniec: function: boolean;
\r
1237 var doszedl: boolean;
\r
1242 if dom(ktory,i)=0 then
\r
1243 doszedl:=false;exit
\r
1253 unit komunikat: procedure;
\r
1254 var m: arrayof integer;
\r
1256 array m dim (1:4);
\r
1263 writeln (i:1," miejsce zajal gracz ",m(i):1)
\r
1267 begin (* arbiter *)
\r
1268 array tab dim (1:4);
\r
1269 array old dim (1:4);
\r
1270 array dom dim (1:4);
\r
1271 array ctabs dim (1:5);
\r
1272 array tabcub dim (1:6);
\r
1273 array plansza dim (1:40);
\r
1274 array skon dim (1:4);
\r
1275 array wejscie dim (1:4);
\r
1276 array polestartu dim (1:4);
\r
1277 array dtab dim(1:4);
\r
1281 array tabcub(i) dim(1:200);
\r
1282 array dtab(i) dim (1:3);
\r
1283 array tab(i) dim (1:4);
\r
1284 array old(i) dim (1:4);
\r
1285 array dom(i) dim (1:4);
\r
1286 polestartu(i):=10*(i-1)+1;
\r
1287 wejscie(i):=polestartu(i)-1;
\r
1291 array tabcub(i) dim(1:200);
\r
1298 dtab(1,1):=" 1 ";
\r
1315 ktory:= (ktory mod 4) + 1;
\r
1316 if skon(ktory)=/=0 then repeat fi;
\r
1318 kostka:=entier(random*6)+1;
\r
1319 call cu(kostka,ktory);
\r
1320 attach (gracz(ktory));
\r
1322 if koniec then exit exit fi;
\r
1323 if kostka=/=6 or skon(ktory)=/=0 then exit fi
\r
1333 begin (* program glowny *)
\r
1334 array gracz dim (1:4);
\r
1335 writeln ("Type how many PLAYERS want to enjoy game");
\r
1338 gracz(i) := new player(i);
\r
1340 if ia=0 then ia:=1;gracz(1):=new gracz1(1,40,1); fi;
\r
1341 for i:=ia+1 to 2 do
\r
1342 gracz(i) := new gracz1(i,(i-1)*10,i*10-9);
\r
1344 gracz(3):=new gracz3;
\r
1345 gracz(4):=new gracz4;
\r