2 (*----------------------------------------------------------------------*)
\r
3 (* Auteurs:BERNARD Didier licence informatique *)
\r
4 (* DUCAMP Denis ann
\82e 1992-1993 *)
\r
7 (*----------------------------------------------------------------------*)
\r
8 const vide=0,pion=1,dame=2,bloc=4,noir=-1,blanc=1,damenoire=-2,dameblanche=2;
\r
10 horiz,vert,debhoriz,debvert,horiz1,vert1,horiz2,
\r
11 coulblanc,coulnoir,coulrouge:integer,
\r
12 damier:arrayof integer,
\r
13 liste,h_g,h_d,b_g,b_d:arrayof arrayof integer,
\r
17 clc:calcul_liste_coup,
\r
20 unit init_deplact:procedure;
\r
21 (* Cette proc
\82dure calcule pour chaque case le num
\82ro de la case au *)
\r
22 (* dessus
\85 gauche, au dessus
\85 droite, en bas
\85 gauche et en bas
\85 droite *)
\r
26 array h_g dim(noir:blanc);
\r
27 array h_g(noir) dim(1:50); array h_g(blanc) dim(1:50);
\r
28 array h_d dim(noir:blanc);
\r
29 array h_d(noir) dim(1:50); array h_d(blanc) dim(1:50);
\r
30 array b_g dim(noir:blanc);
\r
31 array b_g(noir) dim(1:50); array b_g(blanc) dim(1:50);
\r
32 array b_d dim(noir:blanc);
\r
33 array b_d(noir) dim(1:50); array b_d(blanc) dim(1:50);
\r
35 j:=i mod 10; k:=(i-1)mod 10;
\r
36 if i<=5 or j=6 then h_g(blanc,i):=0;
\r
37 else if k<5 then h_g(blanc,i):=i-5;
\r
38 else h_g(blanc,i):=i-6; fi; fi;
\r
39 if i<=5 or j=5 then h_d(blanc,i):=0;
\r
40 else if k<5 then h_d(blanc,i):=i-4;
\r
41 else h_d(blanc,i):=i-5; fi; fi;
\r
42 if i>=46 or j=6 then b_g(blanc,i):=0;
\r
43 else if k<5 then b_g(blanc,i):=i+5;
\r
44 else b_g(blanc,i):=i+4; fi; fi;
\r
45 if i>=46 or j=5 then b_d(blanc,i):=0;
\r
46 else if k<5 then b_d(blanc,i):=i+6;
\r
47 else b_d(blanc,i):=i+5; fi; fi;
\r
48 h_d(noir,i):=b_g(blanc,i); h_g(noir,i):=b_d(blanc,i);
\r
49 b_d(noir,i):=h_g(blanc,i); b_g(noir,i):=h_d(blanc,i);
\r
53 unit calcul_liste_coup:coroutine;
\r
54 (* Cette coroutine calcule la liste des coups du joueur qui
\85 la main *)
\r
56 var i,nc,joueur,nbmax,nb_coup:integer,
\r
57 coup,damier:arrayof integer,
\r
58 liste_coup:arrayof arrayof integer,
\r
62 unit enreg_coup:coroutine;
\r
63 (* Cette coroutine enregistre un coup dans la liste des coups *)
\r
71 array liste_coup(nb_coup) dim(1:nb);
\r
72 for i:=1 to nb do liste_coup(nb_coup,i):=coup(i); od;
\r
73 else if nb>nbmax then
\r
74 (* La longueur du nouveau coup est sup
\82rieure
\85 celle des autres *)
\r
75 (* donc on peut supprimer les anciens qui ne peuvent plus etre jou
\82s *)
\r
76 for i:=1 to nb_coup do kill(liste_coup(i)); od;
\r
77 array liste_coup(1) dim(1:nb);
\r
80 for i:=1 to nb do liste_coup(1,i):=coup(i); od;
\r
86 unit recurse_pion:procedure
\r
87 (damier:arrayof integer,num,sautee,caz:integer,prof:boolean);
\r
88 (* Cette proc
\82dure recherche tous les coups possibles pour un pion donn
\82 *)
\r
89 (* Elle s'appelle r
\82cursivement si le pion peut en sauter au moins une fois *)
\r
93 damier2:arrayof integer;
\r
101 nc:=h_g(joueur,caz);
\r
103 if damier(nc)*joueur<0 then
\r
104 nc2:=h_g(joueur,nc);
\r
106 if damier(nc2)=vide then
\r
108 damier2:=copy(damier);
\r
109 damier2(nc2):=damier(caz);
\r
110 damier2(nc),damier2(caz):=vide;
\r
111 call recurse_pion(damier2,num+1,nc,nc2,true);
\r
113 nc:=h_d(joueur,caz);
\r
115 if damier(nc)*joueur<0 then
\r
116 nc2:=h_d(joueur,nc);
\r
118 if damier(nc2)=vide then
\r
120 if damier2<>none then kill(damier2); fi;
\r
121 damier2:=copy(damier);
\r
122 damier2(nc2):=damier(caz);
\r
123 damier2(nc),damier2(caz):=vide;
\r
124 call recurse_pion(damier2,num+1,nc,nc2,true);
\r
126 nc:=b_g(joueur,caz);
\r
128 if damier(nc)*joueur<0 then
\r
129 nc2:=b_g(joueur,nc);
\r
131 if damier(nc2)=vide then
\r
133 if damier2<>none then kill(damier2); fi;
\r
134 damier2:=copy(damier);
\r
135 damier2(nc2):=damier(caz);
\r
136 damier2(nc),damier2(caz):=vide;
\r
137 call recurse_pion(damier2,num+1,nc,nc2,true);
\r
139 nc:=b_d(joueur,caz);
\r
141 if damier(nc)*joueur<0 then
\r
142 nc2:=b_d(joueur,nc);
\r
144 if damier(nc2)=vide then
\r
146 if damier2<>none then kill(damier2); fi;
\r
147 damier2:=copy(damier);
\r
148 damier2(nc2):=damier(caz);
\r
149 damier2(nc),damier2(caz):=vide;
\r
150 call recurse_pion(damier2,num+1,nc,nc2,true);
\r
152 if rec then kill(damier2)
\r
160 unit recurse_dame:procedure
\r
161 (damier:arrayof integer,num,sautee,caz:integer,prof:boolean);
\r
162 (* Cette proc
\82dure recherche tous les coups possible pour une dame *)
\r
163 (* Elle s'appelle r
\82cursivement si la dame peut sauter au moins une fois *)
\r
167 damier2:arrayof integer;
\r
177 nc:=h_g(joueur,nc);
\r
178 if nc=0 orif damier(nc)=/=vide then exit; fi;
\r
181 if damier(nc)*joueur<0 then
\r
182 nc2:=h_g(joueur,nc);
\r
184 if damier(nc2)=/=vide then exit; fi;
\r
186 damier2:=copy(damier);
\r
187 damier2(nc2):=damier(caz);
\r
188 damier2(nc):=bloc*joueur;
\r
189 damier2(caz):=vide;
\r
190 call recurse_dame(damier2,num+1,nc,nc2,true);
\r
191 nc2:=h_g(joueur,nc2);
\r
196 nc:=h_d(joueur,nc);
\r
197 if nc=0 orif damier(nc)=/=vide then exit; fi;
\r
200 if damier(nc)*joueur<0 then
\r
201 nc2:=h_d(joueur,nc);
\r
203 if damier(nc2)=/=vide then exit; fi;
\r
205 if damier2=/=none then kill(damier2); fi;
\r
206 damier2:=copy(damier);
\r
207 damier2(nc2):=damier(caz);
\r
208 damier2(nc):=bloc*joueur;
\r
209 damier2(caz):=vide;
\r
210 call recurse_dame(damier2,num+1,nc,nc2,true);
\r
211 nc2:=h_d(joueur,nc2);
\r
216 nc:=b_g(joueur,nc);
\r
217 if nc=0 orif damier(nc)=/=vide then exit; fi;
\r
220 if damier(nc)*joueur<0 then
\r
221 nc2:=b_g(joueur,nc);
\r
223 if damier(nc2)=/=vide then exit; fi;
\r
225 if damier2=/=none then kill(damier2); fi;
\r
226 damier2:=copy(damier);
\r
227 damier2(nc2):=damier(caz);
\r
228 damier2(nc):=bloc*joueur;
\r
229 damier2(caz):=vide;
\r
230 call recurse_dame(damier2,num+1,nc,nc2,true);
\r
231 nc2:=b_g(joueur,nc2);
\r
236 nc:=b_d(joueur,nc);
\r
237 if nc=0 orif damier(nc)=/=vide then exit; fi;
\r
240 if damier(nc)*joueur<0 then
\r
241 nc2:=b_d(joueur,nc);
\r
243 if damier(nc2)=/=vide then exit; fi;
\r
245 if damier2=/=none then kill(damier2); fi;
\r
246 damier2:=copy(damier);
\r
247 damier2(nc2):=damier(caz);
\r
248 damier2(nc):=bloc*joueur;
\r
249 damier2(caz):=vide;
\r
250 call recurse_dame(damier2,num+1,nc,nc2,true);
\r
251 nc2:=b_d(joueur,nc2);
\r
254 if rec then kill(damier2)
\r
262 begin (* calcul_liste_coup *)
\r
263 ec:=new enreg_coup;
\r
264 array coup dim(1:21);
\r
270 if liste_coup<>none then
\r
271 for i:=1 to upper(liste_coup) do
\r
272 if liste_coup(i)<>none then kill(liste_coup(i)); fi;
\r
275 if damier(i)*joueur>0 then
\r
276 if abs(damier(i))=pion then
\r
277 call recurse_pion(damier,1,0,i,false);
\r
281 if damier(nc)=vide then
\r
289 if damier(nc)=vide then
\r
295 else call recurse_dame(damier,1,0,i,false);
\r
299 if damier(nc)=/=vide then exit; fi;
\r
304 nc:=h_g(joueur,nc);
\r
308 if damier(nc)=/=vide then exit; fi;
\r
313 nc:=h_d(joueur,nc);
\r
317 if damier(nc)=/=vide then exit; fi;
\r
322 nc:=b_g(joueur,nc);
\r
326 if damier(nc)=/=vide then exit; fi;
\r
331 nc:=b_d(joueur,nc);
\r
338 end calcul_liste_coup;
\r
340 unit valide:coroutine;
\r
341 (* Renvoie TRUE si une ligne de Liste_Coup est
\82gal
\85 Coup, FALSE sinon *)
\r
344 i,j,long1,long2,n_coup:integer,
\r
345 coup:arrayof integer,
\r
346 liste_coup:arrayof arrayof integer;
\r
350 long1:=upper(coup);
\r
351 long2:=upper(liste_coup(1));
\r
352 if (long1=long2) then
\r
353 for i:=1 to n_coup do
\r
355 for j:=1 to long1 do
\r
356 if liste_coup(i,j)<>coup(j) then
\r
361 if egaux then exit; fi;
\r
369 unit init_damier:procedure(inout damier:arrayof integer);
\r
370 (* Initialise le damier en m
\82moire *)
\r
371 (* en positionnant les pions comme en d
\82but de partie *)
\r
375 if damier=none then array damier dim(1:50); fi;
\r
376 for i:=1 to 20 do damier(i):=noir; od;
\r
377 for i:=21 to 30 do damier(i):=vide; od;
\r
378 for i:=31 to 50 do damier(i):=blanc; od;
\r
381 unit aff_pions:coroutine;
\r
382 (* Coroutine qui affiche
\85 l'
\82cran tous les pions du *)
\r
383 (* damier en fonction du tableau damier en m
\82moire *)
\r
390 if damier(i)=blanc then call aff_blanc(i)
\r
391 else if damier(i)=noir then call aff_noir(i)
\r
392 else if damier(i)=dameblanche then call aff_dameblanche(i)
\r
393 else if damier(i)=damenoire then call aff_damenoire(i)
\r
394 else call del_case(i);
\r
401 unit calc_coord:coroutine;
\r
402 (* Calcule les coordonn
\82es du coin haut gauche de la case caz *)
\r
404 var caz,h,v:integer;
\r
409 if((caz div 5)mod 2=0)then h:=debhoriz+horiz+(caz mod 5)*horiz2;
\r
410 else h:=debhoriz+(caz mod 5)*horiz2; fi;
\r
411 v:=debvert+vert*(caz div 5);
\r
416 unit aff_dameblanche:procedure(caz:integer);
\r
417 (* Affiche une dame blanche sur la case caz *)
\r
421 cc.caz:=caz; attach(cc); h:=cc.h; v:=cc.v; clr.h:=h; clr.v:=v;
\r
422 clr.long:=horiz1; clr.haut:=vert1; clr.col:=coulnoir; attach(clr);
\r
423 clr.h:=h+9; clr.v:=v+4; clr.long:=15; clr.haut:=12;
\r
424 clr.col:=coulblanc; attach(clr);
\r
425 clr.h:=h+5; clr.v:=v+8; attach(clr);
\r
426 end aff_dameblanche;
\r
428 unit aff_damenoire:IIUWGraph procedure(caz:integer);
\r
429 (* Affiche une dame noire sur la case caz *)
\r
433 cc.caz:=caz; attach(cc); h:=cc.h; v:=cc.v;
\r
434 clr.h:=h; clr.v:=v; clr.long:=horiz1; clr.haut:=vert1;
\r
435 clr.col:=coulnoir; attach(clr);
\r
436 call color(coulblanc); call move(h+9,v+8);
\r
437 call draw(h+9,v+4); call draw(h+24,v+4);
\r
438 call draw(h+24,v+16); call draw(h+20,v+16);
\r
439 call move(h+5,v+8);
\r
440 call draw(h+20,v+8); call draw(h+20,v+20);
\r
441 call draw(h+5,v+20); call draw(h+5,v+8);
\r
444 unit aff_blanc:procedure(caz:integer);
\r
445 (* affiche un pion blanc sur la case caz *)
\r
449 cc.caz:=caz; attach(cc); h:=cc.h; v:=cc.v;
\r
450 clr.h:=h; clr.v:=v; clr.long:=horiz1; clr.haut:=vert1;
\r
451 clr.col:=coulnoir; attach(clr);
\r
452 clr.h:=h+7; clr.v:=v+6; clr.long:=14; clr.haut:=12;
\r
453 clr.col:=coulblanc; attach(clr);
\r
456 unit aff_noir:IIUWGraph procedure(caz:integer);
\r
457 (* Affiche un pion noir sur la case caz *)
\r
461 cc.caz:=caz; attach(cc); h:=cc.h; v:=cc.v;
\r
462 clr.h:=h; clr.v:=v; clr.long:=horiz1; clr.haut:=vert1;
\r
463 clr.col:=coulnoir; attach(clr);
\r
464 call color(coulblanc); call move(h+7,v+6); call draw(h+21,v+6);
\r
465 call draw(h+21,v+18); call draw(h+7,v+18); call draw(h+7,v+6);
\r
468 unit aff_damier:IIUWGraph procedure;
\r
469 (* Affiche un damier vide
\85 l'
\82cran *)
\r
471 var i,j,bord,h,v:integer;
\r
473 clr.h:=debhoriz-1; clr.v:=debvert-1;
\r
474 clr.long:=10*horiz+1; clr.haut:=10*vert+1;
\r
475 clr.col:=coulblanc; attach(clr);
\r
476 bord:=horiz; clr.v:=debvert;
\r
477 clr.long:=horiz1; clr.haut:=vert1; clr.col:=coulnoir;
\r
479 clr.h:=debhoriz+bord;
\r
489 unit del_case:procedure(caz:integer);
\r
490 (* Efface tout ce qui pourrait se trouver sur la case caz *)
\r
494 cc.caz:=caz; attach(cc); h:=cc.h; v:=cc.v;
\r
495 clr.h:=h; clr.v:=v; clr.long:=horiz1; clr.haut:=vert1;
\r
496 clr.col:=coulnoir; attach(clr);
\r
499 unit clear:IIUWGraph coroutine;
\r
500 (* Dessine un rectangle de coin haut gauche h,v et bas droit h+long,v+haut *)
\r
502 var h,v,long,haut,col,i:integer;
\r
507 for i:=0 to haut do
\r
509 call draw(h+long,v+i);
\r
515 unit aff_tab_car:IIUWGraph procedure(h,v:integer,tab:arrayof char);
\r
516 (* Affiche une cha
\8cne de caract
\8ares
\85 l'
\82cran *)
\r
520 clr.h:=h; clr.v:=v; clr.long:=(upper(tab)-lower(tab)+1)*8-1;
\r
521 clr.haut:=7; clr.col:=coulnoir; attach(clr);
\r
522 call color(coulblanc); call move(h,v);
\r
523 for i:=lower(tab) to upper(tab) do
\r
524 call hascii(ord(tab(i)));
\r
528 unit aff_nb:procedure(h,v,n,l:integer);
\r
529 (* Transforme un nombre en tableau de chiffres puis appelle la *)
\r
530 (* proc
\82dure Aff_Tab_Car pour l'afficher sur un
\82cran graphique *)
\r
532 var tab,bat:arrayof char,
\r
536 array tab dim(1:l);
\r
538 for i:=2 to l do tab(i):=' '; od;
\r
539 call aff_tab_car(h,v,tab);
\r
541 array tab dim(1:6);
\r
549 tab(i):=chr((n mod 10)+48);
\r
552 array bat dim(1:l);
\r
561 for i:=j to l do bat(i):=' '; od;
\r
562 call aff_tab_car(h,v,bat);
\r
568 unit attend_bouton:mouse procedure(output h,v:integer);
\r
569 (* Cette proc
\82dure renvoie les coordonn
\82es du pixel point
\82 par la *)
\r
570 (* souris lorsque le bouton gauche a
\82t
\82 cliqu
\82 pour la derni
\8are fois *)
\r
576 call getpress(0,h1,v1,p,l,r,c);
\r
577 if not l and not r and not c then exit fi;
\r
580 call getpress(0,h,v,p,l,r,c);
\r
581 if l or r then exit fi;
\r
584 pref IIUWGraph block begin
\r
586 writeln("Abandon d'un joueur");
\r
592 unit sur_damier:function(h,v:integer):boolean;
\r
593 (* Retourne TRUE si le pixel de coordonn
\82es *)
\r
594 (* (h,v) est sur une case num
\82rot
\82e du damier *)
\r
597 if h>=debhoriz and v>=debvert and h<debhoriz+10*horiz and v<debvert+10*vert
\r
599 else result:=false;
\r
603 unit num_caz:function(h,v:integer):integer;
\r
604 (* Calcule le num
\82ro de la case
\85 laquelle *)
\r
605 (* appartient le pixel de coordonn
\82e (h,v) *)
\r
607 var ligne,colon:integer;
\r
609 ligne:=(v-debvert)div vert;
\r
610 colon:=(h-debhoriz)div horiz;
\r
611 if(ligne mod 2)+(colon mod 2)=1
\r
612 then result:=1+(5*ligne)+(colon div 2)
\r
618 unit quelle_caz:IIUWGraph function:integer;
\r
619 (* Renvoie le num
\82ro de la case o
\97 on vient de cliquer *)
\r
621 var h,v,n_c:integer;
\r
624 call attend_bouton(h,v);
\r
625 if sur_damier(h,v) then n_c:=num_caz(h,v); fi;
\r
626 if(h=0 or v=0)then quit:=true; fi;
\r
627 if n_c<>0 or quit then exit fi;
\r
632 unit maj_aff:procedure(damier,coup:arrayof integer);
\r
633 (* Met
\85 jour l'affichage du damier en actualisant *)
\r
634 (*
\85 l'
\82cran les cases point
\82es par le tableau Coup *)
\r
638 for i:=1 to upper(coup) do
\r
641 when blanc: call aff_blanc(n);
\r
642 when noir: call aff_noir(n);
\r
643 when dameblanche: call aff_dameblanche(n);
\r
644 when damenoire: call aff_damenoire(n);
\r
645 otherwise call del_case(n);
\r
650 unit maj_damier:procedure(damier,coup:arrayof integer,joueur:integer);
\r
651 (* Met
\85 jour le damier en m
\82moire en jouant le coup *)
\r
653 var deb,fin,i,n:integer;
\r
658 for i:=2 step 2 to n-1 do damier(coup(i)):=0; od;
\r
659 if joueur=blanc then
\r
661 then damier(fin):=dameblanche
\r
662 else damier(fin):=damier(deb); fi;
\r
664 then damier(fin):=damenoire
\r
665 else damier(fin):=damier(deb); fi;
\r
667 if fin<>deb then damier(deb):=vide; fi;
\r
670 unit aff_croix:IIUWGraph procedure(caz:integer);
\r
671 (* Affiche une croix sur la case caz du damier *)
\r
675 cc.caz:=caz; attach(cc); h:=cc.h; v:=cc.v;
\r
676 call color(coulrouge); call move(h,v);
\r
677 call draw(h+horiz1,v+vert1);
\r
678 call move(h,v+vert1);
\r
679 call draw(h+horiz1,v);
\r
680 call color(coulblanc);
\r
683 unit arbitre:IIUWGraph coroutine;
\r
684 (* Cette coroutine initialise la partie (damier et coroutines), *)
\r
685 (* g
\8are la partie en donnant alternativement la main aux deux joueurs, *)
\r
686 (* v
\82rifie la validit
\82 des coups jou
\82s et g
\8are leur affichage *)
\r
688 var joueur,nmax,ncoup,coul,rep,rep1,i:integer,
\r
689 coup:arrayof integer,
\r
690 liste:arrayof arrayof integer,
\r
691 joueur1,joueur2:participant,
\r
694 call init_damier(damier);
\r
695 array liste dim(1:50);
\r
697 clc:=new calcul_liste_coup;
\r
698 cc:=new calc_coord;
\r
702 for i:=1 to 25 do writeln; od;
\r
703 writeln(" JEU DE DAMES");
\r
705 writeln("Voici les options de ce jeu:");
\r
707 writeln("1 - Jouer contre l'ordinateur");
\r
708 writeln("2 - Deux joueurs");
\r
709 writeln("3 - Deux ordinateurs");
\r
712 write("Quel est votre choix ? ");read(rep);writeln;
\r
713 if(rep>=1 and rep<=3) then exit; fi;
\r
718 write("Sous quelle couleur voulez-vous jouer (noir=-1/blanc=1)? ");
\r
719 read(coul);writeln;
\r
720 if (abs(coul)=1) then exit; fi;
\r
723 write("A quel niveau l'ordinateur doit-il jouer (1,2,etc)? ");
\r
725 if rep>0 then exit; fi;
\r
728 joueur1:=new player(damier,coul);
\r
729 joueur2:=new computer(damier,-coul,rep);
\r
732 joueur1:=new computer(damier,-coul,rep);
\r
733 joueur2:=new player(damier,coul);
\r
736 joueur1:=new player(damier,blanc);
\r
737 joueur2:=new player(damier,noir);
\r
740 write("A quel niveau l'ordinateur BLANC doit-il jouer (1,2,etc)? ");
\r
742 if rep>0 then exit; fi;
\r
744 joueur1:=new computer(damier,blanc,rep);
\r
746 write("A quel niveau l'ordinateur NOIR doit-il jouer (1,2,etc)? ");
\r
747 read(rep1);writeln;
\r
748 if rep1>0 then exit; fi;
\r
750 joueur2:=new computer(damier,noir,rep);
\r
756 call aff_tab_car((debhoriz-40)div 2,debvert,unpack("Blanc"));
\r
757 call aff_tab_car(debhoriz+10*horiz+(debhoriz-32)div 2,debvert,
\r
759 call aff_tab_car(240,(debvert-8)div 2,unpack("Joueur actif:"));
\r
760 if joueur1 is computer then
\r
761 call aff_tab_car((debhoriz-144)div 2,debvert+vert,
\r
762 unpack("Machine niveau:"));
\r
763 call aff_nb((debhoriz-144)div 2+128,debvert+vert,rep,1);
\r
765 call aff_tab_car((debhoriz-48)div 2,debvert+vert,unpack("Humain"));
\r
767 if joueur2 is computer then
\r
768 call aff_tab_car(debhoriz+10*horiz+(debhoriz-144)div 2,debvert+vert,
\r
769 unpack("Machine niveau:"));
\r
770 call aff_nb(debhoriz+10*horiz+(debhoriz-144)div 2+128,debvert+vert,rep1,1);
\r
772 call aff_tab_car(debhoriz+10*horiz+(debhoriz-48)div 2,debvert+vert,
\r
776 call aff_tab_car((debhoriz-144)div 2,debvert+2*vert,
\r
777 unpack("Dernier coup jou
\82:"));
\r
778 call aff_tab_car(debhoriz+10*horiz+(debhoriz-144)div 2,debvert+2*vert,
\r
779 unpack("Dernier coup jou
\82:"));
\r
781 pref mouse block begin
\r
785 clc.joueur:=joueur; clc.damier:=damier; clc.liste_coup:=liste;
\r
786 attach(clc); nmax:=clc.nbmax; ncoup:=clc.nb_coup;
\r
790 then writeln("Les BLANCS ont PERDU...")
\r
791 else writeln("Les NOIRS ont PERDU...");
\r
795 for i:=1 to ncoup do
\r
798 pref mouse block begin
\r
800 if(joueur=blanc) then
\r
801 call aff_tab_car(360,(debvert-8)div 2,unpack("blanc"));
\r
804 coup:=joueur1.coupjou;
\r
806 call aff_tab_car(360,(debvert-8)div 2,unpack("noir "));
\r
809 coup:=joueur2.coupjou;
\r
813 clc.joueur:=joueur; clc.damier:=damier; clc.liste_coup:=liste;
\r
814 attach(clc); nmax:=clc.nbmax; ncoup:=clc.nb_coup;
\r
815 val.liste_coup:=liste; val.coup:=coup; val.n_coup:=ncoup;
\r
816 attach(val); if val.egaux then exit; fi;
\r
817 if (joueur=blanc) then
\r
819 coup:=joueur1.coupjou;
\r
822 coup:=joueur2.coupjou;
\r
825 pref mouse block begin
\r
827 call maj_damier(damier,coup,joueur);
\r
828 call maj_aff(damier,coup);
\r
829 if (joueur=blanc) then
\r
830 call aff_nb((debhoriz-40)div 2,debvert+3*vert,coup(1),2);
\r
831 call aff_nb((debhoriz-40)div 2+24,debvert+3*vert,
\r
832 coup(upper(coup)),2);
\r
834 call aff_nb(debhoriz+10*horiz+(debhoriz-40)div 2,
\r
835 debvert+3*vert,coup(1),2);
\r
836 call aff_nb(debhoriz+10*horiz+(debhoriz-40)div 2+24,
\r
837 debvert+3*vert,coup(upper(coup)),2);
\r
845 unit participant:mouse coroutine(damier:arrayof integer,moi:integer);
\r
846 (* Cette coroutine pr
\82fixe les coroutines computer et player *)
\r
848 var coupjou:arrayof integer;
\r
852 unit computer:participant coroutine(prof:integer);
\r
853 (* Calcule le coup que l'ordianteur va jouer *)
\r
855 var alf,i,k,maxi,ncoup,nmax,num,valeur:integer,
\r
856 damierec:arrayof integer,
\r
857 listejou:arrayof arrayof integer,
\r
860 unit recurrence:coroutine(jeu:arrayof integer);
\r
861 (* Cette coroutine pr
\82fixe les coroutines note, alpha et beta *)
\r
863 var alf,bet,resultat:integer;
\r
867 unit note:recurrence coroutine(moi:integer);
\r
868 (* Attribut une note
\85 la position du damier: *)
\r
869 (* positive si elle est favorable
\85 l'ordinateur, n
\82gative sinon *)
\r
872 val,val2,val3,val4:arrayof integer;
\r
874 array val dim(1:50); array val2 dim(1:50);
\r
875 array val3 dim(1:50); array val4 dim(1:50);
\r
877 val(2),val(8),val(13),val(9),val(4):=17;
\r
878 val(1),val(7),val(12),val(18),val(23),val(19),val(14),val(10),val(5):=16;
\r
879 val(6),val(11),val(17),val(22),val(28):=15;
\r
880 val(33),val(29),val(24),val(20),val(15):=15;
\r
881 val(16),val(21),val(27),val(32),val(38):=14;
\r
882 val(43),val(39),val(34),val(30),val(25):=14;
\r
883 val(26),val(31),val(37),val(42),val(48):=13;
\r
884 val(49),val(44),val(40),val(35):=13;
\r
885 val(36),val(41),val(47),val(50),val(45):=12;
\r
890 k:=val(c); val(c):=val(i); val(i):=k; i:=i-1;
\r
894 val2(c):=val(i); i:=i-1;
\r
895 val3(c):=30+val(c);
\r
896 val4(c):=30+val2(c);
\r
904 when blanc: resultat:=resultat+val(i);
\r
905 when noir: resultat:=resultat-val2(i);
\r
906 when dameblanche: resultat:=resultat+val3(i);
\r
907 when damenoire: resultat:=resultat-val4(i);
\r
914 unit alpha:recurrence coroutine(qui,prof:integer);
\r
915 (* Maximise les coups de l'ordinateur *)
\r
917 var i,k,maxi,ncoup,nmax,valeur:integer,
\r
918 damier:arrayof integer,
\r
919 liste:arrayof arrayof integer,
\r
922 array damier dim(1:50);
\r
923 array liste dim(1:50);
\r
925 then rec:=new beta(damier,-qui,prof-1)
\r
926 else rec:=new note(damier,moi);
\r
930 clc.joueur:=qui; clc.damier:=jeu; clc.liste_coup:=liste;
\r
931 attach(clc); nmax:=clc.nbmax; ncoup:=clc.nb_coup;
\r
933 then resultat:=-999
\r
936 for i:=1 to ncoup do
\r
937 for k:=1 to 50 do damier(k):=jeu(k); od;
\r
938 call maj_damier(damier,liste(i),qui);
\r
942 valeur:=rec.resultat;
\r
943 if maxi<valeur then
\r
945 if alf<maxi then alf:=maxi; fi;
\r
951 for k:=i to ncoup do kill(liste(k));od;
\r
958 unit beta:recurrence coroutine(qui,prof:integer);
\r
959 (* Minimise les coups du joueur *)
\r
961 var i,k,maxi,ncoup,nmax,valeur:integer,
\r
962 damier:arrayof integer,
\r
963 liste:arrayof arrayof integer,
\r
966 array damier dim(1:50);
\r
967 array liste dim(1:50);
\r
969 then rec:=new alpha(damier,-qui,prof-1)
\r
970 else rec:=new note(damier,moi);
\r
974 clc.joueur:=qui; clc.damier:=jeu; clc.liste_coup:=liste;
\r
975 attach(clc); nmax:=clc.nbmax; ncoup:=clc.nb_coup;
\r
980 for i:=1 to ncoup do
\r
981 for k:=1 to 50 do damier(k):=jeu(k); od;
\r
982 call maj_damier(damier,liste(i),qui);
\r
986 valeur:=rec.resultat;
\r
987 if maxi>valeur then
\r
989 if bet>maxi then bet:=maxi; fi;
\r
995 for k:=i to ncoup do kill(liste(k));od;
\r
1002 begin (*computer*)
\r
1003 array listejou dim(1:50);
\r
1004 array damierec dim(1:50);
\r
1005 rec:=new beta(damierec,-moi,prof);
\r
1009 call aff_tab_car((debhoriz-80)div 2,debvert+6*vert,unpack("Note: "));
\r
1010 call aff_tab_car((debhoriz-112)div 2,debvert+4*vert,
\r
1011 unpack("Meilleur coup:"));
\r
1012 call aff_tab_car((debhoriz-120)div 2,debvert+7*vert,
\r
1013 unpack("Coup en calcul:"));
\r
1015 call aff_tab_car((debhoriz+10*horiz+(debhoriz-80)div 2),
\r
1016 debvert+6*vert,unpack("Note: "));
\r
1017 call aff_tab_car((debhoriz+10*horiz+(debhoriz-112)div 2),
\r
1018 debvert+4*vert,unpack("Meilleur coup:"));
\r
1019 call aff_tab_car((debhoriz+10*horiz+(debhoriz-120)div 2),
\r
1020 debvert+7*vert,unpack("Coup en calcul:"));
\r
1024 call aff_tab_car((debhoriz-40)div 2,debvert+5*vert,unpack("-- --"));
\r
1025 call aff_tab_car(((debhoriz-80)div 2)+48,debvert+6*vert,
\r
1028 call aff_tab_car((debhoriz+10*horiz+(debhoriz-40)div 2),
\r
1029 debvert+5*vert,unpack("-- --"));
\r
1030 call aff_tab_car((debhoriz+10*horiz+(debhoriz-80)div 2+48),
\r
1031 debvert+6*vert,unpack(" "));
\r
1034 clc.joueur:=moi; clc.damier:=damier; clc.liste_coup:=listejou;
\r
1035 attach(clc); nmax:=clc.nbmax; ncoup:=clc.nb_coup;
\r
1037 coupjou:=listejou(1);
\r
1038 listejou(1):=none;
\r
1042 for i:=1 to ncoup do
\r
1045 call aff_nb(((debhoriz-40)div 2),debvert+8*vert,
\r
1047 call aff_nb(((debhoriz-40)div 2)+24,debvert+8*vert,
\r
1048 listejou(i,upper(listejou(i))),4);
\r
1050 call aff_nb((debhoriz+10*horiz+(debhoriz-40)div 2),
\r
1051 debvert+8*vert,listejou(i,1),4);
\r
1052 call aff_nb((debhoriz+10*horiz+(debhoriz-40)div 2)+24,
\r
1053 debvert+8*vert,listejou(i,upper(listejou(i))),4);
\r
1056 for k:=1 to 50 do damierec(k):=damier(k); od;
\r
1057 call maj_damier(damierec,listejou(i),moi);
\r
1061 valeur:=rec.resultat;
\r
1062 if valeur=maxi then
\r
1064 if random<0.75 then
\r
1066 coupjou:=copy(listejou(i));
\r
1067 kill(listejou(i));
\r
1069 else if random>0.75 then
\r
1071 coupjou:=copy(listejou(i));
\r
1072 kill(listejou(i));
\r
1074 if maxi<valeur then
\r
1076 if alf<maxi then alf:=maxi; fi;
\r
1078 coupjou:=copy(listejou(i));
\r
1079 kill(listejou(i));
\r
1083 call aff_nb(((debhoriz-80)div 2)+48,debvert+6*vert,maxi,4);
\r
1084 call aff_nb(((debhoriz-40)div 2),debvert+5*vert,
\r
1085 coupjou(1) (*listejou(num,1)*) ,4);
\r
1086 call aff_nb(((debhoriz-40)div 2)+24,debvert+5*vert,
\r
1087 coupjou(nmax) (*listejou(num,upper(listejou(num)))*) ,4);
\r
1089 call aff_nb((debhoriz+10*horiz+(debhoriz-80)div 2)+48,
\r
1090 debvert+6*vert,maxi,4);
\r
1091 call aff_nb((debhoriz+10*horiz+(debhoriz-40)div 2),
\r
1092 debvert+5*vert,coupjou(1) (*listejou(num,1)*) ,4);
\r
1093 call aff_nb((debhoriz+10*horiz+(debhoriz-40)div 2)+24,
\r
1094 debvert+5*vert,coupjou(nmax) (*listejou(num,upper(listejou(num)))*) ,4);
\r
1100 call aff_tab_car((debhoriz-40)div 2,debvert+8*vert,unpack("-- --"));
\r
1102 call aff_tab_car((debhoriz+10*horiz+(debhoriz-40)div 2),
\r
1103 debvert+8*vert,unpack("-- --"));
\r
1106 (*coupjou:=listejou(num);*)
\r
1113 unit player:participant coroutine;
\r
1114 (* Enregistre le coup jou
\82 par l'utilisateur *)
\r
1116 var ok,q,ret,saute:boolean,
\r
1117 cas,deb,fin,i,j,k,ncoup,nmax,prof:integer,
\r
1118 coupe,damierjou:arrayof integer,
\r
1119 listejou:arrayof arrayof integer;
\r
1121 array listejou dim(1:50);
\r
1124 clc.joueur:=moi; clc.damier:=damier; clc.liste_coup:=listejou;
\r
1125 attach(clc); nmax:=clc.nbmax; ncoup:=clc.nb_coup;
\r
1126 damierjou:=damier; array coupe dim(1:21);
\r
1134 if(damier(cas)=moi or damier(cas)=(moi+moi))then
\r
1141 while(j<=ncoup) do
\r
1142 if coupe(1)=listejou(j,1) then
\r
1149 while((j<=ncoup) and ok) do
\r
1150 if coupe(1)=listejou(j,1)
\r
1156 if ok then exit; fi;
\r
1158 (* pref mouse block begin*)
\r
1160 call aff_croix(cas);
\r
1163 if (upper(listejou(1))>2)
\r
1165 else saute:=false;
\r
1178 if i>1 andif not(saute) andif coupe(i)=coupe(i-1) then
\r
1182 if i>2 andif saute andif coupe(i)=coupe(i-2) then
\r
1188 case damier(coupe(i))
\r
1189 when blanc: call aff_blanc(coupe(i));
\r
1190 when noir: call aff_noir(coupe(i));
\r
1191 when dameblanche: call aff_dameblanche(coupe(i));
\r
1192 when damenoire: call aff_damenoire(coupe(i));
\r
1193 otherwise call del_case(coupe(i));
\r
1202 if (damier(coupe(1))=moi and(coupe(2)=h_d(moi,coupe(1))
\r
1203 or coupe(2)=h_g(moi,coupe(1))))
\r
1204 then saute:=false;
\r
1206 if (damier(coupe(1))=moi) then
\r
1208 coupe(3):=coupe(2);
\r
1217 if coupe(k)<>listejou(j,k) then
\r
1233 while((j<=fin) and ok) do
\r
1236 if coupe(k)<>listejou(j,k) then
\r
1245 if q then exit; fi;
\r
1255 call aff_croix(cas);
\r
1262 if (i=nmax) then exit; fi;
\r
1266 array coupjou dim (1:i);
\r
1267 for i:=1 to upper(coupjou) do
\r
1268 coupjou(i):=listejou(deb,i);
\r
1277 var driver:boolean,
\r
1280 (* v
\82rifie qu'un gestionnaire de souris est install
\82 *)
\r
1282 driver:=init(bouton);
\r
1284 then writeln("Une souris avec ",bouton:1, " boutons a
\82t
\82 d
\82tect
\82e");
\r
1285 else writeln("Erreur: aucune souris n'a
\82t
\82 d
\82tect
\82e
\r
1286 , celle-ci est obligatoire"); exit;
\r
1288 pref IIUWGraph block
\r
1290 (*v
\82rifie que la carte vid
\82o pr
\82sente est support
\82e par le programme*)
\r
1294 (* Cas d'une carte EGA/VGA/SVGA *)
\r
1295 writeln("Une carte EGA ou compatible VGA a
\82t
\82 d
\82tect
\82e");
\r
1296 coulblanc:=15;coulnoir:=0;coulrouge:=12;
\r
1297 horiz:=30;vert:=25;debhoriz:=160;debvert:=50;
\r
1298 horiz1:=29;vert1:=24;horiz2:=60;
\r
1300 writeln("La carte vid
\82o pr
\82sente n'est pas supportee
\r
1301 par le programme: ",nocard);
\r
1302 writeln("Une carte EGA ou compatible VGA est obligatoire");
\r
1307 end (*IIUWGraph*);
\r