4 ************************************************************************
\r
6 * TP LI1 : Mai 1995 *
\r
8 * Co-auteurs : R
\82gis BRETTE *
\r
9 * Jean-Yves LAGARDE *
\r
11 * SUJET : A partir du langage LOGLAN, r
\82aliser *
\r
12 * une application utilisant les coroutines. *
\r
14 * MACHINE : DOS 386, Systeme LOGLAN-82 *
\r
15 * Version de classe graphisme : IIUWgraph *
\r
16 * Ecran : 640 X 480 *
\r
18 * REALISATION : Cette application permet de simuler un *
\r
19 * jeu de cartes : la belote. Les diff
\82rents *
\r
20 * joueurs sont simul
\82s par des coroutines. *
\r
22 * MODE D'EMPLOI : On clique
\85 la souris avec le bouton gauche*
\r
23 * sur les boutons pr
\82sents
\85 l'
\82cran. *
\r
29 ************************************************************************
\r
75 Pref iiuwgraph block (* fonctions graphiques *)
\r
77 Pref mouse block (* souris *)
\r
80 P1,P2,P3,P4,P5,P6,P7,P8,T1,T2,T3,T4,T5,T6,T7,T8 : carte,
\r
81 CA1,CA2,CA3,CA4,CA5,CA6,CA7,CA8,CO1,CO2,CO3,CO4,
\r
82 CO5,CO6,CO7,CO8 : carte,
\r
83 carte_ret,carte_oui : carte,
\r
84 atout_joue : arrayof boolean,
\r
85 score1,score2,tour,atout,fin_donne1,fin_donne2 : integer,
\r
86 oui,non,b_pic,b_trefle,b_carreau,b_aide_atout : bouton_relief,
\r
87 b_coeur,rien,carre,b_option,b_debut,b_fin : bouton_relief,
\r
89 image,image2,depart,save_menu : arrayof integer,
\r
90 del_menu,terrain,save_joueur : arrayof integer,
\r
91 he,ve,pe,le,re,ce : integer,
\r
92 dede,on_prend,termine : boolean,
\r
93 joueur_prend,adv1_prend,part_prend,adv2_prend : boolean,
\r
94 belote_joueur,belote_adversaire1 : boolean,
\r
95 belote_partenaire,belote_adversaire2 : boolean,
\r
96 s,e1,e2,e11,e22 : PILE,
\r
100 adv2 : adversaire2,
\r
102 j_jeu,p_jeu,a1_jeu,a2_jeu : arrayof carte_user,
\r
103 pli : arrayof carte,
\r
104 tx,ty : arrayof integer,
\r
105 commence,i,j,k,abscisse,ordonnee,coul,
\r
106 cpt_pli,eval,attente,total,lg : integer;
\r
108 (*************************************)
\r
109 (* Bouton en relief *)
\r
110 (*************************************)
\r
112 Unit BOUTON_RELIEF : class (x1,y1,x2,y2,nb_car:integer,titre:string);
\r
113 var selectionne : boolean;
\r
115 Unit print : procedure;
\r
117 if not selectionne
\r
119 call patern(x1,y1,x2,y2,gris_clair,plein);
\r
120 call patern(x1,y1,x2,y2,noir,vide);
\r
121 call patern(x1+1,y1+1,x1+1,y2-1,blanc,plein);
\r
122 call patern(x1+2,y1+2,x1+2,y2-2,blanc,plein);
\r
123 call patern(x1+1,y1+1,x2-1,y1+1,blanc,plein);
\r
124 call patern(x1+2,y1+2,x2-2,y1+2,blanc,plein);
\r
125 call patern(x2-1,y1+1,x2-1,y2-1,gris_fonce,plein);
\r
126 call patern(x2-2,y1+2,x2-2,y2-2,gris_fonce,plein);
\r
127 call patern(x1+1,y2-1,x2-1,y2-1,gris_fonce,plein);
\r
128 call patern(x1+2,y2-2,x2-2,y2-2,gris_fonce,plein);
\r
129 call patern(x1+5,y1+5,x2-5,y2-5,gris_fonce,vide);
\r
130 call outstring(ENTIER((x2-x1-nb_car*larg_caract)/2)+x1,
\r
131 ENTIER((y2-y1-haut_caract)/2)+y1,titre,noir,gris_clair);
\r
133 call patern(x1,y1,x2,y2,gris_clair,plein);
\r
134 call patern(x1,y1,x2,y2,noir,vide);
\r
135 call patern(x1+1,y1+1,x1+1,y2-1,noir,plein);
\r
136 call patern(x1+2,y1+2,x1+2,y2-2,noir,plein);
\r
137 call patern(x1+1,y1+1,x2-1,y1+1,noir,plein);
\r
138 call patern(x1+2,y1+2,x2-2,y1+2,noir,plein);
\r
139 call patern(x1+5,y1+5,x2-5,y2-5,gris_fonce,vide);
\r
140 call outstring(ENTIER((x2-x1-nb_car*larg_caract)/2)+x1+1,
\r
141 ENTIER((y2-y1-haut_caract)/2)+y1+1,titre,noir,gris_clair);
\r
145 Unit choix : procedure ;
\r
146 var pause : integer;
\r
150 (* on attend un peu pour visualiser l'effet de pression..*)
\r
151 for pause:=1 to 1000 do od;
\r
152 selectionne:=FALSE;
\r
156 Unit dedans : function(h,v :integer):boolean;
\r
158 result := (v>y1 and v<y2 and h>x1 and h<x2);
\r
163 (* On initialise le bouton_relief
\85 faux *)
\r
164 selectionne:=FALSE;
\r
170 (*************************************)
\r
171 (* Bouton en relief 2 *)
\r
172 (*************************************)
\r
174 Unit BOUTON_ENFONCE : class (x1,y1,x2,y2,nb_car:integer,titre:string);
\r
176 Unit print : procedure;
\r
178 call patern(x1,y1,x2,y2,gris_clair,plein);
\r
179 call patern(x1,y1,x2,y2,noir,vide);
\r
180 call patern(x1+1,y1+1,x1+1,y2-1,blanc,plein);
\r
181 call patern(x1+2,y1+2,x1+2,y2-2,blanc,plein);
\r
182 call patern(x1+1,y1+1,x2-1,y1+1,blanc,plein);
\r
183 call patern(x1+2,y1+2,x2-2,y1+2,blanc,plein);
\r
184 call patern(x2-1,y1+1,x2-1,y2-1,gris_fonce,plein);
\r
185 call patern(x2-2,y1+2,x2-2,y2-2,gris_fonce,plein);
\r
186 call patern(x1+1,y2-1,x2-1,y2-1,gris_fonce,plein);
\r
187 call patern(x1+2,y2-2,x2-2,y2-2,gris_fonce,plein);
\r
188 call outstring(ENTIER((x2-x1-nb_car*larg_caract)/2)+x1,
\r
189 ENTIER((y2-y1-haut_caract)/2)+y1,titre,noir,gris_clair);
\r
192 Unit choix : procedure ;
\r
194 call patern(x1,y1,x2,y2,gris_clair,plein);
\r
195 call patern(x1,y1,x2,y2,noir,vide);
\r
196 call patern(x1+1,y1+1,x1+1,y2-1,noir,plein);
\r
197 call patern(x1+2,y1+2,x1+2,y2-2,noir,plein);
\r
198 call patern(x1+1,y1+1,x2-1,y1+1,noir,plein);
\r
199 call patern(x1+2,y1+2,x2-2,y1+2,noir,plein);
\r
200 call outstring(ENTIER((x2-x1-nb_car*larg_caract)/2)+x1+1,
\r
201 ENTIER((y2-y1-haut_caract)/2)+y1+1,titre,noir,gris_clair);
\r
204 Unit dedans : function(h,v :integer):boolean;
\r
206 result := (v>y1 and v<y2 and h>x1 and h<x2);
\r
209 end bouton_enfonce;
\r
211 (********************************************************************)
\r
212 (****************************************)
\r
213 (* Representation des cartes *)
\r
214 (****************************************)
\r
216 Unit sept_print : procedure(x,y:integer,couleur:integer);
\r
218 call outstring(x+3,y+2,"7",couleur,blanc);
\r
219 call outstring(x+40,y+87,"7",couleur,blanc);
\r
220 call outstring(x+40,y+2,"7",couleur,blanc);
\r
221 call outstring(x+3,y+87,"7",couleur,blanc);
\r
225 Unit huit_print : procedure(x,y:integer,couleur:integer);
\r
227 call outstring(x+3,y+2,"8",couleur,blanc);
\r
228 call outstring(x+40,y+87,"8",couleur,blanc);
\r
229 call outstring(x+40,y+2,"8",couleur,blanc);
\r
230 call outstring(x+3,y+87,"8",couleur,blanc);
\r
234 Unit neuf_print : procedure(x,y:integer,couleur:integer);
\r
236 call outstring(x+3,y+2,"9",couleur,blanc);
\r
237 call outstring(x+40,y+87,"9",couleur,blanc);
\r
238 call outstring(x+40,y+2,"9",couleur,blanc);
\r
239 call outstring(x+3,y+87,"9",couleur,blanc);
\r
243 Unit dix_print : procedure(x,y:integer,couleur:integer);
\r
245 call outstring(x+3,y+2,"10",couleur,blanc);
\r
246 call outstring(x+34,y+87,"10",couleur,blanc);
\r
247 call outstring(x+34,y+2,"10",couleur,blanc);
\r
248 call outstring(x+3,y+87,"10",couleur,blanc);
\r
252 Unit valet_print : procedure(x,y:integer,couleur:integer);
\r
254 call outstring(x+3,y+2,"V",couleur,blanc);
\r
255 call outstring(x+40,y+87,"V",couleur,blanc);
\r
256 call outstring(x+40,y+2,"V",couleur,blanc);
\r
257 call outstring(x+3,y+87,"V",couleur,blanc);
\r
261 Unit dame_print : procedure(x,y:integer,couleur:integer);
\r
263 call outstring(x+3,y+2,"D",couleur,blanc);
\r
264 call outstring(x+40,y+87,"D",couleur,blanc);
\r
265 call outstring(x+40,y+2,"D",couleur,blanc);
\r
266 call outstring(x+3,y+87,"D",couleur,blanc);
\r
270 Unit roi_print : procedure(x,y:integer,couleur:integer);
\r
272 call outstring(x+3,y+2,"R",couleur,blanc);
\r
273 call outstring(x+40,y+87,"R",couleur,blanc);
\r
274 call outstring(x+40,y+2,"R",couleur,blanc);
\r
275 call outstring(x+3,y+87,"R",couleur,blanc);
\r
279 Unit as_print : procedure(x,y:integer,couleur:integer);
\r
281 call outstring(x+3,y+2,"1",couleur,blanc);
\r
282 call outstring(x+40,y+87,"1",couleur,blanc);
\r
283 call outstring(x+40,y+2,"1",couleur,blanc);
\r
284 call outstring(x+3,y+87,"1",couleur,blanc);
\r
290 Unit pic : procedure(x,y : integer);
\r
291 var tabx,taby : arrayof integer;
\r
293 array tabx dim(1:7);
\r
294 array taby dim(1:7);
\r
295 tabx(1):=X+10;taby(1):=Y+25;
\r
296 tabx(2):=X+6;taby(2):=Y+38;
\r
297 tabx(3):=X+14;taby(3):=Y+38;
\r
298 tabx(4):=X+10;taby(4):=Y+25;
\r
299 tabx(5):=X+0;taby(5):=Y+25;
\r
300 tabx(6):=X+10;taby(6):=Y+10;
\r
301 tabx(7):=X+20;taby(7):=Y+25;
\r
302 call intens(7,tabx,taby,noir,plein);
\r
303 call cirb(x+5+6/2,y+25+6/2,6/2,6/2,0,3600,noir,plein);
\r
304 call cirb(x+15+6/2,y+25+6/2,6/2,6/2,0,3600,noir,plein);
\r
307 Unit trefle : procedure(x,y : integer);
\r
308 var tabx,taby : arrayof integer;
\r
310 array tabx dim(1:3);
\r
311 array taby dim(1:3);
\r
312 tabx(1):=X+10;taby(1):=Y+23;
\r
313 tabx(2):=X+6;taby(2):=Y+38;
\r
314 tabx(3):=X+14;taby(3):=Y+38;
\r
315 call intens(3,tabx,taby,noir,plein);
\r
316 call cirb(x+10+6/2,y+15+6/2,6/2,6/2,0,3600,noir,plein);
\r
317 call cirb(x+1+6/2,y+25+6/2,6/2,6/2,0,3600,noir,plein);
\r
318 call cirb(x+19+6/2,y+25+6/2,6/2,6/2,0,3600,noir,plein);
\r
321 Unit carreau : procedure(x,y : integer);
\r
322 var tabx,taby : arrayof integer;
\r
324 array tabx dim(1:4);
\r
325 array taby dim(1:4);
\r
326 tabx(1):=X+0;taby(1):=Y+25;
\r
327 tabx(2):=X+10;taby(2):=Y+40;
\r
328 tabx(3):=X+20;taby(3):=Y+25;
\r
329 tabx(4):=X+10;taby(4):=Y+10;
\r
330 call intens(4,tabx,taby,rouge,plein);
\r
333 Unit coeur : procedure(x,y : integer);
\r
334 var tabx,taby : arrayof integer;
\r
336 array tabx dim(1:4);
\r
337 array taby dim(1:4);
\r
338 tabx(1):=X+10;taby(1):=Y+25;
\r
339 tabx(2):=X-2;taby(2):=Y+25;
\r
340 tabx(3):=X+10;taby(3):=Y+40;
\r
341 tabx(4):=X+22;taby(4):=Y+25;
\r
342 call intens(4,tabx,taby,rouge,plein);
\r
343 call cirb(x+5+7/2,y+22+7/2,7/2,7/2,0,3600,rouge,plein);
\r
344 call cirb(x+15+7/2,y+22+7/2,7/2,7/2,0,3600,rouge,plein);
\r
348 (******************************************)
\r
349 (* Creation des cartes *)
\r
350 (******************************************)
\r
352 Unit carte : class(couleur,valeur:integer);
\r
354 Unit dedans :function(h,v : integer):boolean;
\r
356 result := (v>y and v<y+100 and h>x and h<x+50);
\r
359 Unit print : procedure;
\r
362 call patern(x,y,x+50,y+100,blanc,plein);
\r
363 call patern(x-1,y-1,x+51,y+101,noir,vide);
\r
365 when P : call pic(x+15,y+30);
\r
367 when T : call trefle(x+15,y+30);
\r
369 when CA : call carreau(x+15,y+30);
\r
371 when CO : call coeur(x+15,y+30);
\r
375 when sept : call sept_print(x,y,tmp);
\r
376 when huit : call huit_print(x,y,tmp);
\r
377 when neuf : call neuf_print(x,y,tmp);
\r
378 when dix : call dix_print(x,y,tmp);
\r
379 when valet : call valet_print(x,y,tmp);
\r
380 when dame : call dame_print(x,y,tmp);
\r
381 when roi : call roi_print(x,y,tmp);
\r
382 when as : call as_print(x,y,tmp);
\r
387 Unit efface : procedure;
\r
389 call patern(x-1,y-1,x+51,y+101,bleu,plein);
\r
399 Unit CARTE_USER : class;
\r
403 c:=new carte(P,sept);
\r
408 (*************************************)
\r
409 (* Implementation d'une pile *)
\r
411 (*************************************)
\r
415 unit elem:class (valeur:carte,suivant:elem);
\r
419 unit empty:function:boolean;
\r
423 else result:=false;
\r
427 unit push:procedure(c:carte);
\r
429 sommet:=new elem(c,sommet);
\r
432 unit pop:function:carte;
\r
436 result:=sommet.valeur;
\r
437 sommet:=sommet.suivant;
\r
442 (*********************************************************************)
\r
444 (*************************************)
\r
445 (* Creation des 4 coroutines *)
\r
446 (*************************************)
\r
449 Unit joueur : coroutine;
\r
450 var i,n,abscisse,ordonnee:integer;
\r
452 Unit donne1 : procedure;
\r
454 call patern(0,362,640,480,bleu,plein);
\r
455 call b_aide_atout.print;
\r
461 j_jeu(i).present:=true;
\r
462 j_jeu(i).c.x:=abscisse;
\r
463 j_jeu(i).c.y:=ordonnee;
\r
464 call j_jeu(i).c.print;
\r
465 abscisse:=abscisse+55;
\r
468 for i:=1 to 7000 do od;
\r
472 j_jeu(i).present:=true;
\r
473 j_jeu(i).c.x:=abscisse;
\r
474 j_jeu(i).c.y:=ordonnee;
\r
475 call j_jeu(i).c.print;
\r
476 abscisse:=abscisse+55;
\r
478 for i:=1 to 7000 do od;
\r
479 fin_donne1:=fin_donne1+1;
\r
488 Unit tour1 : procedure;
\r
491 joueur_prend:=false;
\r
493 dede:=getpress(he,ve,pe,le,re,ce);
\r
496 if (oui.dedans(he,ve))
\r
500 atout:=carte_ret.couleur;
\r
501 joueur_prend:=true;
\r
503 call putmap(image);
\r
505 call putmap(terrain);
\r
509 if (non.dedans(he,ve))
\r
513 call putmap(image);
\r
515 call putmap(terrain);
\r
516 call carte_ret.print;
\r
525 Unit tour2 : procedure;
\r
529 dede:=getpress(he,ve,pe,le,re,ce);
\r
532 if (b_pic.dedans(he,ve))
\r
536 joueur_prend:=true;
\r
539 call putmap(image);
\r
541 call putmap(terrain);
\r
545 if (b_trefle.dedans(he,ve))
\r
547 call b_trefle.choix;
\r
549 joueur_prend:=true;
\r
552 call putmap(image);
\r
554 call putmap(terrain);
\r
558 if (b_carreau.dedans(he,ve))
\r
560 call b_carreau.choix;
\r
562 joueur_prend:=true;
\r
565 call putmap(image);
\r
567 call putmap(terrain);
\r
571 if (b_coeur.dedans(he,ve))
\r
573 call b_coeur.choix;
\r
575 joueur_prend:=true;
\r
578 call putmap(image);
\r
580 call putmap(terrain);
\r
585 if (rien.dedans(he,ve))
\r
589 call putmap(image);
\r
591 call putmap(terrain);
\r
592 call carte_ret.print;
\r
600 Unit donne2 : procedure;
\r
601 var i,j,abscisse,ordonnee : integer;
\r
604 call putmap(image);
\r
609 for j:=1 to 7000 do od;
\r
610 j_jeu(6).c:=carte_ret;
\r
611 j_jeu(6).present:=true;
\r
612 j_jeu(6).c.x:=abscisse;
\r
613 j_jeu(6).c.y:=ordonnee;
\r
614 call j_jeu(6).c.print;
\r
615 abscisse:=abscisse+55;
\r
617 for j:=1 to 7000 do od;
\r
621 j_jeu(i).present:=true;
\r
622 j_jeu(i).c.x:=abscisse;
\r
623 j_jeu(i).c.y:=ordonnee;
\r
624 call j_jeu(i).c.print;
\r
625 abscisse:=abscisse+55;
\r
628 for j:=1 to 7000 do od;
\r
632 j_jeu(i).present:=true;
\r
633 j_jeu(i).c.x:=abscisse;
\r
634 j_jeu(i).c.y:=ordonnee;
\r
635 call j_jeu(i).c.print;
\r
636 abscisse:=abscisse+55;
\r
639 (* belote ou non ? *)
\r
640 belote_joueur:=false;
\r
643 if j_jeu(i).c.couleur=atout and j_jeu(i).c.valeur=dame
\r
647 if j_jeu(j).c.couleur=atout and j_jeu(j).c.valeur=roi
\r
649 belote_joueur:=true;
\r
654 fin_donne2:=fin_donne2+1;
\r
664 Unit jouer_carte : procedure;
\r
667 he,ve,pe,le,re,ce : integer;
\r
672 dede:=getpress(he,ve,pe,le,re,ce);
\r
675 if b_aide_atout.dedans(he,ve)
\r
677 call b_aide_atout.choix;
\r
679 save_joueur:=getmap(640,480);
\r
680 call affiche_atout;
\r
682 call putmap(save_joueur);
\r
684 if (j_jeu(1).c.dedans(he,ve))
\r
686 if j_jeu(1).present
\r
688 for i:=1 to 10000 do od;
\r
689 pli(cpt_pli):=j_jeu(1).c;
\r
690 j_jeu(1).present:=false;
\r
691 if j_jeu(1).c.couleur=atout
\r
693 atout_joue(j_jeu(1).c.valeur):=true;
\r
695 call j_jeu(1).c.efface;
\r
699 if (j_jeu(2).c.dedans(he,ve))
\r
701 if j_jeu(2).present
\r
703 for i:=1 to 10000 do od;
\r
704 pli(cpt_pli):=j_jeu(2).c;
\r
705 j_jeu(2).present:=false;
\r
706 if j_jeu(2).c.couleur=atout
\r
708 atout_joue(j_jeu(2).c.valeur):=true;
\r
710 call j_jeu(2).c.efface;
\r
714 if (j_jeu(3).c.dedans(he,ve))
\r
716 if j_jeu(3).present
\r
718 for i:=1 to 10000 do od;
\r
719 pli(cpt_pli):=j_jeu(3).c;
\r
720 j_jeu(3).present:=false;
\r
721 if j_jeu(3).c.couleur=atout
\r
723 atout_joue(j_jeu(3).c.valeur):=true;
\r
725 call j_jeu(3).c.efface;
\r
729 if (j_jeu(4).c.dedans(he,ve))
\r
731 if j_jeu(4).present
\r
733 for i:=1 to 10000 do od;
\r
734 pli(cpt_pli):=j_jeu(4).c;
\r
735 j_jeu(4).present:=false;
\r
736 if j_jeu(4).c.couleur=atout
\r
738 atout_joue(j_jeu(4).c.valeur):=true;
\r
740 call j_jeu(4).c.efface;
\r
744 if (j_jeu(5).c.dedans(he,ve))
\r
746 if j_jeu(5).present
\r
748 for i:=1 to 10000 do od;
\r
749 pli(cpt_pli):=j_jeu(5).c;
\r
750 j_jeu(5).present:=false;
\r
751 if j_jeu(5).c.couleur=atout
\r
753 atout_joue(j_jeu(5).c.valeur):=true;
\r
755 call j_jeu(5).c.efface;
\r
759 if (j_jeu(6).c.dedans(he,ve))
\r
761 if j_jeu(6).present
\r
763 for i:=1 to 10000 do od;
\r
764 pli(cpt_pli):=j_jeu(6).c;
\r
765 j_jeu(6).present:=false;
\r
766 if j_jeu(6).c.couleur=atout
\r
768 atout_joue(j_jeu(6).c.valeur):=true;
\r
770 call j_jeu(6).c.efface;
\r
774 if (j_jeu(7).c.dedans(he,ve))
\r
776 if j_jeu(7).present
\r
778 for i:=1 to 10000 do od;
\r
779 pli(cpt_pli):=j_jeu(7).c;
\r
780 j_jeu(7).present:=false;
\r
781 if j_jeu(7).c.couleur=atout
\r
783 atout_joue(j_jeu(7).c.valeur):=true;
\r
785 call j_jeu(7).c.efface;
\r
789 if (j_jeu(8).c.dedans(he,ve))
\r
791 if j_jeu(8).present
\r
793 for i:=1 to 10000 do od;
\r
794 pli(cpt_pli):=j_jeu(8).c;
\r
795 j_jeu(8).present:=false;
\r
796 if j_jeu(8).c.couleur=atout
\r
798 atout_joue(j_jeu(8).c.valeur):=true;
\r
800 call j_jeu(8).c.efface;
\r
806 pli(cpt_pli).x:=295;
\r
807 pli(cpt_pli).y:=240;
\r
808 call pli(cpt_pli).print;
\r
809 for i:=1 to 30000 do od;
\r
820 oui:=new bouton_relief(260,95,310,125,3,"oui");
\r
821 non:=new bouton_relief(330,95,390,125,3,"non");
\r
822 call patern(200,55,440,135,gris_clair,plein);
\r
823 call patern(200,55,440,135,noir,vide);
\r
824 call outstring(235,60,"Desirez-vous prendre ?",noir,gris_clair);
\r
833 call putmap(image);
\r
834 b_pic:=new bouton_relief(210,85,280,125,3,"Pic");
\r
835 b_trefle:=new bouton_relief(290,85,360,125,6,"Trefle");
\r
836 b_carreau:=new bouton_relief(210,135,280,175,7,"Carreau");
\r
837 b_coeur:=new bouton_relief(290,135,360,175,5,"Coeur");
\r
838 rien:=new bouton_relief(370,110,430,150,6,"Aucune");
\r
839 carre:=new bouton_relief(175,55,465,195,0,"");
\r
841 call outstring(235,60,"choisissez une couleur ?",noir,gris_clair);
\r
843 call b_trefle.print;
\r
844 call b_carreau.print;
\r
845 call b_coeur.print;
\r
865 Unit adversaire1 : coroutine;
\r
866 var i,j,n,cumul,attente : integer;
\r
868 Unit donne1 : procedure;
\r
872 a1_jeu(i).c:=s.pop;
\r
873 a1_jeu(i).present:=true;
\r
876 for i:=1 to 7000 do od;
\r
879 a1_jeu(i).c:=s.pop;
\r
880 a1_jeu(i).present:=true;
\r
882 fin_donne1:=fin_donne1+1;
\r
892 Unit tour1 : procedure;
\r
896 (* peut-il prendre ? *)
\r
897 cumul:=evalue(carte_ret);
\r
900 if (a1_jeu(i).c.couleur=carte_ret.couleur)
\r
902 cumul:=cumul+evalue(a1_jeu(i).c);
\r
907 call outstring(300,26,"EST prend",noir,gris_clair);
\r
908 for i:=1 to 27000 do od;
\r
909 call outstring(300,26," ",noir,gris_clair);
\r
912 atout:=carte_ret.couleur;
\r
915 call outstring(250,26,"EST ne prend pas ",noir,gris_clair);
\r
916 for i:=1 to 27000 do od;
\r
917 call outstring(250,26," ",noir,gris_clair);
\r
923 Unit tour2 : procedure;
\r
926 while ((j<=4) and not(on_prend))
\r
930 if (coul=/=carte_ret.couleur)
\r
934 if (a1_jeu(i).c.couleur=coul)
\r
936 cumul:=cumul+evalue(a1_jeu(i).c);
\r
941 call outstring(300,26,"EST prend",noir,gris_clair);
\r
942 for i:=1 to 17000 do od;
\r
943 call outstring(300,26," ",noir,gris_clair);
\r
948 call outstring(250,26,"EST ne prend pas ",noir,gris_clair);
\r
949 for i:=1 to 17000 do od;
\r
950 call outstring(250,26," ",noir,gris_clair);
\r
964 Unit donne2 : procedure;
\r
969 a1_jeu(6).c:=carte_ret;
\r
970 a1_jeu(6).present:=true;
\r
973 a1_jeu(i).c:=s.pop;
\r
974 a1_jeu(i).present:=true;
\r
979 a1_jeu(i).c:=s.pop;
\r
980 a1_jeu(i).present:=true;
\r
983 (* belote ou non ? *)
\r
984 belote_adversaire1:=false;
\r
987 if a1_jeu(i).c.couleur=atout and a1_jeu(i).c.valeur=dame
\r
991 if a1_jeu(j).c.couleur=atout and a1_jeu(j).c.valeur=roi
\r
993 belote_adversaire1:=true;
\r
999 fin_donne2:=fin_donne2+1;
\r
1010 Unit jouer_carte : procedure;
\r
1011 var trouve,pas_encore : boolean,
\r
1012 i,remember,forte : integer;
\r
1018 if cpt_pli=1 (* c'est lui qui joue en premier *)
\r
1020 if adv1_prend or adv2_prend
\r
1022 (* ils ont pris *)
\r
1023 (* adv1 joue atout si possible *)
\r
1024 while i<9 and not trouve
\r
1026 if a1_jeu(i).c.couleur=atout and a1_jeu(i).present
\r
1028 pli(cpt_pli):=a1_jeu(i).c;
\r
1029 a1_jeu(i).present:=false;
\r
1030 atout_joue(a1_jeu(i).c.valeur):=true;
\r
1037 while i<9 and not trouve
\r
1039 (* adv1 n'a pas d'atout, alors il joue as sinon indien *)
\r
1040 if a1_jeu(i).present
\r
1044 pli(cpt_pli):=a1_jeu(i).c;
\r
1046 pas_encore:=false;
\r
1047 if pli(cpt_pli).valeur=as
\r
1052 (* il n'a pas encore trouve d'as, et il lui reste des cartes
\r
1054 if a1_jeu(i).c.valeur=as
\r
1056 pli(cpt_pli):=a1_jeu(i).c;
\r
1060 (* si toujours pas d'as, il prend la plus petite de son jeu *)
\r
1061 if pli(cpt_pli).valeur>a1_jeu(i).c.valeur
\r
1063 pli(cpt_pli):=a1_jeu(i).c;
\r
1071 (* il joue donc la carte nø remember *)
\r
1074 a1_jeu(remember).present:=false;
\r
1075 if a1_jeu(remember).c.couleur=atout
\r
1077 atout_joue(a1_jeu(remember).c.valeur):=true;
\r
1081 (* Ils n'ont pas pris *)
\r
1084 while i<9 and not trouve
\r
1086 (* adv1 joue as sinon indien different d'atout *)
\r
1087 if a1_jeu(i).c.couleur<>atout
\r
1089 if a1_jeu(i).present
\r
1093 pli(cpt_pli):=a1_jeu(i).c;
\r
1095 pas_encore:=false;
\r
1096 if pli(cpt_pli).valeur=as
\r
1099 a1_jeu(remember).present:=false;
\r
1100 if a1_jeu(remember).c.couleur=atout
\r
1102 atout_joue(a1_jeu(remember).c.valeur):=true;
\r
1106 (* il n'a pas encore trouve d'as, et il lui reste des cartes
\r
1108 if a1_jeu(i).c.valeur=as
\r
1110 pli(cpt_pli):=a1_jeu(i).c;
\r
1112 a1_jeu(remember).present:=false;
\r
1113 if a1_jeu(remember).c.couleur=atout
\r
1115 atout_joue(a1_jeu(remember).c.valeur):=true;
\r
1119 (* si toujours pas d'as, il prend la plus petite carte de son jeu *)
\r
1120 if pli(cpt_pli).valeur>a1_jeu(i).c.valeur
\r
1122 pli(cpt_pli):=a1_jeu(i).c;
\r
1133 (* il ne lui reste que de l'atout *)
\r
1134 (* il est donc oblige de jouer atout *)
\r
1138 (* adv1 joue le plus petit atout *)
\r
1139 if a1_jeu(i).present
\r
1145 if not compare_atout(a1_jeu(i).c.valeur,a1_jeu(remember).c.valeur)
\r
1146 (* a1_jeu(i).c.valeur<a1_jeu(remember).c.valeur *)
\r
1155 a1_jeu(remember).present:=false;
\r
1156 if a1_jeu(remember).c.couleur=atout
\r
1158 atout_joue(a1_jeu(remember).c.valeur):=true;
\r
1160 pli(cpt_pli):=a1_jeu(remember).c;
\r
1162 else (* s'il ne joue pas en premier .............................. *)
\r
1164 if pli(1).couleur<>atout
\r
1167 while i<9 and not trouve
\r
1169 (* Il joue as sinon indien dans couleur demandee different d'atout *)
\r
1170 if a1_jeu(i).present and a1_jeu(i).c.couleur=pli(1).couleur
\r
1175 pas_encore:=false;
\r
1176 if a1_jeu(remember).c.valeur=as
\r
1181 (* il n'a pas encore trouve d'as, et il lui reste des cartes
\r
1183 if a1_jeu(i).c.valeur=as
\r
1188 (* si toujours pas d'as, il prend la plus petite de son jeu *)
\r
1189 if a1_jeu(remember).c.valeur>a1_jeu(i).c.valeur
\r
1200 (* il n'a pas de la couleur demandee, il essaie de jouer atout *)
\r
1204 (* adv1 joue le plus petit atout *)
\r
1205 if a1_jeu(i).present and a1_jeu(i).c.couleur=atout
\r
1211 if not compare_atout(a1_jeu(i).c.valeur,a1_jeu(remember).c.valeur)
\r
1221 (* il ne peut pas couper *)
\r
1225 (* adv1 joue sa plus petite carte *)
\r
1226 if a1_jeu(i).present
\r
1232 if a1_jeu(i).c.valeur<a1_jeu(remember).c.valeur
\r
1243 (* c'est atout demandee *)
\r
1244 (* il est oblige de monter *)
\r
1246 for i:=1 to cpt_pli
\r
1248 if pli(i).couleur=atout
\r
1250 if not compare_atout(forte,pli(i).valeur)
\r
1252 forte:=pli(i).valeur
\r
1257 while i<9 and not trouve
\r
1259 if a1_jeu(i).present and a1_jeu(i).c.couleur=atout
\r
1264 if compare_atout(a1_jeu(i).c.valeur,forte)
\r
1269 if compare_atout(a1_jeu(i).c.valeur,forte)
\r
1274 if not compare_atout(a1_jeu(i).c.valeur,a1_jeu(remember).c.valeur)
\r
1285 (* adv1 n'a pas d'atout, il joue un indien *)
\r
1289 (* adv1 joue sa plus petite carte *)
\r
1290 if a1_jeu(i).present
\r
1296 if a1_jeu(i).c.valeur<a1_jeu(remember).c.valeur
\r
1306 pli(cpt_pli):=a1_jeu(remember).c;
\r
1307 a1_jeu(remember).present:=false;
\r
1308 if a1_jeu(remember).c.couleur=atout
\r
1310 atout_joue(a1_jeu(remember).c.valeur):=true;
\r
1313 pli(cpt_pli).x:=400;
\r
1314 pli(cpt_pli).y:=170;
\r
1315 call pli(cpt_pli).print;
\r
1316 for i:=1 to 30000 do od;
\r
1348 Unit partenaire : coroutine;
\r
1349 var i,j,n,cumul : integer;
\r
1351 Unit donne1 : procedure;
\r
1355 p_jeu(i).c:=s.pop;
\r
1356 p_jeu(i).present:=true;
\r
1358 for i:=1 to 7000 do od;
\r
1360 for i:=1 to 7000 do od;
\r
1363 p_jeu(i).c:=s.pop;
\r
1364 p_jeu(i).present:=true;
\r
1366 for i:=1 to 7000 do od;
\r
1367 fin_donne1:=fin_donne1+1;
\r
1378 Unit tour1 : procedure;
\r
1381 part_prend:=false;
\r
1382 (* peut-il prendre ? *)
\r
1383 cumul:=evalue2(carte_ret);
\r
1386 if (p_jeu(i).c.couleur=carte_ret.couleur)
\r
1388 cumul:=cumul+evalue2(p_jeu(i).c);
\r
1393 call outstring(300,26,"NORD prend",noir,gris_clair);
\r
1394 for i:=1 to 27000 do od;
\r
1395 call outstring(300,26," ",noir,gris_clair);
\r
1398 atout:=carte_ret.couleur;
\r
1401 call outstring(250,26,"NORD ne prend pas ",noir,gris_clair);
\r
1402 for i:=1 to 27000 do od;
\r
1403 call outstring(250,26," ",noir,gris_clair);
\r
1409 Unit tour2 : procedure;
\r
1412 while ((j<=4) and not(on_prend))
\r
1416 if (coul=/=carte_ret.couleur)
\r
1420 if (p_jeu(i).c.couleur=coul)
\r
1422 cumul:=cumul+evalue2(p_jeu(i).c);
\r
1427 call outstring(300,26,"NORD prend",noir,gris_clair);
\r
1428 for i:=1 to 17000 do od;
\r
1429 call outstring(300,26," ",noir,gris_clair);
\r
1434 call outstring(250,26,"NORD ne prend pas ",noir,gris_clair);
\r
1435 for i:=1 to 17000 do od;
\r
1436 call outstring(250,26," ",noir,gris_clair);
\r
1450 Unit donne2 : procedure;
\r
1455 p_jeu(6).c:=carte_ret;
\r
1456 p_jeu(6).present:=true;
\r
1459 p_jeu(i).c:=s.pop;
\r
1460 p_jeu(i).present:=true;
\r
1465 p_jeu(i).c:=s.pop;
\r
1466 p_jeu(i).present:=true;
\r
1469 belote_partenaire:=false;
\r
1472 if p_jeu(i).c.couleur=atout and p_jeu(i).c.valeur=dame
\r
1476 if p_jeu(j).c.couleur=atout and p_jeu(j).c.valeur=roi
\r
1478 belote_partenaire:=true;
\r
1484 fin_donne2:=fin_donne2+1;
\r
1494 Unit jouer_carte : procedure;
\r
1495 var trouve,pas_encore : boolean,
\r
1496 i,remember,forte,grand,petit,maitre : integer;
\r
1502 if cpt_pli=1 (* c'est lui qui joue en premier *)
\r
1504 if joueur_prend or part_prend
\r
1506 (* ils ont pris *)
\r
1507 (* part joue atout si possible *)
\r
1512 if p_jeu(i).present
\r
1514 if p_jeu(i).c.couleur=atout and grand=0
\r
1519 if p_jeu(i).c.couleur=atout
\r
1521 if compare_atout(p_jeu(i).c.valeur,p_jeu(grand).c.valeur)
\r
1525 if not compare_atout(p_jeu(i).c.valeur,p_jeu(petit).c.valeur)
\r
1537 if p_jeu(grand).c.valeur=maitre
\r
1543 pli(cpt_pli):=p_jeu(remember).c;
\r
1547 while i<9 and not trouve and grand=0
\r
1549 (* part n'a pas d'atout, alors il joue as sinon indien *)
\r
1550 if p_jeu(i).present
\r
1554 pli(cpt_pli):=p_jeu(i).c;
\r
1556 pas_encore:=false;
\r
1557 if pli(cpt_pli).valeur=as
\r
1562 (* il n'a pas encore trouve d'as, et il lui reste des cartes
\r
1564 if p_jeu(i).c.valeur=as
\r
1566 pli(cpt_pli):=p_jeu(i).c;
\r
1570 (* si toujours pas d'as, il prend la plus petite de son jeu *)
\r
1571 if pli(cpt_pli).valeur>p_jeu(i).c.valeur
\r
1573 pli(cpt_pli):=p_jeu(i).c;
\r
1581 (* il joue donc la carte nø remember *)
\r
1584 p_jeu(remember).present:=false;
\r
1587 (* Ils n'ont pas pris *)
\r
1590 while i<9 and not trouve
\r
1592 (* part joue as sinon indien different d'atout *)
\r
1593 if p_jeu(i).c.couleur<>atout
\r
1595 if p_jeu(i).present
\r
1599 pli(cpt_pli):=p_jeu(i).c;
\r
1601 pas_encore:=false;
\r
1602 if pli(cpt_pli).valeur=as
\r
1605 p_jeu(remember).present:=false;
\r
1608 (* il n'a pas encore trouve d'as, et il lui reste des cartes
\r
1610 if p_jeu(i).c.valeur=as
\r
1612 pli(cpt_pli):=p_jeu(i).c;
\r
1614 p_jeu(remember).present:=false;
\r
1617 (* si toujours pas d'as, il prend la plus petite carte de son jeu *)
\r
1618 if pli(cpt_pli).valeur>p_jeu(i).c.valeur
\r
1620 pli(cpt_pli):=p_jeu(i).c;
\r
1631 (* il ne lui reste que de l'atout *)
\r
1632 (* il est donc oblige de jouer atout *)
\r
1636 (* part joue le plus petit atout *)
\r
1637 if p_jeu(i).present
\r
1643 if not compare_atout(p_jeu(i).c.valeur,p_jeu(remember).c.valeur)
\r
1644 (* p_jeu(i).c.valeur<p_jeu(remember).c.valeur *)
\r
1653 p_jeu(remember).present:=false;
\r
1654 pli(cpt_pli):=p_jeu(remember).c;
\r
1656 else (* s'il ne joue pas en premier .............................. *)
\r
1658 if pli(1).couleur<>atout
\r
1661 while i<9 and not trouve
\r
1663 (* Il joue as sinon indien dans couleur demandee different d'atout *)
\r
1664 if p_jeu(i).present and p_jeu(i).c.couleur=pli(1).couleur
\r
1669 pas_encore:=false;
\r
1670 if p_jeu(remember).c.valeur=as
\r
1675 (* il n'a pas encore trouve d'as, et il lui reste des cartes
\r
1677 if p_jeu(i).c.valeur=as
\r
1682 (* si toujours pas d'as, il prend la plus petite de son jeu *)
\r
1683 if p_jeu(remember).c.valeur>p_jeu(i).c.valeur
\r
1694 (* il n'a pas de la couleur demandee, il essaie de jouer atout *)
\r
1698 (* part joue le plus petit atout *)
\r
1699 if p_jeu(i).present and p_jeu(i).c.couleur=atout
\r
1705 if not compare_atout(p_jeu(i).c.valeur,p_jeu(remember).c.valeur)
\r
1715 (* il ne peut pas couper *)
\r
1719 (* part joue sa plus petite carte *)
\r
1720 if p_jeu(i).present
\r
1726 if p_jeu(i).c.valeur<p_jeu(remember).c.valeur
\r
1737 (* c'est atout demandee *)
\r
1738 (* il est oblige de monter *)
\r
1740 for i:=1 to cpt_pli
\r
1742 if pli(i).couleur=atout
\r
1744 if not compare_atout(forte,pli(i).valeur)
\r
1746 forte:=pli(i).valeur
\r
1751 while i<9 and not trouve
\r
1753 if p_jeu(i).present and p_jeu(i).c.couleur=atout
\r
1758 if compare_atout(p_jeu(i).c.valeur,forte)
\r
1763 if compare_atout(p_jeu(i).c.valeur,forte)
\r
1768 if not compare_atout(p_jeu(i).c.valeur,p_jeu(remember).c.valeur)
\r
1779 (* part n'a pas d'atout, il joue un indien *)
\r
1783 (* part joue sa plus petite carte *)
\r
1784 if p_jeu(i).present
\r
1790 if p_jeu(i).c.valeur<p_jeu(remember).c.valeur
\r
1800 pli(cpt_pli):=p_jeu(remember).c;
\r
1801 p_jeu(remember).present:=false;
\r
1805 if p_jeu(remember).c.couleur=atout
\r
1807 atout_joue(p_jeu(remember).c.valeur):=true;
\r
1812 pli(cpt_pli).x:=295;
\r
1813 pli(cpt_pli).y:=100;
\r
1814 call pli(cpt_pli).print;
\r
1815 for i:=1 to 30000 do od;
\r
1850 Unit adversaire2 : coroutine;
\r
1851 var i,j,n,cumul : integer;
\r
1853 Unit donne1 : procedure;
\r
1857 a2_jeu(i).c:=s.pop;
\r
1858 a2_jeu(i).present:=true;
\r
1860 for i:=1 to 7000 do od;
\r
1862 for i:=1 to 7000 do od;
\r
1865 a2_jeu(i).c:=s.pop;
\r
1866 a2_jeu(i).present:=true;
\r
1868 for i:=1 to 7000 do od;
\r
1869 fin_donne1:=fin_donne1+1;
\r
1879 Unit tour1 : procedure;
\r
1882 adv2_prend:=false;
\r
1883 (* peut-il prendre ? *)
\r
1884 cumul:=evalue(carte_ret);
\r
1887 if (a2_jeu(i).c.couleur=carte_ret.couleur)
\r
1889 cumul:=cumul+evalue(a2_jeu(i).c);
\r
1894 call outstring(290,26,"OUEST prend",noir,gris_clair);
\r
1895 for i:=1 to 27000 do od;
\r
1896 call outstring(290,26," ",noir,gris_clair);
\r
1899 atout:=carte_ret.couleur;
\r
1902 call outstring(240,26,"OUEST ne prend pas",noir,gris_clair);
\r
1903 for i:=1 to 27000 do od;
\r
1904 call outstring(240,26," ",noir,gris_clair);
\r
1908 (* attach(user); *)
\r
1912 Unit tour2 : procedure;
\r
1915 while ((j<=4) and not(on_prend))
\r
1919 if (coul=/=carte_ret.couleur)
\r
1923 if (a2_jeu(i).c.couleur=coul)
\r
1925 cumul:=cumul+evalue(a2_jeu(i).c);
\r
1930 call outstring(290,26,"OUEST prend",noir,gris_clair);
\r
1931 for i:=1 to 17000 do od;
\r
1932 call outstring(290,26," ",noir,gris_clair);
\r
1937 call outstring(240,26,"OUEST ne prend pas",noir,gris_clair);
\r
1938 for i:=1 to 17000 do od;
\r
1939 call outstring(240,26," ",noir,gris_clair);
\r
1953 Unit donne2 : procedure;
\r
1958 a2_jeu(6).c:=carte_ret;
\r
1959 a2_jeu(6).present:=true;
\r
1962 a2_jeu(i).c:=s.pop;
\r
1963 a2_jeu(i).present:=true;
\r
1968 a2_jeu(i).c:=s.pop;
\r
1969 a2_jeu(i).present:=true;
\r
1972 belote_adversaire2:=false;
\r
1975 if a2_jeu(i).c.couleur=atout and a2_jeu(i).c.valeur=dame
\r
1979 if a2_jeu(j).c.couleur=atout and a2_jeu(j).c.valeur=roi
\r
1981 belote_adversaire2:=true;
\r
1987 fin_donne2:=fin_donne2+1;
\r
1997 Unit jouer_carte : procedure;
\r
1998 var trouve,pas_encore : boolean,
\r
1999 i,remember,forte,grand,petit,maitre : integer;
\r
2005 if cpt_pli=1 (* c'est lui qui joue en premier *)
\r
2007 if adv1_prend or adv2_prend
\r
2009 (* ils ont pris *)
\r
2010 (* adv2 joue atout si possible *)
\r
2015 if a2_jeu(i).present
\r
2017 if a2_jeu(i).c.couleur=atout and grand=0
\r
2022 if a2_jeu(i).c.couleur=atout
\r
2024 if compare_atout(p_jeu(i).c.valeur,a2_jeu(grand).c.valeur)
\r
2028 if not compare_atout(a2_jeu(i).c.valeur,a2_jeu(petit).c.valeur)
\r
2040 if a2_jeu(grand).c.valeur=maitre
\r
2046 pli(cpt_pli):=a2_jeu(remember).c;
\r
2050 while i<9 and not trouve
\r
2052 (* adv2 n'a pas d'atout, alors il joue as sinon indien *)
\r
2053 if a2_jeu(i).present
\r
2057 pli(cpt_pli):=a2_jeu(i).c;
\r
2059 pas_encore:=false;
\r
2060 if pli(cpt_pli).valeur=as
\r
2065 (* il n'a pas encore trouve d'as, et il lui reste des cartes
\r
2067 if a2_jeu(i).c.valeur=as
\r
2069 pli(cpt_pli):=a2_jeu(i).c;
\r
2073 (* si toujours pas d'as, il prend la plus petite de son jeu *)
\r
2074 if pli(cpt_pli).valeur>a2_jeu(i).c.valeur
\r
2076 pli(cpt_pli):=a2_jeu(i).c;
\r
2084 (* il joue donc la carte nø remember *)
\r
2087 a2_jeu(remember).present:=false;
\r
2090 (* Ils n'ont pas pris *)
\r
2093 while i<9 and not trouve
\r
2095 (* adv2 joue as sinon indien different d'atout *)
\r
2096 if a2_jeu(i).c.couleur<>atout
\r
2098 if a2_jeu(i).present
\r
2102 pli(cpt_pli):=a2_jeu(i).c;
\r
2104 pas_encore:=false;
\r
2105 if pli(cpt_pli).valeur=as
\r
2108 a2_jeu(remember).present:=false;
\r
2111 (* il n'a pas encore trouve d'as, et il lui reste des cartes
\r
2113 if a2_jeu(i).c.valeur=as
\r
2115 pli(cpt_pli):=a2_jeu(i).c;
\r
2117 a2_jeu(remember).present:=false;
\r
2120 (* si toujours pas d'as, il prend la plus petite carte de son jeu *)
\r
2121 if pli(cpt_pli).valeur>a2_jeu(i).c.valeur
\r
2123 pli(cpt_pli):=a2_jeu(i).c;
\r
2134 (* il ne lui reste que de l'atout *)
\r
2135 (* il est donc oblige de jouer atout *)
\r
2139 (* adv2 joue le plus petit atout *)
\r
2140 if a2_jeu(i).present
\r
2146 if not compare_atout(a2_jeu(i).c.valeur,a2_jeu(remember).c.valeur)
\r
2147 (* a2_jeu(i).c.valeur<a2_jeu(remember).c.valeur *)
\r
2156 a2_jeu(remember).present:=false;
\r
2157 pli(cpt_pli):=a2_jeu(remember).c;
\r
2159 else (* s'il ne joue pas en premier .............................. *)
\r
2161 if pli(1).couleur<>atout
\r
2164 while i<9 and not trouve
\r
2166 (* Il joue as sinon indien dans couleur demandee different d'atout *)
\r
2167 if a2_jeu(i).present and a2_jeu(i).c.couleur=pli(1).couleur
\r
2172 pas_encore:=false;
\r
2173 if a2_jeu(remember).c.valeur=as
\r
2178 (* il n'a pas encore trouve d'as, et il lui reste des cartes
\r
2180 if a2_jeu(i).c.valeur=as
\r
2185 (* si toujours pas d'as, il prend la plus petite de son jeu *)
\r
2186 if a2_jeu(remember).c.valeur>a2_jeu(i).c.valeur
\r
2197 (* il n'a pas de la couleur demandee, il essaie de jouer atout *)
\r
2201 (* adv2 joue le plus petit atout *)
\r
2202 if a2_jeu(i).present and a2_jeu(i).c.couleur=atout
\r
2208 if not compare_atout(a2_jeu(i).c.valeur,a2_jeu(remember).c.valeur)
\r
2218 (* il ne peut pas couper *)
\r
2222 (* adv2 joue sa plus petite carte *)
\r
2223 if a2_jeu(i).present
\r
2229 if a2_jeu(i).c.valeur<a2_jeu(remember).c.valeur
\r
2240 (* c'est atout demandee *)
\r
2241 (* il est oblige de monter *)
\r
2243 for i:=1 to cpt_pli
\r
2245 if pli(i).couleur=atout
\r
2247 if not compare_atout(forte,pli(i).valeur)
\r
2249 forte:=pli(i).valeur
\r
2254 while i<9 and not trouve
\r
2256 if a2_jeu(i).present and a2_jeu(i).c.couleur=atout
\r
2261 if compare_atout(a2_jeu(i).c.valeur,forte)
\r
2266 if compare_atout(a2_jeu(i).c.valeur,forte)
\r
2271 if not compare_atout(a2_jeu(i).c.valeur,a2_jeu(remember).c.valeur)
\r
2282 (* adv2 n'a pas d'atout, il joue un indien *)
\r
2286 (* adv2 joue sa plus petite carte *)
\r
2287 if a2_jeu(i).present
\r
2293 if a2_jeu(i).c.valeur<a2_jeu(remember).c.valeur
\r
2303 pli(cpt_pli):=a2_jeu(remember).c;
\r
2304 a2_jeu(remember).present:=false;
\r
2308 if a2_jeu(remember).c.couleur=atout
\r
2310 atout_joue(a2_jeu(remember).c.valeur):=true;
\r
2315 pli(cpt_pli).x:=190;
\r
2316 pli(cpt_pli).y:=170;
\r
2317 call pli(cpt_pli).print;
\r
2318 for i:=1 to 30000 do od;
\r
2348 (* *********************** fin des coroutines ************************* *)
\r
2351 (*************************************)
\r
2352 (* On coupe le jeu de cartes *)
\r
2353 (*************************************)
\r
2356 Unit COUPE_JEU : procedure;
\r
2357 var i,j : integer,
\r
2362 call RANSET(1000);
\r
2363 i:=entier(RANDOM*32);
\r
2370 call tmp1.push(s.pop);
\r
2374 call tmp2.push(s.pop);
\r
2376 while not tmp1.empty
\r
2378 call s.push(tmp1.pop);
\r
2380 while not tmp2.empty
\r
2382 call s.push(tmp2.pop);
\r
2390 (*************************************)
\r
2391 (* Melange du jeu de cartes *)
\r
2392 (*************************************)
\r
2394 Unit MELANGE : procedure;
\r
2396 tab : arrayof carte,
\r
2398 a,b,i,j,attente : integer;
\r
2401 array tab dim(0:31);
\r
2436 call RANSET(1000);
\r
2437 i:=entier(RANDOM*10);
\r
2438 for attente:=1 to 2000 do od;
\r
2439 call RANSET(1500);
\r
2440 j:=entier(RANDOM*10);
\r
2444 tab(i):=tab((i+j) mod 31);
\r
2445 tab((i+j) mod 31):=tampon;
\r
2449 tab(i):=tab((i+j) mod 31);
\r
2450 tab((i+j) mod 31):=tampon;
\r
2457 call s.push(tab(a));
\r
2462 (**************************************************)
\r
2463 (* Renvoie la valeur de l'atout le plus fort *)
\r
2464 (* qui n'a pas encore ete joue *)
\r
2465 (**************************************************)
\r
2467 Unit AT_FORT : function : integer;
\r
2469 if not atout_joue(valet)
\r
2473 if not atout_joue(neuf)
\r
2479 if not atout_joue(i)
\r
2491 (**************************************************)
\r
2492 (* Ordre de croissance des cartes a l'atout *)
\r
2493 (* --> retourne vrai si c1>c2 *)
\r
2494 (**************************************************)
\r
2496 Unit COMPARE_ATOUT : function(c1,c2 : integer): boolean;
\r
2514 (* il n'y a ni valet ni neuf *)
\r
2525 end compare_atout;
\r
2527 (**************************************************)
\r
2528 (* Attribue une valeur pour chaque carte *)
\r
2529 (**************************************************)
\r
2531 Unit EVALUE : function(c : carte): integer;
\r
2534 when sept : result:=5;
\r
2535 when huit : result:=7;
\r
2536 when dame : result:=10;
\r
2537 when roi : result:=13;
\r
2538 when dix : result:=15;
\r
2539 when as : result:=18;
\r
2540 when neuf : result:=22;
\r
2541 when valet: result:=30;
\r
2545 (**************************************************)
\r
2546 (* Attribue une valeur pour chaque carte *)
\r
2547 (**************************************************)
\r
2549 Unit EVALUE2 : function(c : carte): integer;
\r
2552 when sept : result:=4;
\r
2553 when huit : result:=4;
\r
2554 when dame : result:=6;
\r
2555 when roi : result:=6;
\r
2556 when dix : result:=10;
\r
2557 when as : result:=15;
\r
2558 when neuf : result:=15;
\r
2559 when valet: result:=25;
\r
2563 (*************************************)
\r
2564 (* Affichage du menu *)
\r
2565 (*************************************)
\r
2567 Unit PREMIER_MENU : procedure;
\r
2569 b_option:=new bouton_relief(280,140,360,180,6,"Option");
\r
2570 b_debut:=new bouton_relief(280,200,360,240,5,"Jouer");
\r
2571 b_fin:=new bouton_relief(280,260,360,300,7,"Quitter");
\r
2572 call patern(220,50,420,320,gris_clair,plein);
\r
2573 call patern(220,50,420,320,gris_fonce,vide);
\r
2574 call patern(221,51,419,51,gris_fonce,plein);
\r
2575 call patern(222,52,418,52,gris_fonce,plein);
\r
2576 call patern(221,51,221,319,gris_fonce,plein);
\r
2577 call patern(222,52,222,318,gris_fonce,plein);
\r
2578 call patern(419,51,419,319,gris_fonce,plein);
\r
2579 call patern(418,52,418,318,gris_fonce,plein);
\r
2580 call patern(221,319,419,319,gris_fonce,plein);
\r
2581 call patern(222,318,418,318,gris_fonce,plein);
\r
2583 call outstring(293,70,"M E N U",noir,gris_clair);
\r
2584 call patern(285,85,355,85,noir,plein);
\r
2585 call outstring(275,90 ,"JYL & REDGE ",noir,gris_clair);
\r
2586 call outstring(275,105," 1995 ",noir,gris_clair);
\r
2587 call b_option.print;
\r
2588 call b_debut.print;
\r
2590 call patern(0,0,640,40,gris_clair,plein);
\r
2591 (* affichage des bandes de commentaires en gris du haut *)
\r
2594 call draw(640,20);
\r
2596 call draw(640,40);
\r
2597 call outstring(270,4,"B-E-L-O-T-E",noir,gris_clair);
\r
2598 (* sauvegarde menu *)
\r
2599 call move(100,50);
\r
2600 save_menu:=getmap(540,370);
\r
2605 (*************************************)
\r
2607 (*************************************)
\r
2609 Unit MENU : procedure;
\r
2610 var h,v,p,l,r,c : integer,
\r
2613 call move(100,50);
\r
2614 call putmap(save_menu);
\r
2617 d:=getpress(h,v,p,l,r,c);
\r
2620 if b_option.dedans(h,v)
\r
2622 call b_option.choix;
\r
2625 if b_debut.dedans(h,v)
\r
2627 call b_debut.choix;
\r
2628 (* affichage des bandes de commentaires en gris du haut *)
\r
2631 call draw(640,20);
\r
2633 call draw(640,40);
\r
2634 call outstring(270,2,"B-E-L-O-T-E",noir,gris_clair);
\r
2635 call move(219,49);
\r
2636 call putmap(del_menu);
\r
2639 if b_fin.dedans(h,v)
\r
2652 (*************************************)
\r
2654 (*************************************)
\r
2656 Unit OPTION : procedure;
\r
2657 var h,v,p,l,r,c,i : integer,
\r
2658 op1,op2,op3 : bouton_enfonce,
\r
2659 valide : bouton_relief,
\r
2662 op1:=new bouton_enfonce(210,200,270,240,3,"5OO");
\r
2663 op2:=new bouton_enfonce(290,200,350,240,4,"1OOO");
\r
2664 op3:=new bouton_enfonce(370,200,430,240,4,"15OO");
\r
2665 valide:=new bouton_relief(280,255,360,295,2,"OK");
\r
2666 call patern(190,130,450,310,gris_clair,plein);
\r
2667 call patern(190,130,450,310,noir,vide);
\r
2669 call patern(191,131,449,131,blanc,plein);
\r
2670 call patern(192,132,448,132,blanc,plein);
\r
2671 call patern(191,131,191,309,blanc,plein);
\r
2672 call patern(192,132,192,308,blanc,plein);
\r
2674 call patern(449,131,449,309,gris_fonce,plein);
\r
2675 call patern(448,132,448,308,gris_fonce,plein);
\r
2676 call patern(191,309,449,309,gris_fonce,plein);
\r
2677 call patern(192,308,448,308,gris_fonce,plein);
\r
2680 call outstring(260,145,"Nombre de points",noir,gris_clair);
\r
2681 call outstring(260,165," par partie",noir,gris_clair);
\r
2685 call valide.print;
\r
2689 d:=getpress(h,v,p,l,r,c);
\r
2692 if op1.dedans(h,v)
\r
2699 if op2.dedans(h,v)
\r
2706 if op3.dedans(h,v)
\r
2713 if valide.dedans(h,v)
\r
2715 call valide.choix;
\r
2716 for i:=1 to 5000 do od;
\r
2717 call move(100,50);
\r
2718 call putmap(save_menu);
\r
2727 (*************************************)
\r
2728 (* Calcul du score pour *)
\r
2729 (* chaque equipe *)
\r
2730 (*************************************)
\r
2732 Unit CALCUL_SCORE : procedure;
\r
2733 var s1,s2,i,attente : integer,
\r
2734 dedans,capot : boolean;
\r
2739 (* prise en compte du 10 de der *)
\r
2740 if commence=1 or commence=3
\r
2747 while not(e1.empty)
\r
2749 if e1.sommet.valeur.couleur=atout and e1.sommet.valeur.valeur=valet
\r
2753 if e1.sommet.valeur.couleur=atout and e1.sommet.valeur.valeur=neuf
\r
2757 case e1.sommet.valeur.valeur
\r
2758 when dix : s1:=s1+10;
\r
2759 when valet : s1:=s1+2;
\r
2760 when dame : s1:=s1+3;
\r
2761 when roi : s1:=s1+4;
\r
2762 when as : s1:=s1+11;
\r
2766 call e11.push(e1.pop);
\r
2768 while not(e2.empty)
\r
2770 if e2.sommet.valeur.couleur=atout and e2.sommet.valeur.valeur=valet
\r
2774 if e2.sommet.valeur.couleur=atout and e2.sommet.valeur.valeur=neuf
\r
2778 case e2.sommet.valeur.valeur
\r
2779 when dix : s2:=s2+10;
\r
2780 when valet : s2:=s2+2;
\r
2781 when dame : s2:=s2+3;
\r
2782 when roi : s2:=s2+4;
\r
2783 when as : s2:=s2+11;
\r
2787 call e22.push(e2.pop);
\r
2793 score2:=score2+250;
\r
2795 call outstring(270,22,"Equipe1 est capot",noir,gris_clair);
\r
2796 for i:=1 to 40000 do od;
\r
2797 call outstring(270,22," ",noir,gris_clair);
\r
2801 score1:=score1+250;
\r
2803 call outstring(270,22,"Equipe2 est capot",noir,gris_clair);
\r
2804 for i:=1 to 40000 do od;
\r
2805 call outstring(270,22," ",noir,gris_clair);
\r
2808 if joueur_prend or part_prend
\r
2812 score2:=score2+162;
\r
2813 call outstring(255,22,"Equipe1 est dedans",noir,gris_clair);
\r
2814 for i:=1 to 40000 do od;
\r
2815 call outstring(255,22," ",noir,gris_clair);
\r
2821 score1:=score1+162;
\r
2822 call outstring(255,22,"Equipe2 est dedans",noir,gris_clair);
\r
2823 for i:=1 to 40000 do od;
\r
2824 call outstring(255,22," ",noir,gris_clair);
\r
2829 if not dedans and not capot
\r
2831 score1:=score1+s1;
\r
2832 score2:=score2+s2;
\r
2835 if belote_joueur or belote_partenaire
\r
2837 score1:=score1+20;
\r
2838 call outstring(210,25,"Equipe1 avait la belote",noir,gris_clair);
\r
2839 for attente:=1 to 30000 do od;
\r
2840 call outstring(210,25," ",noir,gris_clair);
\r
2842 if belote_adversaire1 or belote_adversaire2
\r
2844 score2:=score2+20;
\r
2845 call outstring(210,25,"Equipe2 avait la belote",noir,gris_clair);
\r
2846 for attente:=1 to 30000 do od;
\r
2847 call outstring(210,25," ",noir,gris_clair);
\r
2855 (*************************************)
\r
2856 (* mise_a_jour des plis *)
\r
2858 (*************************************)
\r
2861 Unit MAJ_PLI : procedure;
\r
2864 if commence=1 or commence=3
\r
2868 call e1.push(pli(i));
\r
2873 call e2.push(pli(i));
\r
2879 (*************************************)
\r
2880 (* Qui a fait le pli ? *)
\r
2881 (*************************************)
\r
2883 Unit EVALUE_PLI : function : integer;
\r
2885 i,gagnant : integer;
\r
2891 if pli(i).couleur=atout and pli(i).valeur=valet
\r
2899 if pli(i).couleur=atout and pli(i).valeur=neuf
\r
2908 if pli(i).couleur=atout
\r
2912 if pli(gagnant).valeur<pli(i).valeur
\r
2925 if pli(i).couleur=pli(gagnant).couleur
\r
2926 and pli(i).valeur>pli(gagnant).valeur
\r
2934 (*******************************************************)
\r
2935 (* On remet les cartes des joueurs dans le jeu *)
\r
2936 (*******************************************************)
\r
2938 Unit PERSONNE_A_PRIS : procedure;
\r
2944 call s.push(j_jeu(i).c);
\r
2948 call s.push(a1_jeu(i).c);
\r
2952 call s.push(p_jeu(i).c);
\r
2956 call s.push(a2_jeu(i).c);
\r
2958 call s.push(carte_ret);
\r
2959 end personne_a_pris;
\r
2961 (*************************************)
\r
2962 (* Affichage des atouts *)
\r
2963 (*************************************)
\r
2965 Unit affiche_atout : procedure;
\r
2968 call patern(180,395,460,460,gris_clair,plein);
\r
2969 call patern(180,395,460,395,blanc,plein);
\r
2970 call patern(181,396,459,396,blanc,plein);
\r
2971 call patern(180,395,180,460,blanc,plein);
\r
2972 call patern(181,396,181,459,blanc,plein);
\r
2974 call patern(182,397,458,397,blanc,plein);
\r
2975 call patern(182,397,182,458,blanc,plein);
\r
2976 call patern(458,397,458,458,gris_fonce,plein);
\r
2977 call patern(182,458,458,458,gris_fonce,plein);
\r
2979 call patern(180,460,460,460,gris_fonce,plein);
\r
2980 call patern(181,459,459,459,gris_fonce,plein);
\r
2981 call patern(460,395,460,460,gris_fonce,plein);
\r
2982 call patern(459,396,459,459,gris_fonce,plein);
\r
2983 call outstring(200,400," 7 ",noir,blanc);
\r
2984 call outstring(230,400," 8 ",noir,blanc);
\r
2985 call outstring(260,400," 9 ",noir,blanc);
\r
2986 call outstring(290,400," V ",noir,blanc);
\r
2987 call outstring(320,400," D ",noir,blanc);
\r
2988 call outstring(350,400," R ",noir,blanc);
\r
2989 call outstring(380,400," 10 ",noir,blanc);
\r
2990 call outstring(410,400," A ",noir,blanc);
\r
2995 call patern(200+(i-1)*30,420,200+i*30,450,gris_fonce,plein);
\r
2997 call patern(200+(i-1)*30,420,200+i*30,450,noir,vide);
\r
2999 for i:=1 to 100000 do od;
\r
3000 end affiche_atout;
\r
3002 (*************************************)
\r
3003 (* Affichage du score *)
\r
3004 (*************************************)
\r
3006 Unit AFFICHE_SCORE : procedure;
\r
3008 call outstring(500,2,"Equipe 1 :",noir,gris_clair);
\r
3009 call track(600,2,score1,gris_clair,noir);
\r
3010 call outstring(500,22,"Equipe 2 :",noir,gris_clair);
\r
3011 call track(600,22,score2,gris_clair,noir);
\r
3012 end affiche_score;
\r
3014 (*************************************)
\r
3015 (* Affichage du vainqueur *)
\r
3016 (*************************************)
\r
3018 Unit AFFICHE_VAINQUEUR : procedure;
\r
3021 h,v,p,l,r,c : integer,
\r
3022 ok : bouton_relief;
\r
3025 ok:=new bouton_relief(270,150,370,190,4,"O.K.");
\r
3027 call putmap(depart);
\r
3030 call outstring(240,22,"Vainqueur : Equipe2",noir,gris_clair);
\r
3034 call outstring(240,22,"Vainqueur : Equipe1",noir,gris_clair);
\r
3036 (* on ne sait jamais ... *)
\r
3037 call outstring(240,22," Match nul !",noir,gris_clair);
\r
3040 call affiche_score;
\r
3044 d:=getpress(h,v,p,l,r,c);
\r
3051 call putmap(depart);
\r
3058 end affiche_vainqueur;
\r
3061 (***************************************)
\r
3062 (* Affichage du tapis de cart *)
\r
3063 (***************************************)
\r
3065 Unit Affiche_tapis : procedure;
\r
3067 call patern(160,90,480,350,25,plein);
\r
3068 call patern(160,90,480,350,gris_fonce,vide);
\r
3069 call patern(161,91,479,349,gris_fonce,vide);
\r
3070 call intens(4,tx,ty,26,plein);
\r
3071 call coeur(170,95);
\r
3072 call carreau(445,290);
\r
3073 call pic(170,290);
\r
3074 call trefle(445,95);
\r
3075 end affiche_tapis;
\r
3077 (***************************************)
\r
3078 (* Initialisation de l'ecran *)
\r
3079 (***************************************)
\r
3081 Unit INIT_ECRAN : procedure;
\r
3082 var nord,est,ouest:bouton_relief;
\r
3084 nord:=new bouton_relief(280,49,360,79,4,"NORD");
\r
3085 est:=new bouton_relief(540,195,620,235,3,"EST");
\r
3086 ouest:=new bouton_relief(20,195,100,235,5,"OUEST");
\r
3087 call patern(0,0,640,40,gris_clair,plein);
\r
3088 (* affichage des bandes de commentaires en gris du haut *)
\r
3091 call draw(640,20);
\r
3093 call draw(640,40);
\r
3094 call outstring(270,2,"B-E-L-O-T-E",noir,gris_clair);
\r
3099 terrain:=getmap(640,361);
\r
3100 (* sauvegarde de l'ecran *)
\r
3102 depart:=getmap(640,480);
\r
3105 (*****************************************************)
\r
3106 (* Initialisation diverses (cartes, jeu...) *)
\r
3107 (*****************************************************)
\r
3109 Unit INITIALISATION : procedure;
\r
3112 P1:=new carte(P,sept);
\r
3113 P2:=new carte(P,huit);
\r
3114 P3:=new carte(P,neuf);
\r
3115 P4:=new carte(P,dix);
\r
3116 P5:=new carte(P,valet);
\r
3117 P6:=new carte(P,dame);
\r
3118 P7:=new carte(P,roi);
\r
3119 P8:=new carte(P,as);
\r
3120 T1:=new carte(T,sept);
\r
3121 T2:=new carte(T,huit);
\r
3122 T3:=new carte(T,neuf);
\r
3123 T4:=new carte(T,dix);
\r
3124 T5:=new carte(T,valet);
\r
3125 T6:=new carte(T,dame);
\r
3126 T7:=new carte(T,roi);
\r
3127 T8:=new carte(T,as);
\r
3128 CA1:=new carte(CA,sept);
\r
3129 CA2:=new carte(CA,huit);
\r
3130 CA3:=new carte(CA,neuf);
\r
3131 CA4:=new carte(CA,dix);
\r
3132 CA5:=new carte(CA,valet);
\r
3133 CA6:=new carte(CA,dame);
\r
3134 CA7:=new carte(CA,roi);
\r
3135 CA8:=new carte(CA,as);
\r
3136 CO1:=new carte(CO,sept);
\r
3137 CO2:=new carte(CO,huit);
\r
3138 CO3:=new carte(CO,neuf);
\r
3139 CO4:=new carte(CO,dix);
\r
3140 CO5:=new carte(CO,valet);
\r
3141 CO6:=new carte(CO,dame);
\r
3142 CO7:=new carte(CO,roi);
\r
3143 CO8:=new carte(CO,as);
\r
3149 b_aide_atout:=new bouton_relief(600,420,630,450,1,"?");
\r
3151 part:=new partenaire;
\r
3152 adv1:=new adversaire1;
\r
3153 adv2:=new adversaire2;
\r
3154 array j_jeu dim(1:8);
\r
3155 array p_jeu dim(1:8);
\r
3156 array a1_jeu dim(1:8);
\r
3157 array a2_jeu dim(1:8);
\r
3158 array pli dim(1:4);
\r
3159 array atout_joue dim(1:8);
\r
3162 j_jeu(i):=new carte_user;
\r
3163 p_jeu(i):=new carte_user;
\r
3164 a1_jeu(i):=new carte_user;
\r
3165 a2_jeu(i):=new carte_user;
\r
3166 atout_joue(i):=false;
\r
3170 pli(i):=new carte(P,SEPT);
\r
3172 array tx dim(1:4);
\r
3173 array ty dim(1:4);
\r
3183 end initialisation;
\r
3185 (*****************************************)
\r
3186 (* Initialisation des variables *)
\r
3187 (*****************************************)
\r
3189 Unit INIT_VARIABLES : procedure;
\r
3198 part:=new partenaire;
\r
3199 adv1:=new adversaire1;
\r
3200 adv2:=new adversaire2;
\r
3201 array pli dim(1:4);
\r
3204 j_jeu(i):=new carte_user;
\r
3205 p_jeu(i):=new carte_user;
\r
3206 a1_jeu(i):=new carte_user;
\r
3207 a2_jeu(i):=new carte_user;
\r
3211 pli(i):=new carte(P,SEPT);
\r
3218 j_jeu(i):=new carte_user;
\r
3219 p_jeu(i):=new carte_user;
\r
3220 a1_jeu(i):=new carte_user;
\r
3221 a2_jeu(i):=new carte_user;
\r
3225 pli(i):=new carte(P,SEPT);
\r
3229 end init_variables;
\r
3232 (******************************************************)
\r
3233 (* Distribue 5 cartes pour chaque joueur puis *)
\r
3234 (* retourne une carte *)
\r
3235 (******************************************************)
\r
3237 Unit DISTRIBUE_1 : procedure;
\r
3239 (* on desire distribuer les cartes *)
\r
3241 when 1 : attach(user);
\r
3242 when 2 : attach(adv1);
\r
3243 when 3 : attach(part);
\r
3244 when 4 : attach(adv2);
\r
3248 image:=getmap(640,480);
\r
3249 (* on retourne une carte *)
\r
3250 carte_ret:=s.pop;
\r
3253 call carte_ret.print;
\r
3256 (*********************************)
\r
3257 (* On demande qui veut prendre *)
\r
3258 (*********************************)
\r
3260 Unit QUI_PREND : procedure;
\r
3263 when 1 : attach(user);
\r
3264 when 2 : attach(adv1);
\r
3265 when 3 : attach(part);
\r
3266 when 4 : attach(adv2);
\r
3270 (*************************************************************)
\r
3271 (* On distribue les cartes restantes et on affiche l'atout *)
\r
3272 (*************************************************************)
\r
3274 Unit DISTRIBUE_2 : procedure;
\r
3276 (* on effectue la troisieme donne *)
\r
3278 when 1 : attach(user);
\r
3279 when 2 : attach(adv1);
\r
3280 when 3 : attach(part);
\r
3281 when 4 : attach(adv2);
\r
3283 (* on affiche l'atout *)
\r
3286 call outstring(2,5,"ATOUT PIC",noir,gris_clair);
\r
3288 call outstring(2,5,"ATOUT TREFLE",noir,gris_clair);
\r
3290 call outstring(2,5,"ATOUT CARREAU",noir,gris_clair);
\r
3292 call outstring(2,5,"ATOUT COEUR",noir,gris_clair);
\r
3296 call outstring(2,25,"Preneur : SUD",noir,gris_clair);
\r
3300 call outstring(2,25,"Preneur : EST",noir,gris_clair);
\r
3304 call outstring(2,25,"Preneur : NORD",noir,gris_clair);
\r
3308 call outstring(2,25,"Preneur : OUEST",noir,gris_clair);
\r
3312 (*************************************)
\r
3313 (* Ouverture mode graphique *)
\r
3314 (*************************************)
\r
3316 Unit OUVERTURE : procedure;
\r
3319 call border(bleu_clair);
\r
3323 call patern(300,300,100,100,i,plein);
\r
3324 call track(50,40,i,noir,blanc);
\r
3325 for attente:=1 to 10000 do od;
\r
3331 call move(219,49);
\r
3332 del_menu:=getmap(421,361);
\r
3333 call move(150,80);
\r
3334 image2:=getmap(500,360);
\r
3337 (*************************************)
\r
3338 (* Fermeture mode graphique *)
\r
3339 (*************************************)
\r
3341 Unit FERMETURE : procedure;
\r
3346 (******************************************************************)
\r
3347 (* debut PROGRAMME PRINCIPAL *)
\r
3348 (******************************************************************)
\r
3357 call initialisation;
\r
3359 call premier_menu;
\r
3362 call init_variables;
\r
3365 call putmap(depart);
\r
3366 call affiche_score;
\r
3368 while score1<total and score2<total
\r
3377 call outstring(270,22,"OUEST distribue...",noir,gris_clair);
\r
3379 call outstring(275,22,"SUD distribue...",noir,gris_clair);
\r
3381 call outstring(275,22,"EST distribue...",noir,gris_clair);
\r
3383 call outstring(270,22,"NORD distribue...",noir,gris_clair);
\r
3385 for attente:=1 to 30000 do od;
\r
3386 call outstring(270,22," ",noir,gris_clair);
\r
3394 call affiche_tapis;
\r
3429 (* on a effectue le premier pli *)
\r
3433 for i:=1 to 20000 do od;
\r
3435 eval:=(eval+commence-1) mod 4;
\r
3436 if eval=0 then eval:=4 fi;
\r
3439 call move(150,80);
\r
3440 call putmap(image2);
\r
3441 call affiche_tapis;
\r
3445 call outstring(240,22,"SUD remporte le pli !",noir,gris_clair);
\r
3446 for attente:=1 to 35000 do od;
\r
3447 call outstring(240,22," ",noir,gris_clair);
\r
3457 call outstring(235,22,"EST remporte le pli !",noir,gris_clair);
\r
3458 for attente:=1 to 35000 do od;
\r
3459 call outstring(235,22," ",noir,gris_clair);
\r
3469 call outstring(240,22,"NORD remporte le pli !",noir,gris_clair);
\r
3470 for attente:=1 to 35000 do od;
\r
3471 call outstring(240,22," ",noir,gris_clair);
\r
3481 call outstring(230,22,"OUEST remporte le pli !",noir,gris_clair);
\r
3482 for attente:=1 to 35000 do od;
\r
3483 call outstring(230,22," ",noir,gris_clair);
\r
3496 atout_joue(i):=false;
\r
3499 eval:=(eval+commence-1) mod 4;
\r
3500 if eval=0 then eval:=4 fi;
\r
3505 call outstring(240,22,"SUD remporte le pli !",noir,gris_clair);
\r
3506 for attente:=1 to 35000 do od;
\r
3507 call outstring(240,22," ",noir,gris_clair);
\r
3509 call outstring(235,22,"EST remporte le pli !",noir,gris_clair);
\r
3510 for attente:=1 to 35000 do od;
\r
3511 call outstring(235,22," ",noir,gris_clair);
\r
3513 call outstring(240,22,"NORD remporte le pli !",noir,gris_clair);
\r
3514 for attente:=1 to 35000 do od;
\r
3515 call outstring(240,22," ",noir,gris_clair);
\r
3517 call outstring(230,22,"OUEST remporte le pli !",noir,gris_clair);
\r
3518 for attente:=1 to 35000 do od;
\r
3519 call outstring(230,22," ",noir,gris_clair);
\r
3521 call calcul_score;
\r
3522 (* on remet tous les plis dans le jeu s *)
\r
3523 while not(e11.empty)
\r
3525 call s.push(e11.pop);
\r
3527 while not(e22.empty)
\r
3529 call s.push(e22.pop);
\r
3533 joueur_prend:=false;
\r
3534 adv1_prend:=false;
\r
3535 part_prend:=false;
\r
3536 adv2_prend:=false;
\r
3538 call personne_a_pris;
\r
3541 part:=new partenaire;
\r
3542 adv1:=new adversaire1;
\r
3543 adv2:=new adversaire2;
\r
3545 call putmap(depart);
\r
3546 call affiche_score;
\r
3550 call affiche_vainqueur;
\r
3554 end; (* IIUWgraph*)
\r