3 const blanc=15,bleu=1,vert=2,vertpetrole=3,rouge=4,violet=5,marron=6,grisclair=7,
\r
4 grisfonce=8,bleuroi=9,vertclair=10,free=-1;
\r
7 UNIT coord2D:class(x,y:integer);
\r
10 UNIT coord3D:class(x,y,h:integer);
\r
14 UNIT gestion_caractere: IIUWGRAPH class;
\r
16 UNIT SAISIE:function(ti,e,x,y:integer):arrayof char;
\r
30 while c<>13 and c<>27 and i<=e do
\r
34 if c>=48 and c<=57 then
\r
51 if t(1)<>' ' then exit; fi;
\r
56 UNIT ConvEnt:function(t:arrayof char):integer;
\r
60 for i:=1 to upper(t) do
\r
62 n:=n*10+(ord(t(i))-48);
\r
69 UNIT displaystring:procedure(t:arrayof char,x,y,coul:integer);
\r
73 for i:=1 to upper(t)
\r
76 call hascii(ord(t(i)));
\r
83 var x,i,j,h:integer;
\r
87 UNIT ARBTAS : class; (* structure utilis
\82e par la coroutine ordinateur *)
\r
89 var tab : arrayof element, (* tableau contenant les elements du tas *)
\r
90 nb : integer, (* entier le nombre d'elements du tas *)
\r
92 (* fonction testant si le tas est vide ou non *)
\r
93 unit vide : function : boolean;
\r
96 then result := true;
\r
100 (* fonction retournant le minimum du tas *)
\r
101 unit mini : function : element;
\r
104 then result := tab(1);
\r
108 (* fonction retournant la position d'un element dans le tas *)
\r
109 unit membre : function(elem:element) : integer;
\r
113 then for i:=1 to nb
\r
115 if tab(i).x = elem.x
\r
123 (* procedure pour inserer un nouvel element dans le tas *)
\r
124 unit inserer : procedure(elem : element);
\r
127 tabaux : arrayof element;
\r
129 if (nb >= dimen) (* on aggrandit le tableau trop petit *)
\r
130 then array tabaux dim (1:nb+1);
\r
133 tabaux(i) := tab(i);
\r
136 dimen := dimen + 1; (* la dimension du tableau est *)
\r
137 (* incremente de 1 *)
\r
139 nb := nb + 1; (* le nombre d'elements est incremente de 1 *)
\r
140 tab(nb) := elem; (* l'element a inserer est place a la fin *)
\r
142 aux := new element;
\r
143 do (* on effectue des echanges tant que le fils est inferieur *)
\r
145 if (i <= 1 ) orif ( tab(i).x >= tab(i div 2).x )
\r
148 aux := tab(i DIV 2); (* echange pere-fils *)
\r
149 tab(i DIV 2) := tab(i);
\r
155 (* procedure pour supprimer un element du tas *)
\r
156 unit supprimer : procedure(elem : element);
\r
161 if ( i <> 0 ) (* on teste si l'element appartient au tas *)
\r
163 tab(i) := tab(nb); (* le dernier element est place *)
\r
164 (* a l'endroit de l'element supprime *)
\r
165 nb := nb - 1; (* on decremente le nombre d'elements *)
\r
166 aux := new element;
\r
168 while ( i <= (nb div 2) )
\r
169 do (* tant que tab(i) n'est pas une feuille *)
\r
171 if (2*i = nb) orif (tab(2*i).x < tab(2*i + 1).x)
\r
172 then j := 2*i; (* on calcule l'indice du plus petit *)
\r
173 else j := 2*i + 1; (* des 2 fils *)
\r
176 if tab(i).x > tab(j).x
\r
177 then aux := tab(i); (* echange si la condition d'ordre *)
\r
178 tab(i) := tab(j);(* n'est pas satisfaite *)
\r
184 tab(nb + 1) := none; (* le dernier element est supprime *)
\r
189 array tab dim (1:10);
\r
196 UNIT elem:class(i,j,k:integer);
\r
201 UNIT pile:class; (* structure utilis
\82e par la coroutine controle*)
\r
204 UNIT empiler:procedure(e:elem);
\r
210 UNIT depiler:procedure;
\r
215 pointeur:=pointeur.prec;
\r
220 UNIT sommet:function:elem;
\r
225 UNIT vide:function:boolean;
\r
227 result:=(pointeur=none);
\r
233 UNIT drawrect: IIUWGRAPH procedure(x1,y1,x2,y2,couleur:integer);
\r
235 call color(couleur);
\r
244 UNIT player: gestion_caractere class(couleur:integer,pl:plateau_jeu);
\r
249 UNIT ordi: player coroutine;
\r
251 var coinlibre,find:boolean,
\r
252 coin,c,quel,version:integer,
\r
254 pos:integer,cointab:arrayof coord2D,
\r
255 posajouer:arrayof arrayof integer,
\r
257 adver,moi:arrayof info;
\r
261 UNIT info: class(n,sur:integer);
\r
262 var rangee:arrayof arrayof combinaison;
\r
269 array rangee dim(1:n);
\r
270 for i:=1 to n do array rangee(i) dim (1:sur); od;
\r
273 rangee(i,j):=new combinaison;
\r
281 UNIT find_place:function(quoi,l,x,h:integer;inout p:coord3D):boolean;
\r
282 const ligne=1,colonne=2,lignediag=3,coldiag=4,axe=5,dbdiag=7,bigdiag=6;
\r
296 if pl.jeu(i,i,i)=free then
\r
297 if i=posajouer(i,i) then trouve:=true;
\r
298 p.x:=i;p.y:=i;p.h:=i;
\r
304 if pl.jeu(i,i,(4-i)+1)=free then
\r
305 if posajouer(i,i)=(4-i)+1 then trouve:=true;
\r
306 p.x:=i;p.y:=i;p.h:=(4-i)+1;
\r
316 if pl.jeu(i,(4-i)+1,i)=free then
\r
317 if i=posajouer(i,(4-i)+1) then trouve:=true;
\r
318 p.x:=i;p.y:=(4-i)+1;p.h:=i;
\r
325 if pl.jeu(i,(4-i)+1,(4-i)+1)=free then
\r
326 if posajouer(i,(4-i)+1)=(4-i)+1 then trouve:=true;
\r
327 p.x:=i;p.y:=(4-i)+1;p.h:=(4-i)+1;
\r
340 if pl.jeu(i,i,h)=free then
\r
341 if h=posajouer(i,i) then trouve:=true;
\r
342 p.x:=i;p.y:=i;p.h:=h;
\r
349 if pl.jeu(i,(4-i)+1,h)=free then
\r
350 if h=posajouer(i,(4-i)+1) then trouve:=true;
\r
351 p.x:=i;p.y:=(4-i)+1;p.h:=h;
\r
357 when ligne: (* recherche d'une place dans la ligne sp
\82cifi
\82e *)
\r
359 if pl.jeu(x,i,h)=free then
\r
360 if h=posajouer(x,i) then trouve:=true; fi;
\r
367 p.h:=posajouer(x,i);
\r
370 when colonne: (* recherche d'une place dans la colonne sp
\82cifi
\82e *)
\r
372 if pl.jeu(i,x,h)=free then
\r
373 if posajouer(i,x)=h then trouve:=true;
\r
374 p.x:=i;p.y:=x;p.h:=posajouer(i,x);
\r
382 when lignediag:(* recherche d'une place dans la diagonnal ligne sp
\82cifi
\82e *)
\r
384 when 1: for i:=1 to 4 do
\r
385 if pl.jeu(x,i,i)=free then
\r
386 if posajouer(x,i)=i then trouve:=true;
\r
387 p.x:=x;p.y:=i;p.h:=i;
\r
394 when 2: for i:=1 to 4 do
\r
395 if pl.jeu(x,i,(4-i)+1)=free then
\r
396 if posajouer(x,i)=(4-i)+1 then trouve:=true;
\r
397 p.x:=x;p.y:=i;p.h:=(4-i)+1;
\r
405 when axe: (* recherche d'une place dans l'axe sp
\82cifi
\82e *)
\r
406 if posajouer(x,h)<>5 then
\r
409 p.h:=posajouer(x,h);
\r
412 when coldiag:(* recherche d'une place dans la diagonnal colonne sp
\82cifi
\82e *)
\r
414 when 1: for i:=1 to 4 do
\r
415 if pl.jeu(i,x,i)=free then
\r
416 if posajouer(i,x)=i then trouve:=true;
\r
417 p.x:=i;p.y:=x;p.h:=i;
\r
424 when 2: for i:=1 to 4 do
\r
425 if pl.jeu(i,x,(4-i)+1)=free then
\r
426 if posajouer(i,x)=(4-i)+1 then trouve:=true;
\r
427 p.x:=i;p.y:=x;p.h:=(4-i)+1;
\r
439 UNIT isintwodiag:function(x,y,h:integer;inout a,b:integer):boolean;
\r
440 var trouve:boolean;
\r
443 if (h=x) and (x=y) then trouve:=true;
\r
446 if (x=y) and (h=(4-x)+1) then trouve:=true;
\r
449 if (x=(4-y)+1) and (h=x) then trouve:=true;
\r
452 if (x=(4-y)+1) and (h=y) then trouve:=true;
\r
461 UNIT isinbigdiag:function(x,y:integer;inout quel:integer):boolean;
\r
462 const droite=1,gauche=2;
\r
468 if (x=y) then trouve:=true;
\r
471 if (x=(4-y)+1) then trouve:=true;
\r
480 UNIT isindiag:function(l,h:integer;inout dg:integer):boolean;
\r
481 var trouve:boolean;
\r
484 if h=l then trouve:=true;
\r
487 if h=(4-l)+1 then trouve:=true;
\r
495 unit troisboules:function(tab:arrayof info;inout p:coord3D):boolean;
\r
503 if tab(1).rangee(p.x,p.h).nbre_boule=3 then
\r
504 trouve:=find_place(1,0,p.x,p.h,p);
\r
506 else if tab(2).rangee(p.y,p.h).nbre_boule=3 then
\r
507 trouve:=find_place(2,0,p.y,p.h,p);
\r
510 if tab(5).rangee(p.x,p.y).nbre_boule=3 then
\r
511 trouve:=find_place(5,0,p.x,p.y,p);
\r
514 if isinbigdiag(p.x,p.y,i) then
\r
515 if tab(6).rangee(p.h,i).nbre_boule=3 then
\r
516 trouve:=find_place(6,i,p.x,p.h,p);
\r
519 if isintwodiag(p.x,p.y,p.h,i,j) then
\r
520 if tab(7).rangee(i,j).nbre_boule=3 then
\r
521 trouve:=find_place(7,0,i,j,p);
\r
525 if tab(3).rangee(p.x,i).nbre_boule=3 then
\r
526 trouve:=find_place(3,i,p.y,p.h,p);
\r
528 if tab(4).rangee(p.y,i).nbre_boule=3 then
\r
529 trouve:=find_place(4,i,p.x,p.h,p);
\r
539 UNIT addcombinaison:procedure(tab:arrayof info,x,y,h:integer);
\r
542 call tab(1).rangee(x,h).plus;
\r
543 call tab(2).rangee(y,h).plus;
\r
544 call tab(5).rangee(x,y).plus;
\r
545 if isindiag(y,h,quel) then
\r
546 call tab(3).rangee(x,quel).plus;
\r
548 if isindiag(x,h,quel) then
\r
549 call tab(4).rangee(y,quel).plus;
\r
551 if isinbigdiag(x,y,quel) then
\r
552 call tab(6).rangee(h,quel).plus;
\r
554 if isintwodiag(x,y,h,quel,version) then
\r
555 call tab(7).rangee(quel,version).plus;
\r
559 UNIT delcombinaison:procedure(tab:arrayof info,x,y,h:integer);
\r
560 var quel,version:integer;
\r
563 (* si une boule a deja ete mise *)
\r
564 call tab(1).rangee(x,h).elimine;
\r
565 call tab(2).rangee(y,h).elimine;
\r
567 if isindiag(y,h,version) then (* diagonnale ligne*)
\r
568 call tab(3).rangee(x,version).elimine; fi;
\r
569 if isindiag(x,h,version) then (* diagonnale colonne*)
\r
570 call tab(4).rangee(y,version).elimine; fi;
\r
571 call tab(5).rangee(x,y).elimine;
\r
572 if isinbigdiag(x,y,quel) then
\r
573 call tab(6).rangee(h,quel).elimine; fi;
\r
574 if isintwodiag(x,y,h,quel,version) then
\r
575 call tab(7).rangee(quel,version).elimine; fi;
\r
578 UNIT selectcoup: procedure(inout p:coord3D);
\r
580 trouve,bien:boolean;
\r
584 while (not mem.vide) and (not trouve) do
\r
587 posajouer(coup.i,coup.j):=posajouer(coup.i,coup.j)+1;
\r
592 if not troisboules(adver,p) then
\r
597 posajouer(coup.i,coup.j):=posajouer(coup.i,coup.j)-1;
\r
599 posajouer(coup.i,coup.j):=posajouer(coup.i,coup.j)-1;
\r
600 call mem.supprimer(coup);
\r
604 posajouer(coup.i,coup.j):=posajouer(coup.i,coup.j)-1;
\r
607 while not mem.vide do
\r
608 call mem.supprimer(mem.mini);
\r
613 UNIT stratego:procedure;
\r
616 poid,n,version,quel,x,i,j:integer;
\r
621 if posajouer(i,j)<5 then
\r
622 coup:=new coord3D(i,j,posajouer(i,j));
\r
628 if moi(1).rangee(coup.x,coup.h).possible then
\r
629 case moi(1).rangee(coup.x,coup.h).nbre_boule
\r
630 when 3:poid:=poid+100;
\r
632 poid:=poid+moi(1).rangee(coup.x,coup.h).nbre_boule;
\r
636 if moi(2).rangee(coup.y,coup.h).possible then
\r
637 case moi(2).rangee(coup.y,coup.h).nbre_boule
\r
638 when 3:poid:=poid+100;
\r
640 poid:=moi(2).rangee(coup.y,coup.h).nbre_boule+poid;
\r
645 if isindiag(coup.y,coup.h,quel) then
\r
646 if moi(3).rangee(coup.x,quel).possible then
\r
647 case moi(3).rangee(coup.x,quel).nbre_boule
\r
648 when 3:poid:=poid+100;
\r
650 poid:=poid+moi(3).rangee(coup.x,quel).nbre_boule;
\r
655 if isindiag(coup.x,coup.h,quel) then
\r
656 if moi(4).rangee(coup.y,quel).possible then
\r
657 case moi(4).rangee(coup.y,quel).nbre_boule
\r
658 when 3: poid:=poid+100;
\r
660 poid:=poid+moi(4).rangee(coup.y,quel).nbre_boule;
\r
666 if moi(5).rangee(coup.x,coup.y).possible then
\r
667 case moi(5).rangee(coup.x,coup.y).nbre_boule
\r
668 when 3:poid:=poid+100;
\r
670 poid:=poid+moi(5).rangee(coup.x,coup.y).nbre_boule;
\r
674 if isinbigdiag(coup.x,coup.y,quel) then
\r
675 if moi(6).rangee(coup.h,quel).possible then
\r
676 case moi(6).rangee(coup.h,quel).nbre_boule
\r
677 when 3: poid:=poid+100;
\r
679 poid:=poid+moi(6).rangee(coup.h,quel).nbre_boule;
\r
684 if isintwodiag(coup.x,coup.y,coup.h,quel,version) then
\r
685 if moi(7).rangee(quel,version).possible then
\r
686 case moi(7).rangee(quel,version).nbre_boule
\r
687 when 3:poid:=poid+100;
\r
689 poid:=poid+moi(7).rangee(quel,version).nbre_boule;
\r
695 if adver(1).rangee(coup.x,coup.h).possible and
\r
696 adver(2).rangee(coup.y,coup.h).possible then
\r
697 if adver(1).rangee(coup.x,coup.h).nbre_boule=2 and
\r
698 adver(2).rangee(coup.y,coup.h).nbre_boule=2 then
\r
702 if adver(1).rangee(coup.x,coup.h).possible and
\r
703 isindiag(coup.x,coup.h,quel) then
\r
705 if adver(4).rangee(coup.y,quel).possible then
\r
706 if adver(1).rangee(coup.x,coup.h).nbre_boule=2 and
\r
707 adver(4).rangee(coup.y,quel).nbre_boule=2 then
\r
715 if adver(c).rangee(x,coup.h).possible and
\r
716 adver(5).rangee(coup.x,coup.y).possible then
\r
717 if adver(c).rangee(x,coup.h).nbre_boule=2 and
\r
718 adver(5).rangee(coup.x,coup.y).nbre_boule=2 then
\r
722 if adver(c).rangee(x,coup.h).possible and
\r
723 isinbigdiag(coup.x,coup.y,quel) then
\r
725 if adver(6).rangee(coup.h,quel).possible then
\r
726 if adver(c).rangee(x,coup.h).nbre_boule=2 and
\r
727 adver(6).rangee(coup.h,quel).nbre_boule=2 then
\r
732 if adver(c).rangee(x,coup.h).possible and
\r
733 isintwodiag(coup.x,coup.y,coup.h,quel,version) then
\r
735 if adver(7).rangee(quel,version).possible then
\r
736 if adver(c).rangee(x,coup.h).nbre_boule=2 and
\r
737 adver(7).rangee(quel,version).nbre_boule=2 then
\r
745 if adver(1).rangee(coup.x,coup.h).possible then
\r
746 case adver(1).rangee(coup.x,coup.h).nbre_boule
\r
747 when 3:poid:=poid+80;
\r
753 if adver(2).rangee(coup.y,coup.h).possible then
\r
754 case adver(2).rangee(coup.y,coup.h).nbre_boule
\r
755 when 3:poid:=poid+80;
\r
762 if isindiag(coup.y,coup.h,quel) then
\r
763 if adver(3).rangee(coup.x,quel).possible then
\r
764 case adver(3).rangee(coup.x,quel).nbre_boule
\r
765 when 3:poid:=poid+80;
\r
772 if isindiag(coup.x,coup.h,quel) then
\r
773 if adver(4).rangee(coup.y,quel).possible then
\r
774 case adver(4).rangee(coup.y,quel).nbre_boule
\r
775 when 3:poid:=poid+80;
\r
783 if adver(5).rangee(coup.x,coup.y).possible then
\r
784 case adver(5).rangee(coup.x,coup.y).nbre_boule
\r
785 when 3:poid:=poid+80;
\r
791 if isinbigdiag(coup.x,coup.y,quel) then
\r
792 if adver(6).rangee(coup.h,quel).possible then
\r
793 case adver(6).rangee(coup.h,quel).nbre_boule
\r
794 when 3:poid:=poid+80;
\r
801 if isintwodiag(coup.x,coup.y,coup.h,quel,version) then
\r
802 if adver(7).rangee(quel,version).possible then
\r
803 case adver(7).rangee(quel,version).nbre_boule
\r
804 when 3:poid:=poid+80;
\r
811 if coinlibre and poid<20 then
\r
813 pos:=round(random*3)+1;
\r
814 coup.x:=cointab(pos).x;
\r
815 coup.y:=cointab(pos).y;
\r
818 if pl.jeu(coup.x,coup.y,coup.h)=free then
\r
819 coin:=coin-1;poid:=poid+20;
\r
820 if coin=0 then coinlibre:=false; fi;
\r
827 e.x:=poid; e.i:=coup.x;e.j:=coup.y;e.h:=coup.h;
\r
828 call mem.inserer(e);
\r
835 unit combinaison:class;
\r
839 unit incremente:function:integer;
\r
845 unit plus:procedure;
\r
850 unit nbre_boule:function:integer;
\r
855 unit elimine:procedure;
\r
867 array cointab dim(1:4);
\r
868 cointab(1):=new coord2D(1,1);
\r
869 cointab(2):=new coord2D(4,4);
\r
870 cointab(3):=new coord2D(1,4);
\r
871 cointab(4):=new coord2D(4,1);
\r
877 array adver dim (1:7);
\r
878 array moi dim (1:7);
\r
880 array posajouer dim(1:4);
\r
883 array posajouer(i) dim(1:4);
\r
886 adver(i):=new info(4,4);
\r
887 moi(i):=new info(4,4);
\r
889 adver(i):=new info(4,2);
\r
890 moi(i):=new info(4,2);
\r
894 adver(5):=new info(4,4);
\r
895 moi(5):=new info(4,4);
\r
896 adver(6):=new info(4,2);
\r
897 moi(6):=new info(4,2);
\r
898 adver(7):=new info(2,2);
\r
899 moi(7):=new info(2,2);
\r
910 place:=new coord3D(1,1,1);
\r
913 call pl.arrow.ligne(pl.line,0);
\r
914 call pl.arrow.colonne(pl.col,0);
\r
916 (*****************************************)
\r
917 (* elimination de quelques combinaisons *)
\r
918 (*****************************************)
\r
919 if pl.haut<>0 then
\r
920 call addcombinaison(adver,pl.line,pl.col,pl.haut);
\r
921 call delcombinaison(moi,pl.line,pl.col,pl.haut);
\r
922 posajouer(pl.line,pl.col):=posajouer(pl.line,pl.col)+1;
\r
925 (*********************************)
\r
926 (*** est ce que j'ai gagne ? !!!!*)
\r
927 (*********************************)
\r
929 find:=troisboules(moi,place);
\r
931 (*********************************)
\r
932 (* contre des 3 boules align
\82es *)
\r
933 (*********************************)
\r
935 ((pl.line=4 or pl.line=1) and (pl.col=1 or pl.col=4))) then
\r
937 if coin=0 then coinlibre:=false; fi;
\r
941 if (adver(1).rangee(pl.line,pl.haut).nbre_boule=3) and
\r
942 (adver(1).rangee(pl.line,pl.haut).possible) then
\r
943 find:=find_place(1,0,pl.line,pl.haut,place);
\r
946 if (adver(2).rangee(pl.col,pl.haut).nbre_boule=3) and
\r
947 (adver(2).rangee(pl.col,pl.haut).possible) then
\r
948 find:=find_place(2,0,pl.col,pl.haut,place);
\r
951 if (adver(5).rangee(pl.line,pl.col).nbre_boule=3) and
\r
952 (adver(5).rangee(pl.line,pl.col).possible) then
\r
953 find:=find_place(5,0,pl.line,pl.col,place);
\r
957 if isindiag(pl.col,pl.haut,quel) then
\r
959 if (adver(3).rangee(pl.line,quel).nbre_boule=3) and
\r
960 (adver(3).rangee(pl.line,quel).possible) then
\r
961 find:=find_place(3,quel,pl.line,pl.haut,place);
\r
964 if isindiag(pl.line,pl.haut,quel) then
\r
966 if (adver(4).rangee(pl.col,quel).nbre_boule=3) and
\r
967 (adver(4).rangee(pl.col,quel).possible) then
\r
968 find:=find_place(4,quel,pl.col,pl.haut,place);
\r
972 if isinbigdiag(pl.line,pl.col,quel) then
\r
973 if (adver(6).rangee(pl.haut,quel).nbre_boule=3) and
\r
974 (adver(6).rangee(pl.haut,quel).possible) then
\r
975 find:=find_place(6,quel,pl.line,pl.haut,place);
\r
978 if isintwodiag(pl.line,pl.col,pl.haut,quel,version) then
\r
979 if (adver(7).rangee(quel,version).nbre_boule=3) and
\r
980 (adver(7).rangee(quel,version).possible) then
\r
981 find:=find_place(7,0,quel,version,place);
\r
987 (******************************************)
\r
988 (* jouer les coins du niveau 1 en premier *)
\r
989 (******************************************)
\r
995 (*********************)
\r
996 (* quel coup jouer ? *)
\r
997 (*********************)
\r
998 call stratego; (* evaluation de toutes les combinaisons*)
\r
999 call selectcoup(place); (* choisi un coup a jouer *)
\r
1003 (*****************************************)
\r
1004 (* on incremente le nombre de boules... *)
\r
1005 (*****************************************)
\r
1006 call addcombinaison(moi,place.x,place.y,place.h);
\r
1007 call delcombinaison(adver,place.x,place.y,place.h);
\r
1008 posajouer(place.x,place.y):=posajouer(place.x,place.y)+1;
\r
1012 if pl.enfiler(place.x,place.y,couleur) then
\r
1013 call pl.arrow.ligne(place.x,blanc);
\r
1014 call pl.arrow.colonne(place.y,blanc);
\r
1022 UNIT humain:player COROUTINE;
\r
1031 call pl.arrow.selectaxe(i,j);
\r
1032 if pl.enfiler(i,j,couleur) then exit; fi;
\r
1039 UNIT joueurs:class;
\r
1040 var couleur:integer,
\r
1044 array nom dim(1:8);
\r
1048 UNIT controle:iiuwgraph coroutine(equipe:arrayof joueurs,pl:Plateau_Jeu);
\r
1050 aux: arrayof arrayof arrayof integer,
\r
1055 UNIT AquiLeTour:procedure;
\r
1058 if tour=3 then tour:=1; fi;
\r
1061 UNIT copie_jeu:procedure;
\r
1066 aux(pl.line,pl.col,k):=pl.jeu(pl.line,pl.col,k);
\r
1070 UNIT coup:function:boolean;
\r
1071 var i,j,k,n,c:integer;
\r
1074 call pl.arrow.ligne(pl.line,0);
\r
1075 call pl.arrow.colonne(pl.col,0);
\r
1084 if (pl.jeu(i,j,k)<>aux(i,j,k)) then
\r
1087 pion:=new elem(i,j,k);
\r
1088 call difference.empiler(pion);
\r
1094 if n>1 or n=0 then result:=false;
\r
1097 pion:=difference.sommet;
\r
1098 if pl.jeu(pion.i,pion.j,pion.k)=equipe(tour).couleur then
\r
1100 pl.line:=pion.i;pl.col:=pion.j;pl.haut:=pion.k;
\r
1101 call pl.arrow.ligne(pl.line,blanc);
\r
1102 call pl.arrow.colonne(pl.col,blanc);
\r
1104 else result:=false;
\r
1110 unit alignee_ligne:function(couleur:integer):integer;
\r
1117 if pl.jeu(a,pion.j,pion.k)=couleur then n:=n+1; fi;
\r
1122 unit colhaut:function(couleur:integer):integer;
\r
1129 if pl.jeu(pion.i,pion.j,a)=couleur then n:=n+1; fi;
\r
1135 unit alignee_colonne:function(couleur:integer):integer;
\r
1141 if pl.jeu(pion.i,j,pion.k)=couleur then n:=n+1; fi;
\r
1146 unit diag_colonne:function(dir,couleur:integer):integer;
\r
1147 var k,i,n:integer;
\r
1151 if dir=-1 then k:=4;
\r
1156 if pl.jeu(i,pion.j,k)=couleur then n:=n+1; fi;
\r
1162 unit diagonnale: function(quel,couleur:integer):integer;
\r
1163 var n,j,i:integer;
\r
1171 if pl.jeu(i,j,pion.k)=couleur then n:=n+1; fi;
\r
1178 if pl.jeu(i,j,pion.k)=couleur then n:=n+1; fi;
\r
1186 unit doublediagonnale: function(quel,dir,couleur:integer):integer;
\r
1187 var n,i,j,k:integer;
\r
1192 if dir=-1 then k:=4;
\r
1200 if pl.jeu(i,j,k)=couleur then n:=n+1; fi;
\r
1201 j:=j+1;k:=k+(1*dir);
\r
1207 if pl.jeu(i,j,k)=couleur then n:=n+1; fi;
\r
1208 j:=j+1; k:=k+(1*dir);
\r
1216 unit diag_ligne:function(dir,couleur:integer):integer;
\r
1217 var k,j,n:integer;
\r
1221 if dir=-1 then k:=4;
\r
1226 if pl.jeu(pion.i,j,k)=couleur then n:=n+1; fi;
\r
1233 UNIT gagne:function:boolean;
\r
1234 const droite=-1,gauche=1;
\r
1235 var rangee:boolean;
\r
1239 pion:=difference.sommet;
\r
1241 if alignee_ligne(equipe(tour).couleur)=4 then rangee:=true; fi;
\r
1242 if alignee_colonne(equipe(tour).couleur)=4 then rangee:=true; fi;
\r
1243 if diag_colonne(droite,equipe(tour).couleur)=4 then rangee:= true;fi;
\r
1244 if diag_colonne(gauche,equipe(tour).couleur)=4 then rangee:=true; fi;
\r
1245 if diag_ligne(droite,equipe(tour).couleur)=4 then rangee:= true; fi;
\r
1246 if diag_ligne(gauche,equipe(tour).couleur)=4 then rangee:= true; fi;
\r
1248 if colhaut(equipe(tour).couleur)=4 then rangee:=true; fi;
\r
1250 if diagonnale(11,equipe(tour).couleur)=4 then rangee:=true; fi;
\r
1251 if doublediagonnale(11,droite,equipe(tour).couleur)=4 then rangee:=true;fi;
\r
1252 if doublediagonnale(11,gauche,equipe(tour).couleur)=4 then rangee:=true; fi;
\r
1253 if diagonnale(41,equipe(tour).couleur)=4 then rangee:=true; fi;
\r
1254 if doublediagonnale(41,droite,equipe(tour).couleur)=4 then rangee:=true; fi;
\r
1255 if doublediagonnale(41,gauche,equipe(tour).couleur)=4 then rangee:=true; fi;
\r
1258 call difference.depiler; (* pile est maintenant vide *)
\r
1264 UNIT restore:procedure;
\r
1266 while (not (difference.vide)) do
\r
1267 pion:=difference.sommet;
\r
1268 pl.jeu(pion.i,pion.j,pion.k):=aux(pion.i,pion.j,pion.k);
\r
1269 call pl.boulle(pion.i,pion.j,pion.k,aux(pion.i,pion.j,pion.k));
\r
1270 call difference.depiler;
\r
1274 UNIT nom_joueur: gestion_caractere procedure(nom:arrayof char,couleur:integer);
\r
1278 call color(couleur);
\r
1281 call move(430,240+i);
\r
1282 call draw(450,240+i);
\r
1284 call displaystring(nom,460,245,blanc);
\r
1289 var i,j,k:integer;
\r
1291 array aux dim(1:4);
\r
1295 array aux(i) dim(1:4);
\r
1298 array aux(i,j) dim (1:4);
\r
1317 difference:=new pile;
\r
1318 call pl.initialisation;
\r
1325 call nom_joueur(equipe(tour).nom,equipe(tour).couleur);
\r
1326 if equipe(tour).joueur is humain then
\r
1327 call move(450,300);
\r
1328 call outstring("A VOTRE TOUR !"); fi;
\r
1329 attach(equipe(tour).joueur);
\r
1331 call move(450,300);
\r
1332 call outstring(" ");
\r
1333 if coup then exit;
\r
1334 else call restore; fi;
\r
1336 if gagne then attach(main);
\r
1337 else call copie_jeu; fi;
\r
1341 UNIT pause: IIUWGRAPH procedure(t:string,x,y,couleur:integer);
\r
1345 call color(couleur);
\r
1346 call outstring(t);
\r
1349 if c<>0 then exit; fi;
\r
1355 UNIT Plateau_Jeu: IIUWGRAPH class;
\r
1357 VAR grille:arrayof arrayof coord2D,
\r
1358 line,col,haut:integer,
\r
1359 jeu: arrayof arrayof arrayof integer;
\r
1361 UNIT cadre: procedure;
\r
1364 call move(179,321);
\r
1365 call draw(392,250);
\r
1366 call draw(282,140);
\r
1367 call draw(69,211);
\r
1368 call draw(179,321);
\r
1373 UNIT ombre: procedure(cx,cy,cxx,cyy,fill_color:integer);
\r
1374 var x,y,xx,yy,i:integer;
\r
1377 call draw(cxx,cyy);
\r
1393 UNIT enlever:procedure(a,b:integer);
\r
1394 var niveau:integer,
\r
1399 while not occupe do
\r
1400 occupe:=(jeu(a,b,niveau)<>free);
\r
1401 if not occupe then
\r
1405 jeu(a,b,niveau):=free;
\r
1408 UNIT enfiler:function(a,b,couleur:integer):boolean;
\r
1409 var niveau,c:integer,
\r
1416 if niveau<>0 then
\r
1417 libre:= (jeu(a,b,niveau)=-1);
\r
1418 else libre:=false;
\r
1423 if niveau=5 then result:=false;
\r
1425 jeu(a,b,niveau):=couleur;
\r
1426 call boulle(grille(b,a).x,grille(b,a).y,niveau,couleur);
\r
1432 UNIT boulle:procedure(x,y,h,couleur:integer);
\r
1435 call color(couleur);
\r
1436 call move(x,y-(26*(h-1)));
\r
1437 call draw(x,y-(26*(h-1))-26);
\r
1438 call move(x+1,y-(26*(h-1))-1);
\r
1439 call draw(x+1,y-(26*(h-1))-26);
\r
1440 call move(x-1,y-(26*(h-1))-1);
\r
1441 call draw(x-1,y-(26*(h-1))-26);
\r
1442 call move(x+1,y-(26*(h-1))+1);
\r
1443 call draw(x+1,y-(26*(h-1))-26);
\r
1447 UNIT axe: procedure(x,y:integer);
\r
1449 call move(x+1,y-1);
\r
1450 call draw(x+1,y-108);
\r
1452 call draw(x,y-108);
\r
1453 call move(x-1,y-1);
\r
1454 call draw(x-1,y-108);
\r
1455 call move(x+1,y+1);
\r
1456 call draw(x+1,y-108);
\r
1459 UNIT plan: procedure(x,y,i:integer);
\r
1460 var xx,yy:integer;
\r
1465 grille(i,1):=new coord2D(xx,yy);
\r
1469 grille(i,2):=new coord2D(xx,yy);
\r
1472 call draw(136,278);
\r
1477 grille(i,3):=new coord2D(xx,yy);
\r
1479 call draw(110,252);
\r
1484 grille(i,4):=new coord2D(xx,yy);
\r
1491 unit rangee: procedure;
\r
1494 call plan(round(213*0.38)+178,round(-71*0.38)+320,2);
\r
1495 call plan(round(213*0.65)+178,round(-71*0.65)+320,3);
\r
1496 call plan(213+178,-71+320,4);
\r
1500 UNIT initialisation:procedure;
\r
1501 var i,j,k:integer;
\r
1517 call boulle(grille(i,j).x,grille(i,j).y,3,blanc);
\r
1518 call boulle(grille(i,j).x,grille(i,j).y,1,blanc);
\r
1519 call boulle(grille(i,j).x,grille(i,j).y,4,blanc);
\r
1520 call boulle(grille(i,j).x,grille(i,j).y,2,blanc);
\r
1528 UNIT fleche: class;
\r
1531 tab_coord:arrayof arrayof coord2D;
\r
1533 unit ligne:procedure(i,couleur:integer);
\r
1538 call color(couleur);
\r
1540 y1:=(-(tab_coord(1,i).x-20)+tab_coord(1,i).x+3*tab_coord(1,i).y)div 3;
\r
1541 call move(tab_coord(1,i).x,tab_coord(1,i).y);
\r
1542 call draw(tab_coord(1,i).x-20,y1);
\r
1544 y1:=(-(tab_coord(1,i).x-5)+tab_coord(1,i).x+3*tab_coord(1,i).y)div 3;
\r
1545 call move(tab_coord(1,i).x-5-3,y1-3);
\r
1546 call draw(tab_coord(1,i).x,tab_coord(1,i).y);
\r
1548 call move(tab_coord(1,i).x,tab_coord(1,i).y+5);
\r
1549 call draw(tab_coord(1,i).x,tab_coord(1,i).y);
\r
1552 unit colonne:procedure(i,couleur:integer);
\r
1555 call color(couleur);
\r
1556 call move(tab_coord(2,i).x,tab_coord(2,i).y);
\r
1557 call draw(tab_coord(2,i).x+15,tab_coord(2,i).y+15);
\r
1559 call move(tab_coord(2,i).x,tab_coord(2,i).y);
\r
1560 call draw(tab_coord(2,i).x+5,tab_coord(2,i).y);
\r
1562 call move(tab_coord(2,i).x,tab_coord(2,i).y);
\r
1563 call draw(tab_coord(2,i).x,tab_coord(2,i).y+5);
\r
1568 UNIT SelectAxe:procedure(inout i,j:integer);
\r
1569 const droite=-77,gauche=-75,hauts=-72,bas=-80,retour=13;
\r
1572 call drawrect(0,0,413,349,rouge);
\r
1573 call ligne(line,15);
\r
1574 call colonne(col,15);
\r
1578 if key<>0 then exit; fi;
\r
1582 when hauts : call ligne(line,0);
\r
1585 call ligne(line,15);
\r
1586 when bas : call ligne(line,0);
\r
1589 call ligne(line,15);
\r
1590 when gauche : call colonne(col,0);
\r
1593 call colonne(col,15);
\r
1594 when droite : call colonne(col,0);
\r
1597 call colonne(col,15);
\r
1598 when retour : i:=line;
\r
1603 call ligne(line,0);
\r
1604 call colonne(col,0);
\r
1605 call drawrect(0,0,413,349,blanc);
\r
1610 array tab_coord dim(1:2);
\r
1611 for line:=2 downto 1
\r
1613 array tab_coord(line) dim(1:4);
\r
1616 tab_coord(1,4):=new coord2D(53,219);
\r
1617 tab_coord(1,3):=new coord2D(92,258);
\r
1618 tab_coord(1,2):=new coord2D(116,282);
\r
1619 tab_coord(1,1):=new coord2D(160,326);
\r
1620 tab_coord(2,1):=new coord2D(190,332);
\r
1621 tab_coord(2,2):=new coord2D(271,305);
\r
1622 tab_coord(2,3):=new coord2D(328,286);
\r
1623 tab_coord(2,4):=new coord2D(398,256);
\r
1636 array grille dim(1:4);
\r
1640 array grille(i) dim(1:4);
\r
1643 array jeu dim(1:4);
\r
1647 array jeu(i) dim(1:4);
\r
1650 array jeu(i,j) dim (1:4);
\r
1655 call color(grisfonce);
\r
1656 call ombre(69,223,282,152,4);
\r
1657 call color(grisclair);
\r
1658 call ombre(69,211,282,140,0);
\r
1660 call color(blanc);
\r
1661 call plan(178,320,1);
\r
1664 call move(440,10);
\r
1665 call outstring("PUISSANCE 4 CHINOIS");
\r
1667 call drawrect(418,220,620,349,blanc);
\r
1668 call drawrect(0,0,413,349,blanc);
\r
1671 arrow:= new fleche;
\r
1673 END; (* fin Plateau_Jeu *)
\r
1675 UNIT menu: gestion_caractere function:integer;
\r
1676 var choix:integer;
\r
1679 call drawrect(418,220,620,349,blanc);
\r
1680 call drawrect(418,50,620,200,rouge);
\r
1681 call color(blanc);
\r
1682 call move(480,60);
\r
1683 call outstring(" OPTIONS ");
\r
1684 call move(420,80);
\r
1685 call outstring("[1] Un joueur");
\r
1686 call move(420,100);
\r
1687 call outstring("[2] Deux joueurs");
\r
1688 call move(420,120);
\r
1689 call outstring("[0] Quitter");
\r
1690 call move(470,180);
\r
1691 call outstring("Votre choix :");
\r
1693 choix:=ConvENT(saisie(1,1,570,180));
\r
1694 if choix>=0 and choix<=2 then exit; fi;
\r
1697 call drawrect(418,50,620,200,blanc);
\r
1698 call drawrect(418,220,620,349,rouge);
\r
1700 UNIT withwho: gestion_caractere function:integer;
\r
1701 var choix:integer;
\r
1704 call drawrect(418,220,620,349,blanc);
\r
1705 call drawrect(418,50,620,200,rouge);
\r
1706 call color(blanc);
\r
1707 call move(480,60);
\r
1708 call outstring(" OPTIONS ");
\r
1709 call move(420,80);
\r
1710 call outstring("[1] Ordinateur");
\r
1711 call move(440,90);
\r
1712 call outstring(" contre Vous");
\r
1713 call move(420,110);
\r
1714 call outstring("[2] Ordinateur");
\r
1715 call move(440,120);
\r
1716 call outstring(" contre Ordinateur");
\r
1718 call move(420,140);
\r
1719 call outstring("[0] Retour");
\r
1720 call move(470,180);
\r
1721 call outstring("Votre choix :");
\r
1723 choix:=ConvENT(saisie(1,1,570,180));
\r
1724 if choix>=0 and choix<=2 then exit; fi;
\r
1727 call drawrect(418,50,620,200,blanc);
\r
1728 call drawrect(418,220,620,349,rouge);
\r
1731 UNIT dialog1:iiuwgraph procedure;
\r
1737 call move(419,220+i);
\r
1738 call draw(619,220+i);
\r
1742 UNIT dialog2:iiuwgraph procedure;
\r
1748 call move(419,51+i);
\r
1749 call draw(619,51+i);
\r
1754 UNIT name:gestion_caractere function(i:integer):arrayof char;
\r
1758 call drawrect(418,220,620,349,rouge);
\r
1759 call color(blanc);
\r
1760 call move(420,230);
\r
1762 call outstring("Nom du joueur 1:");
\r
1763 else call outstring("Nom du joueur 2:");
\r
1765 result:=saisie(2,8,430,250);
\r
1766 call drawrect(418,220,620,349,blanc);
\r
1769 UNIT whostart:gestion_caractere function:integer;
\r
1770 var i,c,a:integer;
\r
1773 call drawrect(418,220,620,349,rouge);
\r
1774 call color(blanc);
\r
1775 call move(420,230);
\r
1776 call outstring(" Voulez-vous que");
\r
1777 call move(420,240);
\r
1778 call outstring("je commence la partie ?");
\r
1780 call move(440,260);
\r
1781 call color(grisfonce);
\r
1782 call outstring("NON");
\r
1783 call move(540,260);
\r
1784 call color(grisclair);
\r
1785 call outstring("OUI");
\r
1791 if i>2 then i:=1; fi;
\r
1794 when 1:call move(440,260);
\r
1795 call color(grisfonce);
\r
1796 call outstring("NON");
\r
1797 call move(540,260);
\r
1798 call color(grisclair);
\r
1799 call outstring("OUI");
\r
1800 when 2:call move(440,260);
\r
1801 call color(grisclair);
\r
1802 call outstring("NON");
\r
1803 call move(540,260);
\r
1804 call color(grisfonce);
\r
1805 call outstring("OUI");
\r
1813 unit thegame: gestion_caractere procedure;
\r
1817 call displaystring(team(1).nom,430,90,bleuroi);
\r
1818 call move(490,120);
\r
1819 call color(blanc);
\r
1820 call outstring("contre");
\r
1821 call displaystring(team(2).nom,530,150,bleuroi);
\r
1825 UNIT quelcouleur:gestion_caractere function(t:arrayof char):integer;
\r
1826 const droite=-77,gauche=-75;
\r
1827 var i,c,a:integer;
\r
1830 call drawrect(418,220,620,349,rouge);
\r
1831 call displaystring(t,420,230,blanc);
\r
1833 call move(440,250);
\r
1834 call outstring("Boule:");
\r
1841 call move(500,250);
\r
1843 call outstring("<Couleur>");
\r
1844 call displaystring(unpack("->:couleur suivante"),420,310,grisfonce);
\r
1845 call displaystring(unpack("<-:couleur pr
\82c
\82dente"),420,320,grisfonce);
\r
1851 if i>14 then i:=1; fi;
\r
1854 if i>14 then i:=1; fi;
\r
1857 if i<1 then i:=14; fi;
\r
1858 if i=boule then i:=i-1;fi;
\r
1859 if i<1 then i:=14; fi;
\r
1865 call move(500,250);
\r
1867 call outstring("<Couleur>");
\r
1872 call drawrect(418,220,620,349,blanc);
\r
1875 signal quitter,gagner;
\r
1876 VAR plateau:plateau_jeu,
\r
1877 team: arrayof joueurs,
\r
1878 c,i,j,boule:integer,
\r
1884 pref iiuwgraph block
\r
1887 kill(team(1).joueur);
\r
1888 kill(team(2).joueur);
\r
1895 pref iiuwgraph block
\r
1897 kill(team(1).joueur);
\r
1898 kill(team(2).joueur);
\r
1901 call move(450,270);
\r
1902 call outstring(" ");
\r
1904 call color(rouge);
\r
1905 call move(500,270);
\r
1906 call outstring(" A GAGNE !");
\r
1915 plateau:=new plateau_jeu;
\r
1916 array team dim(1:2);
\r
1918 team(1):=new joueurs;
\r
1919 team(2):=new joueurs;
\r
1920 pref gestion_caractere block
\r
1927 when 2:team(1).nom:=name(1);
\r
1928 team(1).couleur:=quelcouleur(team(1).nom);
\r
1929 boule:=team(1).couleur;
\r
1930 team(1).joueur:=new humain(team(1).couleur,plateau);
\r
1931 team(2).nom:=name(2);
\r
1932 team(2).couleur:=quelcouleur(team(2).nom);
\r
1933 team(2).joueur:=new humain(team(2).couleur,plateau);
\r
1940 when 2:team(1).nom:=name(1);
\r
1941 team(1).couleur:=quelcouleur(team(1).nom);
\r
1942 boule:=team(1).couleur;
\r
1943 team(1).joueur:=new humain(team(1).couleur,plateau);
\r
1944 team(2).nom:=unpack("COMPUTER");
\r
1945 team(2).couleur:=quelcouleur(team(2).nom);
\r
1946 team(2).joueur:=new ordi(team(2).couleur,plateau);
\r
1949 when 1:team(2).nom:=name(2);
\r
1950 team(2).couleur:=quelcouleur(team(2).nom);
\r
1951 boule:=team(2).couleur;
\r
1952 team(2).joueur:=new humain(team(2).couleur,plateau);
\r
1953 team(1).nom:=unpack("COMPUTER");
\r
1954 team(1).couleur:=quelcouleur(team(1).nom);
\r
1955 team(1).joueur:=new ordi(team(1).couleur,plateau);
\r
1959 when 2:team(1).nom:=unpack("Computer1");
\r
1960 team(1).couleur:=quelcouleur(team(1).nom);
\r
1961 boule:=team(1).couleur;
\r
1962 team(1).joueur:=new ordi(team(1).couleur,plateau);
\r
1963 team(2).nom:=unpack("Computer2");
\r
1964 team(2).couleur:=quelcouleur(team(2).nom);
\r
1965 team(2).joueur:=new ordi(team(2).couleur,plateau);
\r
1968 when 0: raise quitter;
\r
1974 arbitre:=new controle(team,plateau);
\r