examples/grazyna.xmp/belote.log

   1 program belote;\r
   2 \r
   3 (* \r
   4    ************************************************************************\r
   5    *                                                                      *\r
   6    *      TP LI1 : Mai 1995                                               *\r
   7    *                                                                      *\r
   8    *     Co-auteurs :   R\82gis BRETTE                                      *\r
   9    *                    Jean-Yves LAGARDE                                 * \r
  10    *                                                                      *\r
  11    *                   SUJET : A partir du langage LOGLAN, r\82aliser       *\r
  12    *                           une application utilisant les coroutines.  *\r
  13    *                                                                      *\r
  14    *                 MACHINE : DOS 386, Systeme LOGLAN-82                 *\r
  15    *                           Version de classe graphisme : IIUWgraph    *\r
  16    *                           Ecran : 640 X 480                          *                 \r
  17    *                                                                      *\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
  21    *                                                                      *\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
  24    *                                                                      *\r
  25    *                                                                      * \r
  26    *                                                                      * \r
  27    *                                                                      *\r
  28    *                                                                      *\r
  29    ************************************************************************\r
  30 \r
  31 *)\r
  32 \r
  33 \r
  34 CONST\r
  35    noir          =0,\r
  36    bleu          =1,\r
  37    vert          =2,\r
  38    cyan          =3,\r
  39    rouge         =4,\r
  40    magenta       =5,\r
  41    marron        =6,\r
  42    gris_clair    =7,\r
  43    gris_fonce    =8,\r
  44    bleu_clair    =9,\r
  45    vert_clair    =10,\r
  46    cyan_clair    =11,\r
  47    rouge_clair   =12,\r
  48    magenta_clair =13,\r
  49    jaune         =14,\r
  50    blanc         =15,\r
  51    vide          =0,\r
  52    plein         =1,\r
  53   \r
  54   larg_caract = 8,\r
  55   haut_caract = 8,\r
  56 \r
  57   nb_pli = 8,\r
  58   defaut = 500,\r
  59 \r
  60   sept  = 1,\r
  61   huit  = 2,\r
  62   neuf  = 3,\r
  63   valet = 4,\r
  64   dame  = 5,\r
  65   roi   = 6,\r
  66   dix   = 7,\r
  67   as    = 8,\r
  68 \r
  69   P     = 1,\r
  70   T     = 2,\r
  71   CA    = 3,\r
  72   CO    = 4;\r
  73 \r
  74 Begin    \r
  75 Pref iiuwgraph block     (* fonctions graphiques *)\r
  76 Begin\r
  77 Pref mouse block        (* souris *)\r
  78 \r
  79  var \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
  88     nom                                               : string,                                 \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
  97     user                                              : joueur,\r
  98     part                                              : partenaire,\r
  99     adv1                                              : adversaire1,\r
 100     adv2                                              : adversaire2,\r
 101     ca_u                                              : carte_user,\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
 107 \r
 108         (*************************************)\r
 109         (*        Bouton en relief           *) \r
 110         (*************************************) \r
 111 \r
 112 Unit BOUTON_RELIEF :  class (x1,y1,x2,y2,nb_car:integer,titre:string);\r
 113 var selectionne : boolean;  \r
 114 \r
 115   Unit print : procedure;\r
 116   begin\r
 117    if not selectionne \r
 118    then\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
 132    else\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
 142    fi ;\r
 143   end print;\r
 144 \r
 145   Unit choix : procedure ;\r
 146   var pause : integer;\r
 147   begin\r
 148    selectionne:=TRUE;\r
 149    call print;\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
 153    call print;\r
 154   end choix; \r
 155 \r
 156   Unit dedans : function(h,v :integer):boolean;\r
 157   begin\r
 158    result := (v>y1 and v<y2 and h>x1 and h<x2);\r
 159   end dedans ;\r
 160 \r
 161 \r
 162 begin \r
 163 (* On initialise le bouton_relief \85 faux *)\r
 164 selectionne:=FALSE;\r
 165 \r
 166 end BOUTON_RELIEF;\r
 167 \r
 168 \r
 169 \r
 170         (*************************************)\r
 171         (*        Bouton en relief 2         *) \r
 172         (*************************************) \r
 173 \r
 174 Unit BOUTON_ENFONCE :  class (x1,y1,x2,y2,nb_car:integer,titre:string);\r
 175 \r
 176   Unit print : procedure;\r
 177   begin\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
 190   end print;\r
 191 \r
 192   Unit choix : procedure ;\r
 193   begin\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
 202   end choix; \r
 203 \r
 204   Unit dedans : function(h,v :integer):boolean;\r
 205   begin\r
 206    result := (v>y1 and v<y2 and h>x1 and h<x2);\r
 207   end dedans ;\r
 208 \r
 209 end bouton_enfonce;\r
 210 \r
 211 (********************************************************************)\r
 212             (****************************************)\r
 213             (*       Representation des cartes      *)\r
 214             (****************************************)\r
 215 \r
 216  Unit sept_print : procedure(x,y:integer,couleur:integer);\r
 217  begin\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
 222 \r
 223  end sept_print;\r
 224 \r
 225  Unit huit_print : procedure(x,y:integer,couleur:integer);\r
 226  begin\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
 231 \r
 232  end huit_print;\r
 233 \r
 234  Unit neuf_print : procedure(x,y:integer,couleur:integer);\r
 235  begin\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
 240 \r
 241  end neuf_print;\r
 242 \r
 243  Unit dix_print : procedure(x,y:integer,couleur:integer);\r
 244  begin\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
 249 \r
 250  end dix_print;\r
 251 \r
 252  Unit valet_print : procedure(x,y:integer,couleur:integer);\r
 253  begin\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
 258 \r
 259  end valet_print;\r
 260 \r
 261  Unit dame_print : procedure(x,y:integer,couleur:integer);\r
 262  begin\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
 267 \r
 268  end dame_print;\r
 269 \r
 270  Unit roi_print : procedure(x,y:integer,couleur:integer);\r
 271  begin\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
 276 \r
 277  end roi_print;\r
 278 \r
 279  Unit as_print : procedure(x,y:integer,couleur:integer);\r
 280  begin\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
 285 \r
 286  end as_print;\r
 287 \r
 288 \r
 289 \r
 290  Unit pic : procedure(x,y : integer);\r
 291  var tabx,taby : arrayof integer; \r
 292  begin\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
 305  end pic;\r
 306 \r
 307  Unit trefle : procedure(x,y : integer);\r
 308  var tabx,taby : arrayof integer;  \r
 309  begin\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
 319  end trefle;\r
 320 \r
 321  Unit carreau : procedure(x,y : integer);\r
 322  var tabx,taby : arrayof integer;  \r
 323  begin\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
 331  end carreau;\r
 332 \r
 333  Unit coeur : procedure(x,y : integer);\r
 334  var tabx,taby : arrayof integer; \r
 335  begin\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
 345  \r
 346  end coeur;\r
 347 \r
 348                 (******************************************)\r
 349                 (*          Creation des cartes           *)\r
 350                 (******************************************)\r
 351 \r
 352  Unit carte : class(couleur,valeur:integer);\r
 353 \r
 354   Unit dedans :function(h,v : integer):boolean;\r
 355   begin\r
 356    result := (v>y and v<y+100 and h>x and h<x+50);\r
 357   end dedans ;\r
 358 \r
 359   Unit print : procedure;\r
 360   var tmp : integer;\r
 361    begin\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
 364    case couleur\r
 365     when P : call pic(x+15,y+30);\r
 366              tmp:=noir;\r
 367     when T : call trefle(x+15,y+30);\r
 368              tmp:=noir;\r
 369     when CA : call carreau(x+15,y+30);\r
 370               tmp:=rouge;\r
 371     when CO : call coeur(x+15,y+30);\r
 372               tmp:=rouge;\r
 373    esac;\r
 374    case valeur\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
 383 \r
 384    esac;\r
 385   end print;\r
 386 \r
 387   Unit efface : procedure;\r
 388    begin\r
 389    call patern(x-1,y-1,x+51,y+101,bleu,plein);\r
 390   end efface;\r
 391 \r
 392  var\r
 393    x,y:integer;\r
 394  begin\r
 395   x:=0;\r
 396   y:=0;\r
 397  end carte;\r
 398         \r
 399  Unit CARTE_USER : class;\r
 400  var       c : carte,\r
 401      present : boolean;\r
 402  begin\r
 403    c:=new carte(P,sept);\r
 404    present:=FALSE;\r
 405  end carte_user; \r
 406 \r
 407 \r
 408         (*************************************)\r
 409         (*     Implementation d'une pile     *) \r
 410         (*             de cartes             *)\r
 411         (*************************************) \r
 412 \r
 413 \r
 414 Unit PILE:class;\r
 415   unit elem:class (valeur:carte,suivant:elem);\r
 416   end elem;\r
 417   var sommet:elem;\r
 418       \r
 419   unit empty:function:boolean;\r
 420   begin\r
 421     if sommet=none\r
 422     then result:=true;\r
 423     else result:=false;\r
 424     fi;\r
 425   end empty;\r
 426 \r
 427   unit push:procedure(c:carte);\r
 428   begin\r
 429     sommet:=new elem(c,sommet);\r
 430   end push;\r
 431 \r
 432   unit pop:function:carte;\r
 433   begin\r
 434     if sommet=/=none\r
 435     then \r
 436       result:=sommet.valeur;\r
 437       sommet:=sommet.suivant;\r
 438     fi;\r
 439   end pop;\r
 440 end PILE;\r
 441 \r
 442 (*********************************************************************)\r
 443 \r
 444         (*************************************)\r
 445         (*     Creation des 4 coroutines     *) \r
 446         (*************************************) \r
 447 \r
 448 \r
 449 Unit joueur : coroutine;\r
 450 var i,n,abscisse,ordonnee:integer;\r
 451 \r
 452  Unit donne1 : procedure;   \r
 453  begin \r
 454   call patern(0,362,640,480,bleu,plein);\r
 455   call b_aide_atout.print;\r
 456   abscisse:=100;\r
 457   ordonnee:=370;\r
 458   for i:=1 to 2\r
 459    do\r
 460      j_jeu(i).c:=s.pop;\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
 466    od;\r
 467   attach(adv1);\r
 468   for i:=1 to 7000 do od;\r
 469   for i:=3 to 5\r
 470    do\r
 471      j_jeu(i).c:=s.pop;\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
 477    od;\r
 478    for i:=1 to 7000 do od;\r
 479    fin_donne1:=fin_donne1+1;\r
 480    attach(adv1);\r
 481    if fin_donne1=4\r
 482    then\r
 483     fin_donne1:=0;\r
 484     attach(main);\r
 485    fi;\r
 486  end donne1;\r
 487 \r
 488  Unit tour1 : procedure;\r
 489  begin\r
 490    on_prend:=false;\r
 491    joueur_prend:=false;\r
 492    do\r
 493      dede:=getpress(he,ve,pe,le,re,ce);\r
 494      case (ce)\r
 495       when 1 :  \r
 496          if (oui.dedans(he,ve))\r
 497           then\r
 498             call oui.choix;\r
 499             on_prend:=true;\r
 500             atout:=carte_ret.couleur;\r
 501             joueur_prend:=true;\r
 502             call move(0,0);\r
 503             call putmap(image);\r
 504             call move(0,41);\r
 505             call putmap(terrain);\r
 506             attach(main);\r
 507             exit;\r
 508          fi;\r
 509          if (non.dedans(he,ve))\r
 510           then\r
 511             call non.choix;\r
 512             call move(0,0);\r
 513             call putmap(image);\r
 514             call move(0,41);\r
 515             call putmap(terrain);\r
 516             call carte_ret.print;\r
 517             attach(adv1);\r
 518             exit;  \r
 519          fi;\r
 520        esac\r
 521    od;\r
 522    \r
 523    end tour1;\r
 524 \r
 525  Unit tour2 : procedure;\r
 526  begin\r
 527    dede:=false;\r
 528    do\r
 529      dede:=getpress(he,ve,pe,le,re,ce);\r
 530      case (ce)\r
 531       when 1 :  \r
 532          if (b_pic.dedans(he,ve))\r
 533           then\r
 534             call b_pic.choix;\r
 535             on_prend:=true;\r
 536             joueur_prend:=true;\r
 537             atout:=P;\r
 538             call move(0,0);\r
 539             call putmap(image);\r
 540             call move(0,41);\r
 541             call putmap(terrain);\r
 542             attach(main);\r
 543             exit;\r
 544          fi;\r
 545          if (b_trefle.dedans(he,ve))\r
 546           then\r
 547             call b_trefle.choix;\r
 548             on_prend:=true;\r
 549             joueur_prend:=true;\r
 550             atout:=T;\r
 551             call move(0,0);\r
 552             call putmap(image);\r
 553             call move(0,41);\r
 554             call putmap(terrain);\r
 555             attach(main);\r
 556             exit;\r
 557          fi;\r
 558          if (b_carreau.dedans(he,ve))\r
 559           then\r
 560             call b_carreau.choix;\r
 561             on_prend:=true;\r
 562             joueur_prend:=true;\r
 563             atout:=CA;\r
 564             call move(0,0);\r
 565             call putmap(image);\r
 566             call move(0,41);\r
 567             call putmap(terrain);\r
 568             attach(main);\r
 569             exit;\r
 570          fi;\r
 571          if (b_coeur.dedans(he,ve))\r
 572           then\r
 573             call b_coeur.choix;\r
 574             on_prend:=true;\r
 575             joueur_prend:=true;\r
 576             atout:=CO;\r
 577             call move(0,0);\r
 578             call putmap(image);\r
 579             call move(0,41);\r
 580             call putmap(terrain);\r
 581             attach(main);\r
 582             exit;\r
 583          fi;\r
 584 \r
 585          if (rien.dedans(he,ve))\r
 586           then\r
 587             call rien.choix;\r
 588             call move(0,0);\r
 589             call putmap(image);\r
 590             call move(0,41);\r
 591             call putmap(terrain);\r
 592             call carte_ret.print;\r
 593             attach(adv1);\r
 594             exit;  \r
 595          fi;\r
 596        esac\r
 597    od;\r
 598  end tour2;\r
 599 \r
 600  Unit donne2 : procedure;\r
 601  var i,j,abscisse,ordonnee : integer;\r
 602  begin\r
 603    call move(0,0);\r
 604    call putmap(image);\r
 605    abscisse:=375;\r
 606    ordonnee:=370;\r
 607    if joueur_prend\r
 608     then\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
 616  \r
 617       for j:=1 to 7000 do od;\r
 618       for i:=7 to 8\r
 619        do\r
 620          j_jeu(i).c:=s.pop;\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
 626        od;\r
 627     else   \r
 628       for j:=1 to 7000 do od;\r
 629       for i:=6 to 8\r
 630        do\r
 631          j_jeu(i).c:=s.pop;\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
 637        od;\r
 638    fi;  \r
 639    (* belote ou non ? *)\r
 640    belote_joueur:=false;\r
 641    for i:=1 to 8\r
 642    do\r
 643     if j_jeu(i).c.couleur=atout and j_jeu(i).c.valeur=dame\r
 644     then\r
 645      for j:=1 to 8\r
 646      do\r
 647       if j_jeu(j).c.couleur=atout and j_jeu(j).c.valeur=roi\r
 648       then\r
 649        belote_joueur:=true;\r
 650       fi;\r
 651      od;\r
 652     fi;\r
 653    od;\r
 654    fin_donne2:=fin_donne2+1;\r
 655    attach(adv1);\r
 656    if fin_donne2=4\r
 657    then\r
 658     fin_donne2:=0;\r
 659     attach(main);\r
 660    fi;\r
 661    \r
 662 end donne2;\r
 663 \r
 664 Unit jouer_carte : procedure;\r
 665 var\r
 666  dede              : boolean,\r
 667  he,ve,pe,le,re,ce : integer;\r
 668 begin\r
 669   dede:=false;\r
 670   \r
 671    do\r
 672      dede:=getpress(he,ve,pe,le,re,ce);\r
 673      case (ce)\r
 674       when 1 :  \r
 675          if b_aide_atout.dedans(he,ve)\r
 676          then\r
 677           call b_aide_atout.choix;\r
 678           call move(0,0);\r
 679           save_joueur:=getmap(640,480);\r
 680           call affiche_atout;\r
 681           call move(0,0);\r
 682           call putmap(save_joueur);\r
 683          fi;\r
 684          if (j_jeu(1).c.dedans(he,ve))\r
 685          then\r
 686           if j_jeu(1).present\r
 687           then\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
 692            then\r
 693             atout_joue(j_jeu(1).c.valeur):=true;\r
 694            fi;\r
 695            call j_jeu(1).c.efface;\r
 696            exit;\r
 697           fi;\r
 698          fi;\r
 699          if (j_jeu(2).c.dedans(he,ve))\r
 700          then\r
 701           if j_jeu(2).present\r
 702           then\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
 707            then\r
 708             atout_joue(j_jeu(2).c.valeur):=true;\r
 709            fi;\r
 710            call j_jeu(2).c.efface;\r
 711            exit;\r
 712           fi;\r
 713          fi;\r
 714          if (j_jeu(3).c.dedans(he,ve))\r
 715          then\r
 716           if j_jeu(3).present\r
 717           then\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
 722            then\r
 723             atout_joue(j_jeu(3).c.valeur):=true;\r
 724            fi;\r
 725            call j_jeu(3).c.efface;\r
 726            exit;\r
 727           fi;\r
 728          fi;\r
 729          if (j_jeu(4).c.dedans(he,ve))\r
 730          then\r
 731           if j_jeu(4).present\r
 732           then\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
 737            then\r
 738             atout_joue(j_jeu(4).c.valeur):=true;\r
 739            fi;\r
 740            call j_jeu(4).c.efface;\r
 741            exit;\r
 742           fi;\r
 743          fi;\r
 744          if (j_jeu(5).c.dedans(he,ve))\r
 745          then\r
 746           if j_jeu(5).present\r
 747           then\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
 752            then\r
 753             atout_joue(j_jeu(5).c.valeur):=true;\r
 754            fi;\r
 755            call j_jeu(5).c.efface;\r
 756            exit;\r
 757           fi;\r
 758          fi;\r
 759          if (j_jeu(6).c.dedans(he,ve))\r
 760          then\r
 761           if j_jeu(6).present\r
 762           then\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
 767            then\r
 768             atout_joue(j_jeu(6).c.valeur):=true;\r
 769            fi;\r
 770            call j_jeu(6).c.efface;\r
 771            exit;\r
 772           fi;\r
 773          fi;\r
 774          if (j_jeu(7).c.dedans(he,ve))\r
 775          then\r
 776           if j_jeu(7).present\r
 777           then\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
 782            then\r
 783             atout_joue(j_jeu(7).c.valeur):=true;\r
 784            fi;\r
 785            call j_jeu(7).c.efface;\r
 786            exit;\r
 787           fi;\r
 788          fi;\r
 789          if (j_jeu(8).c.dedans(he,ve))\r
 790          then\r
 791           if j_jeu(8).present\r
 792           then\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
 797            then\r
 798             atout_joue(j_jeu(8).c.valeur):=true;\r
 799            fi;\r
 800            call j_jeu(8).c.efface;\r
 801            exit;\r
 802           fi;\r
 803          fi;\r
 804       esac;\r
 805    od;\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
 810 \r
 811   \r
 812 end jouer_carte;\r
 813 \r
 814 begin\r
 815   return;\r
 816 \r
 817    call donne1;\r
 818    if not(on_prend)\r
 819    then\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
 825     call oui.print;\r
 826     call non.print;\r
 827     call tour1;\r
 828    fi;\r
 829 (* 2ieme tour *)      \r
 830    if not(on_prend)\r
 831    then\r
 832     call move(0,0);\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
 840     call carre.print;\r
 841     call outstring(235,60,"choisissez une couleur ?",noir,gris_clair);\r
 842     call b_pic.print;\r
 843     call b_trefle.print;\r
 844     call b_carreau.print;\r
 845     call b_coeur.print;\r
 846     call rien.print;\r
 847     call tour2;\r
 848    fi;\r
 849    if on_prend   \r
 850    then\r
 851     call donne2;\r
 852     for n:=1 to 8\r
 853     do\r
 854      call jouer_carte;\r
 855      attach(main);\r
 856     od;\r
 857    fi;\r
 858 \r
 859   attach(main);\r
 860 end joueur;\r
 861 \r
 862 \r
 863 \r
 864 \r
 865 Unit adversaire1 : coroutine;\r
 866 var  i,j,n,cumul,attente : integer;\r
 867 \r
 868  Unit donne1 : procedure;\r
 869  begin\r
 870   for i:=1 to 2\r
 871    do\r
 872      a1_jeu(i).c:=s.pop;\r
 873      a1_jeu(i).present:=true;\r
 874    od;\r
 875   attach(part);\r
 876   for i:=1 to 7000 do od;\r
 877   for i:=3 to 5\r
 878    do\r
 879      a1_jeu(i).c:=s.pop;\r
 880      a1_jeu(i).present:=true;\r
 881    od;\r
 882    fin_donne1:=fin_donne1+1;\r
 883    attach(part);\r
 884    if fin_donne1=4\r
 885    then\r
 886     fin_donne1:=0;\r
 887     attach(main);\r
 888    fi;\r
 889  \r
 890  end donne1;\r
 891 \r
 892  Unit tour1 : procedure;\r
 893  begin\r
 894    on_prend:=false;\r
 895    adv1_prend:=false;\r
 896  (* peut-il prendre ? *)  \r
 897    cumul:=evalue(carte_ret);\r
 898    for i:=1 to 5\r
 899    do\r
 900     if (a1_jeu(i).c.couleur=carte_ret.couleur)\r
 901     then\r
 902      cumul:=cumul+evalue(a1_jeu(i).c);\r
 903     fi;\r
 904    od;\r
 905    if (cumul>=50) \r
 906    then\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
 910     adv1_prend:=true;\r
 911     on_prend:=true;\r
 912     atout:=carte_ret.couleur;\r
 913     attach(main);\r
 914    else\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
 918     attach(part);\r
 919    fi;\r
 920 \r
 921  end tour1;\r
 922 \r
 923  Unit tour2 : procedure;\r
 924  begin\r
 925   j:=1;\r
 926   while ((j<=4) and not(on_prend))\r
 927   do\r
 928    coul:=j;\r
 929    cumul:=0;\r
 930    if (coul=/=carte_ret.couleur)\r
 931    then\r
 932     for i:=1 to 5\r
 933     do\r
 934      if (a1_jeu(i).c.couleur=coul)\r
 935      then\r
 936       cumul:=cumul+evalue(a1_jeu(i).c);\r
 937      fi;\r
 938     od;\r
 939     if (cumul>=50) \r
 940     then\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
 944      adv1_prend:=true;\r
 945      on_prend:=true;\r
 946      atout:=coul;\r
 947     else\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
 951     fi;\r
 952    fi;\r
 953    j:=j+1;\r
 954   od;\r
 955   if adv1_prend\r
 956   then\r
 957    attach(main);\r
 958   else\r
 959    attach(part);\r
 960   fi;\r
 961 \r
 962 end tour2;\r
 963 \r
 964  Unit donne2 : procedure;\r
 965  var i : integer;\r
 966  begin\r
 967    if adv1_prend\r
 968     then\r
 969       a1_jeu(6).c:=carte_ret;  \r
 970       a1_jeu(6).present:=true;\r
 971       for i:=7 to 8\r
 972        do\r
 973          a1_jeu(i).c:=s.pop;\r
 974          a1_jeu(i).present:=true;\r
 975        od;\r
 976     else   \r
 977       for i:=6 to 8\r
 978        do\r
 979          a1_jeu(i).c:=s.pop;\r
 980          a1_jeu(i).present:=true;\r
 981        od;\r
 982    fi;  \r
 983    (* belote ou non ? *)\r
 984    belote_adversaire1:=false;\r
 985    for i:=1 to 8\r
 986    do\r
 987     if a1_jeu(i).c.couleur=atout and a1_jeu(i).c.valeur=dame\r
 988     then\r
 989      for j:=1 to 8\r
 990      do\r
 991       if a1_jeu(j).c.couleur=atout and a1_jeu(j).c.valeur=roi\r
 992       then\r
 993        belote_adversaire1:=true;\r
 994       fi;\r
 995      od;\r
 996     fi;\r
 997    od;\r
 998 \r
 999    fin_donne2:=fin_donne2+1;\r
1000    attach(part);\r
1001    if fin_donne2=4\r
1002    then\r
1003     fin_donne2:=0;\r
1004     attach(main);\r
1005    fi;\r
1006 \r
1007 end donne2;\r
1008 \r
1009 \r
1010 Unit jouer_carte : procedure;\r
1011 var trouve,pas_encore : boolean,\r
1012     i,remember,forte  : integer;\r
1013 \r
1014 begin\r
1015  i:=1;\r
1016  remember:=0;\r
1017  trouve:=false;    \r
1018  if cpt_pli=1        (* c'est lui qui joue en premier *)\r
1019  then\r
1020   if adv1_prend or adv2_prend\r
1021   then\r
1022    (* ils ont pris *)\r
1023    (* adv1 joue atout si possible *)\r
1024    while i<9 and not trouve\r
1025    do\r
1026     if a1_jeu(i).c.couleur=atout and a1_jeu(i).present\r
1027     then \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
1031      trouve:=true;\r
1032     fi;\r
1033     i:=i+1;\r
1034    od;\r
1035    i:=1;\r
1036    pas_encore:=true;\r
1037    while i<9 and not trouve\r
1038    do\r
1039     (* adv1 n'a pas d'atout, alors il joue as sinon indien *)\r
1040     if a1_jeu(i).present\r
1041     then\r
1042      if pas_encore\r
1043      then\r
1044       pli(cpt_pli):=a1_jeu(i).c;\r
1045       remember:=i;\r
1046       pas_encore:=false;\r
1047       if pli(cpt_pli).valeur=as\r
1048       then \r
1049        trouve:=true;\r
1050       fi;\r
1051      else\r
1052       (* il n'a pas encore trouve d'as, et il lui reste des cartes\r
1053          a comparer *)\r
1054       if a1_jeu(i).c.valeur=as\r
1055       then\r
1056        pli(cpt_pli):=a1_jeu(i).c;\r
1057        remember:=i;\r
1058        trouve:=true;\r
1059       else\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
1062        then\r
1063         pli(cpt_pli):=a1_jeu(i).c;\r
1064         remember:=i;\r
1065        fi;\r
1066       fi;\r
1067      fi;\r
1068     fi;\r
1069     i:=i+1;\r
1070    od;\r
1071    (* il joue donc la carte nø remember *)\r
1072    if remember<>0\r
1073    then\r
1074     a1_jeu(remember).present:=false;\r
1075     if a1_jeu(remember).c.couleur=atout\r
1076     then\r
1077      atout_joue(a1_jeu(remember).c.valeur):=true;\r
1078     fi;\r
1079    fi;\r
1080   else\r
1081    (* Ils n'ont pas pris *)\r
1082    i:=1;\r
1083    pas_encore:=true;\r
1084    while i<9 and not trouve\r
1085    do\r
1086     (* adv1 joue as sinon indien different d'atout *)\r
1087     if a1_jeu(i).c.couleur<>atout\r
1088     then\r
1089      if a1_jeu(i).present\r
1090      then\r
1091       if pas_encore\r
1092       then\r
1093        pli(cpt_pli):=a1_jeu(i).c;\r
1094        remember:=i;\r
1095        pas_encore:=false;\r
1096        if pli(cpt_pli).valeur=as\r
1097        then \r
1098         trouve:=true;\r
1099         a1_jeu(remember).present:=false;\r
1100         if a1_jeu(remember).c.couleur=atout\r
1101         then\r
1102          atout_joue(a1_jeu(remember).c.valeur):=true;\r
1103         fi;\r
1104        fi;\r
1105       else\r
1106        (* il n'a pas encore trouve d'as, et il lui reste des cartes\r
1107           a comparer *)\r
1108        if a1_jeu(i).c.valeur=as\r
1109        then\r
1110         pli(cpt_pli):=a1_jeu(i).c;\r
1111         remember:=i;\r
1112         a1_jeu(remember).present:=false;\r
1113         if a1_jeu(remember).c.couleur=atout\r
1114         then\r
1115          atout_joue(a1_jeu(remember).c.valeur):=true;\r
1116         fi;\r
1117         trouve:=true;\r
1118        else\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
1121         then\r
1122          pli(cpt_pli):=a1_jeu(i).c;\r
1123          remember:=i;\r
1124         fi;\r
1125        fi;\r
1126       fi;\r
1127      fi;\r
1128     fi;\r
1129     i:=i+1;\r
1130    od;\r
1131    if remember=0\r
1132    then\r
1133     (* il ne lui reste que de l'atout *)\r
1134     (* il est donc oblige de jouer atout *)\r
1135     i:=1;\r
1136     while i<9\r
1137     do\r
1138      (* adv1 joue le plus petit atout *)\r
1139      if a1_jeu(i).present\r
1140      then\r
1141       if remember=0\r
1142       then\r
1143        remember:=i;\r
1144       else\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
1147        then\r
1148         remember:=i;\r
1149        fi;\r
1150       fi;\r
1151      fi;\r
1152      i:=i+1;\r
1153     od;\r
1154    fi;\r
1155    a1_jeu(remember).present:=false;\r
1156    if a1_jeu(remember).c.couleur=atout\r
1157    then\r
1158     atout_joue(a1_jeu(remember).c.valeur):=true;\r
1159    fi;\r
1160    pli(cpt_pli):=a1_jeu(remember).c;\r
1161   fi;\r
1162  else    (* s'il ne joue pas en premier .............................. *)     \r
1163   i:=1;\r
1164   if pli(1).couleur<>atout\r
1165   then\r
1166    pas_encore:=true;\r
1167    while i<9 and not trouve\r
1168    do\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
1171     then\r
1172      if pas_encore\r
1173      then\r
1174       remember:=i;\r
1175       pas_encore:=false;\r
1176       if a1_jeu(remember).c.valeur=as\r
1177       then \r
1178        trouve:=true;\r
1179       fi;\r
1180      else\r
1181       (* il n'a pas encore trouve d'as, et il lui reste des cartes\r
1182         a comparer *)\r
1183       if a1_jeu(i).c.valeur=as\r
1184       then\r
1185        remember:=i;\r
1186        trouve:=true;\r
1187       else\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
1190        then\r
1191         remember:=i;\r
1192        fi;\r
1193       fi;\r
1194      fi;\r
1195     fi;\r
1196     i:=i+1;\r
1197    od;\r
1198    if remember=0\r
1199    then\r
1200     (* il n'a pas de la couleur demandee, il essaie de jouer atout *)\r
1201     i:=1;\r
1202     while i<9\r
1203     do\r
1204      (* adv1 joue le plus petit atout *)\r
1205      if a1_jeu(i).present and a1_jeu(i).c.couleur=atout\r
1206      then\r
1207       if remember=0\r
1208       then\r
1209        remember:=i;\r
1210       else\r
1211        if not compare_atout(a1_jeu(i).c.valeur,a1_jeu(remember).c.valeur)\r
1212        then\r
1213         remember:=i;\r
1214        fi;\r
1215       fi;\r
1216      fi;\r
1217      i:=i+1;\r
1218     od;\r
1219     if remember=0\r
1220     then\r
1221      (* il ne peut pas couper *)\r
1222      i:=1;\r
1223      while i<9\r
1224      do\r
1225       (* adv1 joue sa plus petite carte *)\r
1226       if a1_jeu(i).present \r
1227       then\r
1228        if remember=0\r
1229        then\r
1230         remember:=i;\r
1231        else\r
1232         if a1_jeu(i).c.valeur<a1_jeu(remember).c.valeur\r
1233         then\r
1234          remember:=i;\r
1235         fi;\r
1236        fi;\r
1237       fi;\r
1238       i:=i+1;\r
1239      od;\r
1240     fi;\r
1241    fi;\r
1242   else \r
1243    (* c'est atout demandee *)\r
1244    (* il est oblige de monter *)\r
1245    forte:=0;\r
1246    for i:=1 to cpt_pli\r
1247    do\r
1248     if pli(i).couleur=atout\r
1249     then\r
1250      if not compare_atout(forte,pli(i).valeur)\r
1251      then \r
1252       forte:=pli(i).valeur\r
1253      fi;\r
1254     fi;\r
1255    od;\r
1256    i:=1;\r
1257    while i<9 and not trouve\r
1258    do\r
1259     if a1_jeu(i).present and a1_jeu(i).c.couleur=atout\r
1260     then\r
1261      if remember=0\r
1262      then\r
1263       remember:=i;\r
1264       if compare_atout(a1_jeu(i).c.valeur,forte)\r
1265       then \r
1266        trouve:=true;\r
1267       fi;\r
1268      else\r
1269       if compare_atout(a1_jeu(i).c.valeur,forte)\r
1270       then\r
1271        remember:=i;\r
1272        trouve:=true;\r
1273       else\r
1274        if not compare_atout(a1_jeu(i).c.valeur,a1_jeu(remember).c.valeur)\r
1275        then\r
1276         remember:=i;\r
1277        fi;\r
1278       fi;\r
1279      fi;\r
1280     fi;\r
1281     i:=i+1;\r
1282    od;\r
1283    if remember=0\r
1284    then\r
1285     (* adv1 n'a pas d'atout, il joue un indien *)\r
1286     i:=1;\r
1287     while i<9\r
1288     do\r
1289      (* adv1 joue sa plus petite carte *)\r
1290      if a1_jeu(i).present \r
1291      then\r
1292       if remember=0\r
1293       then\r
1294        remember:=i;\r
1295       else\r
1296        if a1_jeu(i).c.valeur<a1_jeu(remember).c.valeur\r
1297        then\r
1298         remember:=i;\r
1299        fi;\r
1300       fi;\r
1301      fi;\r
1302      i:=i+1;\r
1303     od;\r
1304    fi;\r
1305   fi;\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
1309   then\r
1310    atout_joue(a1_jeu(remember).c.valeur):=true;\r
1311   fi;\r
1312  fi;\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
1317  \r
1318 end jouer_carte;\r
1319 \r
1320 \r
1321 begin\r
1322   return;\r
1323 \r
1324   call donne1;\r
1325    if not(on_prend)\r
1326    then\r
1327        call tour1;\r
1328    fi;\r
1329 (* 2ieme tour *)      \r
1330    if not(on_prend)\r
1331    then\r
1332        call tour2;\r
1333    fi;\r
1334    if on_prend\r
1335    then\r
1336     call donne2;\r
1337     for n:=1 to 8\r
1338     do\r
1339      call jouer_carte;\r
1340      attach(main);\r
1341     od;\r
1342    fi;\r
1343 \r
1344   attach(main);   \r
1345 end adversaire1;\r
1346 \r
1347 \r
1348 Unit partenaire : coroutine;\r
1349 var i,j,n,cumul : integer;\r
1350 \r
1351  Unit donne1 : procedure;\r
1352  begin\r
1353   for i:=1 to 2\r
1354    do\r
1355      p_jeu(i).c:=s.pop;\r
1356      p_jeu(i).present:=true;\r
1357    od;\r
1358   for i:=1 to 7000 do od;\r
1359   attach(adv2);\r
1360   for i:=1 to 7000 do od;\r
1361   for i:=3 to 5\r
1362    do\r
1363      p_jeu(i).c:=s.pop;\r
1364      p_jeu(i).present:=true;\r
1365    od;\r
1366   for i:=1 to 7000 do od;\r
1367   fin_donne1:=fin_donne1+1;\r
1368   attach(adv2);\r
1369   if fin_donne1=4\r
1370   then\r
1371    fin_donne1:=0;\r
1372    attach(main);\r
1373   fi;\r
1374 \r
1375 \r
1376  end donne1;\r
1377 \r
1378  Unit tour1 : procedure;\r
1379  begin\r
1380   on_prend:=false;\r
1381   part_prend:=false;\r
1382  (* peut-il prendre ? *)  \r
1383   cumul:=evalue2(carte_ret);\r
1384   for i:=1 to 5\r
1385    do\r
1386     if (p_jeu(i).c.couleur=carte_ret.couleur)\r
1387     then\r
1388      cumul:=cumul+evalue2(p_jeu(i).c);\r
1389     fi;\r
1390    od;\r
1391    if (cumul>=50) \r
1392    then\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
1396     part_prend:=true;\r
1397     on_prend:=true;\r
1398     atout:=carte_ret.couleur;\r
1399     attach(main);\r
1400    else\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
1404     attach(adv2);\r
1405    fi;\r
1406 \r
1407 end tour1;\r
1408 \r
1409 Unit tour2 : procedure;\r
1410 begin\r
1411    j:=1;\r
1412    while ((j<=4) and not(on_prend))\r
1413    do\r
1414    coul:=j;\r
1415    cumul:=0;\r
1416    if (coul=/=carte_ret.couleur)\r
1417    then\r
1418     for i:=1 to 5\r
1419     do\r
1420      if (p_jeu(i).c.couleur=coul)\r
1421      then\r
1422       cumul:=cumul+evalue2(p_jeu(i).c);\r
1423      fi;\r
1424     od;\r
1425     if (cumul>=50) \r
1426     then\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
1430      part_prend:=true;\r
1431      on_prend:=true;\r
1432      atout:=coul;\r
1433     else\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
1437     fi;\r
1438    fi;\r
1439    j:=j+1;\r
1440   od;\r
1441   if part_prend\r
1442   then\r
1443    attach(main);\r
1444   else\r
1445    attach(adv2);\r
1446   fi;\r
1447 \r
1448 end tour2;\r
1449 \r
1450 Unit donne2 : procedure;\r
1451  var i : integer;\r
1452  begin\r
1453    if part_prend\r
1454     then\r
1455       p_jeu(6).c:=carte_ret;  \r
1456       p_jeu(6).present:=true;\r
1457       for i:=7 to 8\r
1458        do\r
1459          p_jeu(i).c:=s.pop;\r
1460          p_jeu(i).present:=true;\r
1461        od;\r
1462     else   \r
1463       for i:=6 to 8\r
1464        do\r
1465          p_jeu(i).c:=s.pop;\r
1466          p_jeu(i).present:=true;\r
1467        od;\r
1468    fi;  \r
1469    belote_partenaire:=false;\r
1470    for i:=1 to 8\r
1471    do\r
1472     if p_jeu(i).c.couleur=atout and p_jeu(i).c.valeur=dame\r
1473     then\r
1474      for j:=1 to 8\r
1475      do\r
1476       if p_jeu(j).c.couleur=atout and p_jeu(j).c.valeur=roi\r
1477       then\r
1478        belote_partenaire:=true;\r
1479       fi;\r
1480      od;\r
1481     fi;\r
1482    od;\r
1483 \r
1484    fin_donne2:=fin_donne2+1;\r
1485    attach(adv2);\r
1486    if fin_donne2=4\r
1487    then\r
1488     fin_donne2:=0;\r
1489     attach(main);\r
1490    fi;\r
1491 \r
1492 end donne2;\r
1493 \r
1494 Unit jouer_carte : procedure;\r
1495 var trouve,pas_encore                    : boolean,\r
1496     i,remember,forte,grand,petit,maitre  : integer;\r
1497 \r
1498 begin\r
1499  i:=1;\r
1500  remember:=0;\r
1501  trouve:=false;    \r
1502  if cpt_pli=1        (* c'est lui qui joue en premier *)\r
1503  then\r
1504   if joueur_prend or part_prend\r
1505   then\r
1506    (* ils ont pris *)\r
1507    (* part joue atout si possible *)\r
1508    grand:=0;\r
1509    petit:=0;\r
1510    while i<9\r
1511    do\r
1512     if p_jeu(i).present\r
1513     then\r
1514      if p_jeu(i).c.couleur=atout and grand=0\r
1515      then\r
1516       grand:=i;\r
1517       petit:=i;\r
1518      else\r
1519       if p_jeu(i).c.couleur=atout\r
1520       then\r
1521        if compare_atout(p_jeu(i).c.valeur,p_jeu(grand).c.valeur)\r
1522        then\r
1523         grand:=i;\r
1524        fi;\r
1525        if not compare_atout(p_jeu(i).c.valeur,p_jeu(petit).c.valeur)\r
1526        then\r
1527         petit:=i;\r
1528        fi;\r
1529       fi;\r
1530      fi;\r
1531     fi;\r
1532     i:=i+1;\r
1533    od;\r
1534    if grand<>0\r
1535    then\r
1536     maitre:=at_fort;\r
1537     if p_jeu(grand).c.valeur=maitre\r
1538     then\r
1539      remember:=grand;\r
1540     else\r
1541      remember:=petit;\r
1542     fi;\r
1543     pli(cpt_pli):=p_jeu(remember).c;\r
1544    fi;\r
1545    i:=1;\r
1546    pas_encore:=true;\r
1547    while i<9 and not trouve and grand=0\r
1548    do\r
1549     (* part n'a pas d'atout, alors il joue as sinon indien *)\r
1550     if p_jeu(i).present\r
1551     then\r
1552      if pas_encore\r
1553      then\r
1554      pli(cpt_pli):=p_jeu(i).c;\r
1555       remember:=i;\r
1556       pas_encore:=false;\r
1557       if pli(cpt_pli).valeur=as\r
1558       then \r
1559       trouve:=true;\r
1560       fi;\r
1561      else\r
1562       (* il n'a pas encore trouve d'as, et il lui reste des cartes\r
1563          a comparer *)\r
1564       if p_jeu(i).c.valeur=as\r
1565       then\r
1566        pli(cpt_pli):=p_jeu(i).c;\r
1567        remember:=i;\r
1568        trouve:=true;\r
1569       else\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
1572        then\r
1573         pli(cpt_pli):=p_jeu(i).c;\r
1574         remember:=i;\r
1575        fi;\r
1576       fi;\r
1577      fi;\r
1578     fi;\r
1579     i:=i+1;\r
1580    od;\r
1581    (* il joue donc la carte nø remember *)\r
1582    if remember<>0\r
1583    then\r
1584     p_jeu(remember).present:=false;\r
1585    fi;\r
1586   else\r
1587    (* Ils n'ont pas pris *)\r
1588    i:=1;\r
1589    pas_encore:=true;\r
1590    while i<9 and not trouve\r
1591    do\r
1592     (* part joue as sinon indien different d'atout *)\r
1593     if p_jeu(i).c.couleur<>atout\r
1594     then\r
1595      if p_jeu(i).present\r
1596      then\r
1597       if pas_encore\r
1598       then\r
1599        pli(cpt_pli):=p_jeu(i).c;\r
1600        remember:=i;\r
1601        pas_encore:=false;\r
1602        if pli(cpt_pli).valeur=as\r
1603        then \r
1604         trouve:=true;\r
1605         p_jeu(remember).present:=false;\r
1606        fi;\r
1607       else\r
1608        (* il n'a pas encore trouve d'as, et il lui reste des cartes\r
1609           a comparer *)\r
1610        if p_jeu(i).c.valeur=as\r
1611        then\r
1612         pli(cpt_pli):=p_jeu(i).c;\r
1613         remember:=i;\r
1614         p_jeu(remember).present:=false;\r
1615         trouve:=true;\r
1616        else\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
1619         then\r
1620          pli(cpt_pli):=p_jeu(i).c;\r
1621          remember:=i;\r
1622         fi;\r
1623        fi;\r
1624       fi;\r
1625      fi;\r
1626     fi;\r
1627     i:=i+1;\r
1628    od;\r
1629    if remember=0\r
1630    then\r
1631     (* il ne lui reste que de l'atout *)\r
1632     (* il est donc oblige de jouer atout *)\r
1633     i:=1;\r
1634     while i<9\r
1635     do\r
1636      (* part joue le plus petit atout *)\r
1637      if p_jeu(i).present\r
1638      then\r
1639       if remember=0\r
1640       then\r
1641        remember:=i;\r
1642       else\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
1645        then\r
1646         remember:=i;\r
1647        fi;\r
1648       fi;\r
1649      fi;\r
1650      i:=i+1;\r
1651     od;\r
1652    fi;\r
1653    p_jeu(remember).present:=false;\r
1654    pli(cpt_pli):=p_jeu(remember).c;\r
1655   fi;\r
1656  else    (* s'il ne joue pas en premier .............................. *)     \r
1657   i:=1;\r
1658   if pli(1).couleur<>atout\r
1659   then\r
1660    pas_encore:=true;\r
1661    while i<9 and not trouve\r
1662    do\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
1665     then\r
1666      if pas_encore\r
1667      then\r
1668       remember:=i;\r
1669       pas_encore:=false;\r
1670       if p_jeu(remember).c.valeur=as\r
1671       then \r
1672        trouve:=true;\r
1673       fi;\r
1674      else\r
1675       (* il n'a pas encore trouve d'as, et il lui reste des cartes\r
1676         a comparer *)\r
1677       if p_jeu(i).c.valeur=as\r
1678       then\r
1679        remember:=i;\r
1680        trouve:=true;\r
1681       else\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
1684        then\r
1685         remember:=i;\r
1686        fi;\r
1687       fi;\r
1688      fi;\r
1689     fi;\r
1690     i:=i+1;\r
1691    od;\r
1692    if remember=0\r
1693    then\r
1694     (* il n'a pas de la couleur demandee, il essaie de jouer atout *)\r
1695     i:=1;\r
1696     while i<9\r
1697     do\r
1698      (* part joue le plus petit atout *)\r
1699      if p_jeu(i).present and p_jeu(i).c.couleur=atout\r
1700      then\r
1701       if remember=0\r
1702       then\r
1703        remember:=i;\r
1704       else\r
1705        if not compare_atout(p_jeu(i).c.valeur,p_jeu(remember).c.valeur)\r
1706        then\r
1707         remember:=i;\r
1708        fi;\r
1709       fi;\r
1710      fi;\r
1711      i:=i+1;\r
1712     od;\r
1713     if remember=0\r
1714     then\r
1715      (* il ne peut pas couper *)\r
1716      i:=1;\r
1717      while i<9\r
1718      do\r
1719       (* part joue sa plus petite carte *)\r
1720       if p_jeu(i).present \r
1721       then\r
1722        if remember=0\r
1723        then\r
1724         remember:=i;\r
1725        else\r
1726         if p_jeu(i).c.valeur<p_jeu(remember).c.valeur\r
1727         then\r
1728          remember:=i;\r
1729         fi;\r
1730        fi;\r
1731       fi;\r
1732       i:=i+1;\r
1733      od;\r
1734     fi;\r
1735    fi;\r
1736   else \r
1737    (* c'est atout demandee *)\r
1738    (* il est oblige de monter *)\r
1739    forte:=0;\r
1740    for i:=1 to cpt_pli\r
1741    do\r
1742     if pli(i).couleur=atout\r
1743     then\r
1744      if not compare_atout(forte,pli(i).valeur)\r
1745      then \r
1746       forte:=pli(i).valeur\r
1747      fi;\r
1748     fi;\r
1749    od;\r
1750    i:=1;\r
1751    while i<9 and not trouve\r
1752    do\r
1753     if p_jeu(i).present and p_jeu(i).c.couleur=atout\r
1754     then\r
1755      if remember=0\r
1756      then\r
1757       remember:=i;\r
1758       if compare_atout(p_jeu(i).c.valeur,forte)\r
1759       then \r
1760        trouve:=true;\r
1761       fi;\r
1762      else\r
1763       if compare_atout(p_jeu(i).c.valeur,forte)\r
1764       then\r
1765        remember:=i;\r
1766        trouve:=true;\r
1767       else\r
1768        if not compare_atout(p_jeu(i).c.valeur,p_jeu(remember).c.valeur)\r
1769        then\r
1770         remember:=i;\r
1771        fi;\r
1772       fi;\r
1773      fi;\r
1774     fi;\r
1775     i:=i+1;\r
1776    od;\r
1777    if remember=0\r
1778    then\r
1779     (* part n'a pas d'atout, il joue un indien *)\r
1780     i:=1;\r
1781     while i<9\r
1782     do\r
1783      (* part joue sa plus petite carte *)\r
1784      if p_jeu(i).present \r
1785      then\r
1786       if remember=0\r
1787       then\r
1788        remember:=i;\r
1789       else\r
1790        if p_jeu(i).c.valeur<p_jeu(remember).c.valeur\r
1791        then\r
1792         remember:=i;\r
1793        fi;\r
1794       fi;\r
1795      fi;\r
1796      i:=i+1;\r
1797     od;\r
1798    fi;\r
1799   fi;\r
1800   pli(cpt_pli):=p_jeu(remember).c;\r
1801   p_jeu(remember).present:=false;\r
1802  fi;\r
1803  if remember<>0\r
1804  then\r
1805   if p_jeu(remember).c.couleur=atout\r
1806   then\r
1807    atout_joue(p_jeu(remember).c.valeur):=true;\r
1808   fi;\r
1809  fi;\r
1810  \r
1811 \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
1816 \r
1817 end jouer_carte;\r
1818 \r
1819 begin\r
1820   return;\r
1821 \r
1822   call donne1;\r
1823   if not(on_prend)\r
1824     then\r
1825        call tour1;\r
1826   fi;\r
1827 (* 2ieme tour *)      \r
1828    if not(on_prend)\r
1829    then\r
1830        call tour2;\r
1831    fi;\r
1832 \r
1833    if on_prend\r
1834    then    \r
1835     call donne2;\r
1836     for n:=1 to 8\r
1837     do\r
1838      call jouer_carte;\r
1839      attach(main);\r
1840     od;\r
1841    fi;\r
1842 \r
1843 \r
1844   attach(main);\r
1845 end partenaire;\r
1846 \r
1847 \r
1848 \r
1849 \r
1850 Unit adversaire2 : coroutine;\r
1851 var i,j,n,cumul : integer;\r
1852 \r
1853  Unit donne1 : procedure;\r
1854  begin\r
1855   for i:=1 to 2\r
1856     do\r
1857       a2_jeu(i).c:=s.pop;\r
1858       a2_jeu(i).present:=true;\r
1859     od;\r
1860   for i:=1 to 7000 do od;\r
1861   attach(user);\r
1862   for i:=1 to 7000 do od;\r
1863   for i:=3 to 5\r
1864     do\r
1865       a2_jeu(i).c:=s.pop;\r
1866       a2_jeu(i).present:=true;\r
1867     od;\r
1868   for i:=1 to 7000 do od;\r
1869   fin_donne1:=fin_donne1+1;\r
1870   attach(user);\r
1871   if fin_donne1=4\r
1872   then\r
1873    fin_donne1:=0;\r
1874    attach(main);\r
1875   fi;\r
1876 \r
1877  end donne1;\r
1878 \r
1879  Unit tour1 : procedure;\r
1880  begin\r
1881   on_prend:=false;\r
1882   adv2_prend:=false;\r
1883  (* peut-il prendre ? *)  \r
1884   cumul:=evalue(carte_ret);\r
1885   for i:=1 to 5\r
1886    do\r
1887     if (a2_jeu(i).c.couleur=carte_ret.couleur)\r
1888     then\r
1889      cumul:=cumul+evalue(a2_jeu(i).c);\r
1890     fi;\r
1891    od;\r
1892    if (cumul>=50) \r
1893    then\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
1897     adv2_prend:=true;\r
1898     on_prend:=true;\r
1899     atout:=carte_ret.couleur;\r
1900     attach(main);\r
1901    else\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
1905     attach(user);   \r
1906    fi;\r
1907 \r
1908    (* attach(user); *)\r
1909 \r
1910 end tour1;\r
1911 \r
1912 Unit tour2 : procedure;\r
1913 begin\r
1914    j:=1;\r
1915    while ((j<=4) and not(on_prend))\r
1916    do\r
1917    coul:=j;\r
1918    cumul:=0;\r
1919    if (coul=/=carte_ret.couleur)\r
1920    then\r
1921     for i:=1 to 5\r
1922     do\r
1923      if (a2_jeu(i).c.couleur=coul)\r
1924      then\r
1925       cumul:=cumul+evalue(a2_jeu(i).c);\r
1926      fi;\r
1927     od;\r
1928     if (cumul>=50) \r
1929     then\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
1933      adv2_prend:=true;\r
1934      on_prend:=true;\r
1935      atout:=coul;\r
1936     else\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
1940     fi;\r
1941    fi;\r
1942    j:=j+1;\r
1943   od;\r
1944   if adv2_prend\r
1945   then\r
1946    attach(main);\r
1947   else\r
1948    attach(user);\r
1949   fi;\r
1950 \r
1951 end tour2;\r
1952 \r
1953  Unit donne2 : procedure;\r
1954  var i : integer;\r
1955  begin\r
1956    if adv2_prend\r
1957     then\r
1958       a2_jeu(6).c:=carte_ret;  \r
1959       a2_jeu(6).present:=true;\r
1960       for i:=7 to 8\r
1961        do\r
1962          a2_jeu(i).c:=s.pop;\r
1963          a2_jeu(i).present:=true;\r
1964        od;\r
1965     else   \r
1966       for i:=6 to 8\r
1967        do\r
1968          a2_jeu(i).c:=s.pop;\r
1969          a2_jeu(i).present:=true;\r
1970        od;\r
1971    fi;  \r
1972    belote_adversaire2:=false;\r
1973    for i:=1 to 8\r
1974    do\r
1975     if a2_jeu(i).c.couleur=atout and a2_jeu(i).c.valeur=dame\r
1976     then\r
1977      for j:=1 to 8\r
1978      do\r
1979       if a2_jeu(j).c.couleur=atout and a2_jeu(j).c.valeur=roi\r
1980       then\r
1981        belote_adversaire2:=true;\r
1982       fi;\r
1983      od;\r
1984     fi;\r
1985    od;\r
1986 \r
1987    fin_donne2:=fin_donne2+1;\r
1988    attach(user);\r
1989    if fin_donne2=4\r
1990    then\r
1991     fin_donne2:=0;\r
1992     attach(main);\r
1993    fi;\r
1994    \r
1995 end donne2;\r
1996 \r
1997 Unit jouer_carte : procedure;\r
1998 var trouve,pas_encore                    : boolean,\r
1999     i,remember,forte,grand,petit,maitre  : integer;\r
2000 \r
2001 begin\r
2002  i:=1;\r
2003  remember:=0;\r
2004  trouve:=false;    \r
2005  if cpt_pli=1        (* c'est lui qui joue en premier *)\r
2006  then\r
2007   if adv1_prend or adv2_prend\r
2008   then\r
2009    (* ils ont pris *)\r
2010    (* adv2 joue atout si possible *)\r
2011    grand:=0;\r
2012    petit:=0;\r
2013    while i<9\r
2014    do\r
2015     if a2_jeu(i).present\r
2016     then\r
2017      if a2_jeu(i).c.couleur=atout and grand=0\r
2018      then\r
2019       grand:=i;\r
2020       petit:=i;\r
2021      else\r
2022       if a2_jeu(i).c.couleur=atout\r
2023       then\r
2024        if compare_atout(p_jeu(i).c.valeur,a2_jeu(grand).c.valeur)\r
2025        then\r
2026         grand:=i;\r
2027        fi;\r
2028        if not compare_atout(a2_jeu(i).c.valeur,a2_jeu(petit).c.valeur)\r
2029        then\r
2030         petit:=i;\r
2031        fi;\r
2032       fi;\r
2033      fi;\r
2034     fi;\r
2035     i:=i+1;\r
2036    od;\r
2037    if grand<>0\r
2038    then\r
2039     maitre:=at_fort;\r
2040     if a2_jeu(grand).c.valeur=maitre\r
2041     then\r
2042      remember:=grand;\r
2043     else\r
2044      remember:=petit;\r
2045     fi;\r
2046     pli(cpt_pli):=a2_jeu(remember).c;\r
2047    fi;\r
2048    i:=1;\r
2049    pas_encore:=true;\r
2050    while i<9 and not trouve\r
2051    do\r
2052     (* adv2 n'a pas d'atout, alors il joue as sinon indien *)\r
2053     if a2_jeu(i).present\r
2054     then\r
2055      if pas_encore\r
2056      then\r
2057       pli(cpt_pli):=a2_jeu(i).c;\r
2058       remember:=i;\r
2059       pas_encore:=false;\r
2060       if pli(cpt_pli).valeur=as\r
2061       then \r
2062        trouve:=true;\r
2063       fi;\r
2064      else\r
2065       (* il n'a pas encore trouve d'as, et il lui reste des cartes\r
2066          a comparer *)\r
2067       if a2_jeu(i).c.valeur=as\r
2068       then\r
2069        pli(cpt_pli):=a2_jeu(i).c;\r
2070        remember:=i;\r
2071        trouve:=true;\r
2072       else\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
2075        then\r
2076         pli(cpt_pli):=a2_jeu(i).c;\r
2077         remember:=i;\r
2078        fi;\r
2079       fi;\r
2080      fi;\r
2081     fi;\r
2082     i:=i+1;\r
2083    od;\r
2084    (* il joue donc la carte nø remember *)\r
2085    if remember<>0\r
2086    then\r
2087     a2_jeu(remember).present:=false;\r
2088    fi;\r
2089   else\r
2090    (* Ils n'ont pas pris *)\r
2091    i:=1;\r
2092    pas_encore:=true;\r
2093    while i<9 and not trouve\r
2094    do\r
2095     (* adv2 joue as sinon indien different d'atout *)\r
2096     if a2_jeu(i).c.couleur<>atout\r
2097     then\r
2098      if a2_jeu(i).present\r
2099      then\r
2100       if pas_encore\r
2101       then\r
2102        pli(cpt_pli):=a2_jeu(i).c;\r
2103        remember:=i;\r
2104        pas_encore:=false;\r
2105        if pli(cpt_pli).valeur=as\r
2106        then \r
2107         trouve:=true;\r
2108         a2_jeu(remember).present:=false;\r
2109        fi;\r
2110       else\r
2111        (* il n'a pas encore trouve d'as, et il lui reste des cartes\r
2112           a comparer *)\r
2113        if a2_jeu(i).c.valeur=as\r
2114        then\r
2115         pli(cpt_pli):=a2_jeu(i).c;\r
2116         remember:=i;\r
2117         a2_jeu(remember).present:=false;\r
2118         trouve:=true;\r
2119        else\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
2122         then\r
2123          pli(cpt_pli):=a2_jeu(i).c;\r
2124          remember:=i;\r
2125         fi;\r
2126        fi;\r
2127       fi;\r
2128      fi;\r
2129     fi;\r
2130     i:=i+1;\r
2131    od;\r
2132    if remember=0\r
2133    then\r
2134     (* il ne lui reste que de l'atout *)\r
2135     (* il est donc oblige de jouer atout *)\r
2136     i:=1;\r
2137     while i<9\r
2138     do\r
2139      (* adv2 joue le plus petit atout *)\r
2140      if a2_jeu(i).present\r
2141      then\r
2142       if remember=0\r
2143       then\r
2144        remember:=i;\r
2145       else\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
2148        then\r
2149         remember:=i;\r
2150        fi;\r
2151       fi;\r
2152      fi;\r
2153      i:=i+1;\r
2154     od;\r
2155    fi;\r
2156    a2_jeu(remember).present:=false;\r
2157    pli(cpt_pli):=a2_jeu(remember).c;\r
2158   fi;\r
2159  else    (* s'il ne joue pas en premier .............................. *)     \r
2160   i:=1;\r
2161   if pli(1).couleur<>atout\r
2162   then\r
2163    pas_encore:=true;\r
2164    while i<9 and not trouve\r
2165    do\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
2168     then\r
2169      if pas_encore\r
2170      then\r
2171       remember:=i;\r
2172       pas_encore:=false;\r
2173       if a2_jeu(remember).c.valeur=as\r
2174       then \r
2175        trouve:=true;\r
2176       fi;\r
2177      else\r
2178       (* il n'a pas encore trouve d'as, et il lui reste des cartes\r
2179         a comparer *)\r
2180       if a2_jeu(i).c.valeur=as\r
2181       then\r
2182        remember:=i;\r
2183        trouve:=true;\r
2184       else\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
2187        then\r
2188         remember:=i;\r
2189        fi;\r
2190       fi;\r
2191      fi;\r
2192     fi;\r
2193     i:=i+1;\r
2194    od;\r
2195    if remember=0\r
2196    then\r
2197     (* il n'a pas de la couleur demandee, il essaie de jouer atout *)\r
2198     i:=1;\r
2199     while i<9\r
2200     do\r
2201      (* adv2 joue le plus petit atout *)\r
2202      if a2_jeu(i).present and a2_jeu(i).c.couleur=atout\r
2203      then\r
2204       if remember=0\r
2205       then\r
2206        remember:=i;\r
2207       else\r
2208        if not compare_atout(a2_jeu(i).c.valeur,a2_jeu(remember).c.valeur)\r
2209        then\r
2210         remember:=i;\r
2211        fi;\r
2212       fi;\r
2213      fi;\r
2214      i:=i+1;\r
2215     od;\r
2216     if remember=0\r
2217     then\r
2218      (* il ne peut pas couper *)\r
2219      i:=1;\r
2220      while i<9\r
2221      do\r
2222       (* adv2 joue sa plus petite carte *)\r
2223       if a2_jeu(i).present \r
2224       then\r
2225        if remember=0\r
2226        then\r
2227         remember:=i;\r
2228        else\r
2229         if a2_jeu(i).c.valeur<a2_jeu(remember).c.valeur\r
2230         then\r
2231          remember:=i;\r
2232         fi;\r
2233        fi;\r
2234       fi;\r
2235       i:=i+1;\r
2236      od;\r
2237     fi;\r
2238    fi;\r
2239   else \r
2240    (* c'est atout demandee *)\r
2241    (* il est oblige de monter *)\r
2242    forte:=0;\r
2243    for i:=1 to cpt_pli\r
2244    do\r
2245     if pli(i).couleur=atout\r
2246     then\r
2247      if not compare_atout(forte,pli(i).valeur)\r
2248      then \r
2249       forte:=pli(i).valeur\r
2250      fi;\r
2251     fi;\r
2252    od;\r
2253    i:=1;\r
2254    while i<9 and not trouve\r
2255    do\r
2256     if a2_jeu(i).present and a2_jeu(i).c.couleur=atout\r
2257     then\r
2258      if remember=0\r
2259      then\r
2260       remember:=i;\r
2261       if compare_atout(a2_jeu(i).c.valeur,forte)\r
2262       then \r
2263        trouve:=true;\r
2264       fi;\r
2265      else\r
2266       if compare_atout(a2_jeu(i).c.valeur,forte)\r
2267       then\r
2268        remember:=i;\r
2269        trouve:=true;\r
2270       else\r
2271        if not compare_atout(a2_jeu(i).c.valeur,a2_jeu(remember).c.valeur)\r
2272        then\r
2273         remember:=i;\r
2274        fi;\r
2275       fi;\r
2276      fi;\r
2277     fi;\r
2278     i:=i+1;\r
2279    od;\r
2280    if remember=0\r
2281    then\r
2282     (* adv2 n'a pas d'atout, il joue un indien *)\r
2283     i:=1;\r
2284     while i<9\r
2285     do\r
2286      (* adv2 joue sa plus petite carte *)\r
2287      if a2_jeu(i).present \r
2288      then\r
2289       if remember=0\r
2290       then\r
2291        remember:=i;\r
2292       else\r
2293        if a2_jeu(i).c.valeur<a2_jeu(remember).c.valeur\r
2294        then\r
2295         remember:=i;\r
2296        fi;\r
2297       fi;\r
2298      fi;\r
2299      i:=i+1;\r
2300     od;\r
2301    fi;\r
2302   fi;\r
2303   pli(cpt_pli):=a2_jeu(remember).c;\r
2304   a2_jeu(remember).present:=false;\r
2305  fi;\r
2306  if remember<>0\r
2307  then\r
2308   if a2_jeu(remember).c.couleur=atout\r
2309   then\r
2310    atout_joue(a2_jeu(remember).c.valeur):=true;\r
2311   fi;\r
2312  fi;\r
2313 \r
2314 \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
2319 \r
2320 end jouer_carte;\r
2321 \r
2322 begin\r
2323   return;\r
2324 \r
2325   call donne1;\r
2326   if not(on_prend)\r
2327    then\r
2328        call tour1;\r
2329   fi;\r
2330 (* 2ieme tour *)      \r
2331   if not(on_prend)\r
2332    then\r
2333        call tour2;\r
2334   fi;\r
2335   if on_prend\r
2336   then\r
2337    call donne2;\r
2338    for n:=1 to 8\r
2339    do\r
2340     call jouer_carte;\r
2341     attach(main);\r
2342    od;\r
2343   fi;\r
2344 \r
2345   attach(main);\r
2346 end adversaire2;\r
2347 \r
2348 (* *********************** fin des coroutines ************************* *)\r
2349 \r
2350 \r
2351         (*************************************)\r
2352         (*     On coupe le jeu de cartes     *) \r
2353         (*************************************) \r
2354 \r
2355 \r
2356 Unit COUPE_JEU : procedure;\r
2357 var i,j        : integer,\r
2358     tmp1,tmp2  : pile;\r
2359 begin\r
2360   tmp1:=new pile;\r
2361   tmp2:=new pile;\r
2362   call RANSET(1000);\r
2363   i:=entier(RANDOM*32);\r
2364   if i<3 or i>29\r
2365   then\r
2366    i:=15;\r
2367   fi;\r
2368   for j:=1 to i\r
2369   do\r
2370    call tmp1.push(s.pop);\r
2371   od;\r
2372   while not s.empty\r
2373   do\r
2374    call tmp2.push(s.pop);\r
2375   od;\r
2376   while not tmp1.empty\r
2377   do\r
2378    call s.push(tmp1.pop);\r
2379   od;\r
2380   while not tmp2.empty\r
2381   do\r
2382    call s.push(tmp2.pop);\r
2383   od;\r
2384   kill(tmp1);\r
2385   kill(tmp2);\r
2386 \r
2387 end coupe_jeu;\r
2388 \r
2389 \r
2390         (*************************************)\r
2391         (*     Melange du jeu de cartes      *) \r
2392         (*************************************) \r
2393 \r
2394 Unit MELANGE : procedure;\r
2395 var\r
2396  tab : arrayof carte,\r
2397  tampon : carte,\r
2398  a,b,i,j,attente : integer;\r
2399 \r
2400 begin\r
2401  array tab dim(0:31);\r
2402  tab(0):=P1;\r
2403  tab(1):=P2;\r
2404  tab(2):=P3;\r
2405  tab(3):=P4;\r
2406  tab(4):=P5;\r
2407  tab(5):=P6;\r
2408  tab(6):=P7;\r
2409  tab(7):=P8;\r
2410  tab(8):=T1;\r
2411  tab(9):=T2;\r
2412  tab(10):=T3;\r
2413  tab(11):=T4;\r
2414  tab(12):=T5;\r
2415  tab(13):=T6;\r
2416  tab(14):=T7;\r
2417  tab(15):=T8;\r
2418  tab(16):=CA1;\r
2419  tab(17):=CA2;\r
2420  tab(18):=CA3;\r
2421  tab(19):=CA4;\r
2422  tab(20):=CA5;\r
2423  tab(21):=CA6;\r
2424  tab(22):=CA7;\r
2425  tab(23):=CA8;\r
2426  tab(24):=CO1;\r
2427  tab(25):=CO2;\r
2428  tab(26):=CO3;\r
2429  tab(27):=CO4;\r
2430  tab(28):=CO5;\r
2431  tab(29):=CO6;\r
2432  tab(30):=CO7;\r
2433  tab(31):=CO8;\r
2434  for a:=1 to 10\r
2435  do\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
2441   for b:=1 to 15\r
2442   do\r
2443    tampon:=tab(i);\r
2444    tab(i):=tab((i+j) mod 31);\r
2445    tab((i+j) mod 31):=tampon;\r
2446    i:=(i+4) mod 31;\r
2447    j:=(j+3) mod 31;\r
2448    tampon:=tab(i);\r
2449    tab(i):=tab((i+j) mod 31);\r
2450    tab((i+j) mod 31):=tampon;\r
2451    i:=(i+1) mod 31;\r
2452    j:=(j+7) mod 31;\r
2453   od;\r
2454  od;\r
2455  for a:=0 to 31 \r
2456  do\r
2457   call s.push(tab(a));\r
2458  od;\r
2459 \r
2460 end melange;\r
2461 \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
2466 \r
2467 Unit AT_FORT : function : integer;\r
2468 begin\r
2469  if not atout_joue(valet)\r
2470  then\r
2471   result:=valet;\r
2472  else\r
2473   if not atout_joue(neuf)\r
2474   then\r
2475    result:=neuf;\r
2476   else\r
2477    for i:=8 downto 1\r
2478    do\r
2479     if not atout_joue(i)\r
2480     then\r
2481      result:=i;\r
2482     fi;\r
2483    od;\r
2484   fi;\r
2485  fi;\r
2486 end at_fort;\r
2487 \r
2488 \r
2489 \r
2490 \r
2491         (**************************************************)\r
2492         (*    Ordre de croissance des cartes a l'atout    *) \r
2493         (*          --> retourne vrai si c1>c2            *)\r
2494         (**************************************************) \r
2495 \r
2496 Unit COMPARE_ATOUT : function(c1,c2 : integer): boolean;\r
2497 begin\r
2498  if c1=valet\r
2499  then \r
2500   result:=true;\r
2501  else \r
2502   if c2=valet\r
2503   then\r
2504    result:=false;\r
2505   else\r
2506    if c1=neuf\r
2507    then \r
2508     result:=true;\r
2509    else \r
2510     if c2=neuf\r
2511     then\r
2512      result:=false;\r
2513     else\r
2514      (* il n'y a ni valet ni neuf *)\r
2515      if c1>c2\r
2516      then\r
2517       result:=true;\r
2518      else\r
2519       result:=false;\r
2520      fi;\r
2521     fi;\r
2522    fi;\r
2523   fi;\r
2524  fi;\r
2525 end compare_atout;\r
2526 \r
2527         (**************************************************)\r
2528         (*     Attribue une valeur pour chaque carte      *) \r
2529         (**************************************************) \r
2530         \r
2531 Unit EVALUE : function(c : carte): integer;\r
2532 begin\r
2533  case c.valeur\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
2542  esac;\r
2543 end evalue;\r
2544 \r
2545         (**************************************************)\r
2546         (*     Attribue une valeur pour chaque carte      *) \r
2547         (**************************************************) \r
2548         \r
2549 Unit EVALUE2 : function(c : carte): integer;\r
2550 begin\r
2551  case c.valeur\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
2560  esac;\r
2561 end evalue2;\r
2562 \r
2563         (*************************************)\r
2564         (*         Affichage du menu         *)\r
2565         (*************************************) \r
2566 \r
2567 Unit PREMIER_MENU : procedure;\r
2568 begin\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
2582  \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
2589  call b_fin.print;\r
2590  call patern(0,0,640,40,gris_clair,plein);\r
2591  (* affichage des bandes de commentaires en gris du haut *)\r
2592  call move(0,20);\r
2593  call color(noir);\r
2594  call draw(640,20);\r
2595  call move(0,40);\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
2601  call menu;\r
2602 end premier_menu;\r
2603 \r
2604 \r
2605         (*************************************)\r
2606         (*                MENU               *)\r
2607         (*************************************) \r
2608 \r
2609 Unit MENU : procedure;\r
2610 var h,v,p,l,r,c          : integer,\r
2611     d                    : boolean;\r
2612 begin\r
2613  call move(100,50);\r
2614  call putmap(save_menu);\r
2615  d:=false;\r
2616   do\r
2617    d:=getpress(h,v,p,l,r,c);\r
2618    case (c)\r
2619     when 1 : \r
2620      if b_option.dedans(h,v)\r
2621      then\r
2622       call b_option.choix;\r
2623       call option;\r
2624      else\r
2625       if b_debut.dedans(h,v)\r
2626       then\r
2627        call b_debut.choix;\r
2628        (* affichage des bandes de commentaires en gris du haut *)\r
2629        call move(0,20);\r
2630        call color(noir);\r
2631        call draw(640,20);\r
2632        call move(0,40);\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
2637        exit;\r
2638       else\r
2639        if b_fin.dedans(h,v)\r
2640        then\r
2641         call b_fin.choix;\r
2642         termine:=true;\r
2643         call fermeture;\r
2644         exit;\r
2645        fi;\r
2646       fi;\r
2647      fi;\r
2648    esac\r
2649   od;\r
2650 end menu; \r
2651 \r
2652         (*************************************)\r
2653         (*             SOUS-MENU             *)\r
2654         (*************************************) \r
2655                                   \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
2660     d             : boolean;\r
2661 begin\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
2668 \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
2673 \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
2678 \r
2679 \r
2680  call outstring(260,145,"Nombre de points",noir,gris_clair);\r
2681  call outstring(260,165,"   par partie",noir,gris_clair);\r
2682  call op1.choix;\r
2683  call op2.print;\r
2684  call op3.print;\r
2685  call valide.print;\r
2686 \r
2687  d:=false;\r
2688   do\r
2689    d:=getpress(h,v,p,l,r,c);\r
2690    case (c)\r
2691     when 1 : \r
2692      if op1.dedans(h,v)\r
2693      then\r
2694       call op1.choix;\r
2695       call op2.print;\r
2696       call op3.print;\r
2697       total:=300;\r
2698      fi;\r
2699      if op2.dedans(h,v)\r
2700      then\r
2701       call op1.print;\r
2702       call op2.choix;\r
2703       call op3.print;\r
2704       total:=1000;\r
2705      fi;\r
2706      if op3.dedans(h,v)\r
2707      then\r
2708       call op1.print;\r
2709       call op2.print;\r
2710       call op3.choix;\r
2711       total:=1500;\r
2712      fi;\r
2713      if valide.dedans(h,v)\r
2714      then\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
2719       exit;\r
2720      fi;\r
2721 \r
2722    esac\r
2723   od;\r
2724 end option; \r
2725 \r
2726 \r
2727         (*************************************)\r
2728         (*        Calcul du score pour       *)\r
2729         (*           chaque equipe           *)\r
2730         (*************************************) \r
2731              \r
2732 Unit CALCUL_SCORE : procedure;\r
2733 var s1,s2,i,attente : integer,\r
2734     dedans,capot    : boolean;\r
2735 \r
2736 begin\r
2737  s1:=0;\r
2738  s2:=0;\r
2739  (* prise en compte du 10 de der *)\r
2740  if commence=1 or commence=3\r
2741  then\r
2742   s1:=s1+10;\r
2743  else\r
2744   s2:=s2+10;\r
2745  fi;\r
2746  \r
2747  while not(e1.empty) \r
2748  do\r
2749   if e1.sommet.valeur.couleur=atout and e1.sommet.valeur.valeur=valet\r
2750   then\r
2751    s1:=s1+20;\r
2752   else\r
2753    if e1.sommet.valeur.couleur=atout and e1.sommet.valeur.valeur=neuf\r
2754    then\r
2755     s1:=s1+14;\r
2756    else\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
2763     esac;\r
2764    fi;\r
2765   fi;\r
2766   call e11.push(e1.pop);\r
2767  od;\r
2768  while not(e2.empty) \r
2769  do\r
2770   if e2.sommet.valeur.couleur=atout and e2.sommet.valeur.valeur=valet\r
2771   then\r
2772    s2:=s2+20;\r
2773   else\r
2774    if e2.sommet.valeur.couleur=atout and e2.sommet.valeur.valeur=neuf\r
2775    then\r
2776    s2:=s2+14;\r
2777    else\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
2784     esac;\r
2785    fi;\r
2786   fi;\r
2787   call e22.push(e2.pop);\r
2788  od;\r
2789  dedans:=false;\r
2790  capot:=false;\r
2791  if (s1=0)\r
2792   then \r
2793     score2:=score2+250;\r
2794     capot:=true;\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
2798   else\r
2799    if (s2=0)\r
2800     then \r
2801       score1:=score1+250;\r
2802       capot:=true;\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
2806 \r
2807     else\r
2808       if joueur_prend or part_prend\r
2809        then\r
2810          if s1<s2\r
2811           then\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
2816             dedans:=true;\r
2817           fi;\r
2818        else \r
2819          if s2<s1\r
2820           then\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
2825             dedans:=true;                 \r
2826          fi;\r
2827       fi;\r
2828    fi;\r
2829    if not dedans and not capot\r
2830     then\r
2831       score1:=score1+s1;\r
2832       score2:=score2+s2;\r
2833    fi;\r
2834  fi;\r
2835  if belote_joueur or belote_partenaire\r
2836  then\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
2841  fi;\r
2842  if belote_adversaire1 or belote_adversaire2\r
2843  then\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
2848  fi;\r
2849  \r
2850 \r
2851 \r
2852 end CALCUL_SCORE;\r
2853 \r
2854 \r
2855         (*************************************)\r
2856         (*        mise_a_jour des plis       *)\r
2857         (*             par equipe            *)\r
2858         (*************************************) \r
2859              \r
2860 \r
2861 Unit MAJ_PLI : procedure;\r
2862 var i : integer;\r
2863 begin\r
2864  if commence=1 or commence=3\r
2865  then \r
2866   for i:=1 to 4\r
2867   do\r
2868    call e1.push(pli(i));\r
2869   od;\r
2870  else \r
2871   for i:=1 to 4\r
2872   do\r
2873    call e2.push(pli(i));\r
2874   od;\r
2875  fi;\r
2876  \r
2877 end maj_pli;\r
2878 \r
2879         (*************************************)\r
2880         (*         Qui a fait le pli ?       *) \r
2881         (*************************************) \r
2882 \r
2883 Unit EVALUE_PLI : function : integer;\r
2884 var\r
2885  i,gagnant : integer;\r
2886  \r
2887 begin\r
2888   gagnant:=0;\r
2889   for i:=1 to 4\r
2890   do\r
2891     if pli(i).couleur=atout and pli(i).valeur=valet\r
2892      then gagnant:=i;\r
2893     fi;\r
2894   od;\r
2895   if gagnant=0\r
2896    then\r
2897      for i:=1 to 4\r
2898      do\r
2899        if pli(i).couleur=atout and pli(i).valeur=neuf\r
2900         then gagnant:=i;\r
2901        fi;\r
2902      od;\r
2903   fi;\r
2904   if gagnant=0\r
2905    then\r
2906      for i:=1 to 4\r
2907      do\r
2908        if pli(i).couleur=atout\r
2909         then\r
2910           if gagnant<>0\r
2911            then\r
2912              if pli(gagnant).valeur<pli(i).valeur\r
2913               then gagnant:=i;\r
2914              fi;\r
2915            else gagnant:=i;\r
2916           fi;\r
2917        fi;\r
2918      od;\r
2919   fi;              \r
2920   if gagnant=0\r
2921    then\r
2922      gagnant:=1;\r
2923      for i:=1 to 4\r
2924      do\r
2925        if pli(i).couleur=pli(gagnant).couleur\r
2926         and pli(i).valeur>pli(gagnant).valeur\r
2927         then gagnant:=i;\r
2928        fi;\r
2929      od;\r
2930    fi;\r
2931    result:=gagnant;\r
2932 end EVALUE_PLI;\r
2933 \r
2934         (*******************************************************)\r
2935         (*    On remet les cartes des joueurs dans le jeu      *) \r
2936         (*******************************************************) \r
2937 \r
2938 Unit PERSONNE_A_PRIS : procedure;\r
2939 var\r
2940  i : integer;\r
2941 begin\r
2942  for i:=1 to 5\r
2943  do \r
2944   call s.push(j_jeu(i).c);\r
2945  od;\r
2946  for i:=1 to 5\r
2947  do \r
2948   call s.push(a1_jeu(i).c);\r
2949  od;\r
2950  for i:=1 to 5\r
2951  do \r
2952   call s.push(p_jeu(i).c);\r
2953  od;\r
2954  for i:=1 to 5\r
2955  do \r
2956   call s.push(a2_jeu(i).c);\r
2957  od;\r
2958  call s.push(carte_ret);\r
2959 end personne_a_pris;\r
2960 \r
2961         (*************************************)\r
2962         (*        Affichage des atouts       *) \r
2963         (*************************************) \r
2964 \r
2965 Unit affiche_atout : procedure;\r
2966 var i : integer;\r
2967 begin\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
2973 \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
2978 \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
2991  for i:=1 to 8\r
2992  do\r
2993   if atout_joue(i)\r
2994   then \r
2995    call patern(200+(i-1)*30,420,200+i*30,450,gris_fonce,plein);\r
2996   fi;\r
2997   call patern(200+(i-1)*30,420,200+i*30,450,noir,vide);\r
2998  od;\r
2999  for i:=1 to 100000 do od;\r
3000 end affiche_atout;\r
3001 \r
3002         (*************************************)\r
3003         (*         Affichage du score        *) \r
3004         (*************************************) \r
3005                                       \r
3006 Unit AFFICHE_SCORE : procedure;\r
3007 begin\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
3013 \r
3014         (*************************************)\r
3015         (*      Affichage du vainqueur       *) \r
3016         (*************************************) \r
3017                                       \r
3018 Unit AFFICHE_VAINQUEUR : procedure;\r
3019 var \r
3020     d           : boolean,\r
3021     h,v,p,l,r,c : integer,\r
3022     ok          : bouton_relief;\r
3023 \r
3024 begin\r
3025  ok:=new bouton_relief(270,150,370,190,4,"O.K.");\r
3026  call move(0,0);\r
3027  call putmap(depart);\r
3028  if score1<score2\r
3029  then\r
3030   call outstring(240,22,"Vainqueur : Equipe2",noir,gris_clair);\r
3031  else\r
3032   if score1>score2\r
3033   then\r
3034    call outstring(240,22,"Vainqueur : Equipe1",noir,gris_clair);\r
3035   else\r
3036    (* on ne sait jamais ... *)\r
3037    call outstring(240,22,"     Match nul !",noir,gris_clair);\r
3038   fi;\r
3039  fi;\r
3040  call affiche_score;\r
3041  call ok.print;\r
3042  d:=false;\r
3043   do\r
3044    d:=getpress(h,v,p,l,r,c);\r
3045    case (c)\r
3046     when 1 : \r
3047        if ok.dedans(h,v)\r
3048        then\r
3049         call ok.choix;\r
3050         call move(0,0);\r
3051         call putmap(depart);\r
3052         call MENU;   \r
3053         exit;\r
3054        fi;\r
3055    esac\r
3056   od;\r
3057 \r
3058 end affiche_vainqueur;\r
3059                 \r
3060 \r
3061         (***************************************)\r
3062         (*     Affichage du tapis de cart      *) \r
3063         (***************************************) \r
3064 \r
3065 Unit Affiche_tapis : procedure;\r
3066 begin\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
3076 \r
3077         (***************************************)\r
3078         (*     Initialisation de l'ecran       *) \r
3079         (***************************************) \r
3080                                            \r
3081 Unit INIT_ECRAN : procedure;\r
3082 var nord,est,ouest:bouton_relief;\r
3083 begin\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
3089   call move(0,20);\r
3090   call color(noir);\r
3091   call draw(640,20);\r
3092   call move(0,40);\r
3093   call draw(640,40);\r
3094   call outstring(270,2,"B-E-L-O-T-E",noir,gris_clair);\r
3095   call nord.print;\r
3096   call est.print;\r
3097   call ouest.print;\r
3098   call move(0,41);\r
3099   terrain:=getmap(640,361);\r
3100   (* sauvegarde de l'ecran *)\r
3101   call move(0,0);\r
3102   depart:=getmap(640,480);\r
3103 end init_ecran;\r
3104 \r
3105         (*****************************************************)\r
3106         (*     Initialisation diverses (cartes, jeu...)      *) \r
3107         (*****************************************************) \r
3108 \r
3109 Unit INITIALISATION : procedure;\r
3110 var i : integer;\r
3111 begin\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
3144  s:=new pile;\r
3145  e1:=new pile;\r
3146  e2:=new pile;\r
3147  e11:=new pile;\r
3148  e22:=new pile;\r
3149  b_aide_atout:=new bouton_relief(600,420,630,450,1,"?");\r
3150  user:=new joueur;\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
3160  for i:=1 to 8\r
3161  do \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
3167  od;\r
3168  for i:=1 to 4\r
3169  do \r
3170   pli(i):=new carte(P,SEPT);\r
3171  od;\r
3172  array tx dim(1:4);\r
3173  array ty dim(1:4);\r
3174  tx(1):=320;\r
3175  tx(2):=162;\r
3176  tx(3):=320;\r
3177  tx(4):=478;\r
3178  ty(1):=92;\r
3179  ty(2):=220;\r
3180  ty(3):=348;\r
3181  ty(4):=220;\r
3182 \r
3183 end initialisation;\r
3184 \r
3185         (*****************************************)\r
3186         (*     Initialisation des variables      *) \r
3187         (*****************************************) \r
3188 \r
3189 Unit INIT_VARIABLES : procedure;\r
3190 var i : integer;\r
3191 begin\r
3192  s:=new pile;\r
3193  e1:=new pile;\r
3194  e2:=new pile;\r
3195  e11:=new pile;\r
3196  e22:=new pile;\r
3197  user:=new joueur;\r
3198  part:=new partenaire;\r
3199  adv1:=new adversaire1;\r
3200  adv2:=new adversaire2;\r
3201  array pli dim(1:4);\r
3202  for i:=1 to 8\r
3203  do \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
3208  od;\r
3209  for i:=1 to 4\r
3210  do \r
3211   pli(i):=new carte(P,SEPT);\r
3212  od;\r
3213  score1:=0;\r
3214  score2:=0;\r
3215  tour:=1;\r
3216  for i:=1 to 8\r
3217  do \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
3222  od;\r
3223  for i:=1 to 4\r
3224  do \r
3225   pli(i):=new carte(P,SEPT);\r
3226  od;\r
3227 \r
3228 \r
3229 end init_variables;\r
3230 \r
3231 \r
3232         (******************************************************)\r
3233         (*     Distribue 5 cartes pour chaque joueur puis     *)\r
3234         (*             retourne une carte                     *)\r
3235         (******************************************************) \r
3236 \r
3237 Unit DISTRIBUE_1 : procedure;\r
3238 begin\r
3239   (* on desire distribuer les cartes *)\r
3240   case tour\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
3245   esac;\r
3246   \r
3247   call move(0,0);\r
3248   image:=getmap(640,480);\r
3249 (* on retourne une carte *)\r
3250   carte_ret:=s.pop;  \r
3251   carte_ret.x:=295;\r
3252   carte_ret.y:=190;\r
3253   call carte_ret.print;\r
3254 end distribue_1;\r
3255 \r
3256         (*********************************)\r
3257         (*  On demande qui veut prendre  *)\r
3258         (*********************************)\r
3259 \r
3260 Unit QUI_PREND : procedure;\r
3261 begin\r
3262  case tour\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
3267  esac;\r
3268 end qui_prend;\r
3269 \r
3270        (*************************************************************)\r
3271        (*  On distribue les cartes restantes et on affiche l'atout  *)\r
3272        (*************************************************************)\r
3273         \r
3274 Unit DISTRIBUE_2 : procedure;\r
3275 begin\r
3276  (* on effectue la troisieme donne *)\r
3277  case tour\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
3282  esac;\r
3283  (* on affiche l'atout *)\r
3284  case atout\r
3285    when 1 :\r
3286     call outstring(2,5,"ATOUT PIC",noir,gris_clair);\r
3287   when 2 :\r
3288      call outstring(2,5,"ATOUT TREFLE",noir,gris_clair);\r
3289   when 3 :\r
3290     call outstring(2,5,"ATOUT CARREAU",noir,gris_clair);\r
3291    when 4 :\r
3292      call outstring(2,5,"ATOUT COEUR",noir,gris_clair);\r
3293   esac;\r
3294   if joueur_prend\r
3295    then \r
3296     call outstring(2,25,"Preneur : SUD",noir,gris_clair);\r
3297   fi; \r
3298   if adv1_prend\r
3299    then \r
3300     call outstring(2,25,"Preneur : EST",noir,gris_clair);\r
3301   fi; \r
3302   if part_prend\r
3303    then \r
3304     call outstring(2,25,"Preneur : NORD",noir,gris_clair);\r
3305   fi; \r
3306   if adv2_prend\r
3307    then \r
3308     call outstring(2,25,"Preneur : OUEST",noir,gris_clair);\r
3309   fi; \r
3310 end distribue_2;\r
3311 \r
3312         (*************************************)\r
3313         (*     Ouverture mode graphique      *) \r
3314         (*************************************) \r
3315 \r
3316 Unit OUVERTURE : procedure;\r
3317 begin\r
3318  call gron(1);\r
3319  call border(bleu_clair);\r
3320  call cls;\r
3321  (*for i:=32 to 40\r
3322  do\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
3326  od;\r
3327  *)\r
3328  call cls;\r
3329  call init(1,0);\r
3330  call showcursor;\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
3335 end OUVERTURE;\r
3336 \r
3337         (*************************************)\r
3338         (*     Fermeture mode graphique      *) \r
3339         (*************************************) \r
3340            \r
3341 Unit FERMETURE : procedure;\r
3342 begin\r
3343  call groff;\r
3344 end FERMETURE;\r
3345 \r
3346  (******************************************************************)\r
3347  (*                  debut PROGRAMME PRINCIPAL                     *) \r
3348  (******************************************************************) \r
3349 \r
3350 \r
3351 \r
3352 begin\r
3353 \r
3354 call OUVERTURE;\r
3355 total:=defaut;\r
3356 termine:=false;\r
3357 call initialisation;\r
3358 call init_ecran;\r
3359 call premier_menu;\r
3360 while not termine\r
3361 do\r
3362  call init_variables;\r
3363  call melange;\r
3364  call move(0,0);\r
3365  call putmap(depart);\r
3366  call affiche_score;\r
3367 \r
3368  while score1<total and score2<total\r
3369  do\r
3370   call coupe_jeu;\r
3371   if tour=5 \r
3372   then\r
3373    tour:=1;\r
3374   fi;\r
3375   case tour\r
3376    when 1 : \r
3377      call outstring(270,22,"OUEST distribue...",noir,gris_clair);\r
3378    when 2 : \r
3379      call outstring(275,22,"SUD distribue...",noir,gris_clair);\r
3380    when 3 : \r
3381      call outstring(275,22,"EST distribue...",noir,gris_clair);\r
3382    when 4 : \r
3383      call outstring(270,22,"NORD distribue...",noir,gris_clair);\r
3384   esac;\r
3385   for attente:=1 to 30000 do od;\r
3386   call outstring(270,22,"                  ",noir,gris_clair);\r
3387   call distribue_1;\r
3388   call qui_prend;\r
3389   if on_prend\r
3390   then\r
3391    call distribue_2;\r
3392      cpt_pli:=1;\r
3393      commence:=tour;\r
3394      call affiche_tapis;\r
3395      case commence\r
3396      when 1 :\r
3397        attach(user);\r
3398        cpt_pli:=2;\r
3399        attach(adv1);\r
3400        cpt_pli:=3;\r
3401        attach(part);\r
3402        cpt_pli:=4;\r
3403        attach(adv2);\r
3404      when 2 :\r
3405        attach(adv1);\r
3406        cpt_pli:=2;\r
3407        attach(part);\r
3408        cpt_pli:=3;\r
3409        attach(adv2);\r
3410        cpt_pli:=4;\r
3411        attach(user);\r
3412      when 3 :\r
3413        attach(part);\r
3414        cpt_pli:=2;\r
3415        attach(adv2);\r
3416        cpt_pli:=3;\r
3417        attach(user);\r
3418        cpt_pli:=4;\r
3419        attach(adv1);\r
3420      when 4 :\r
3421        attach(adv2);\r
3422        cpt_pli:=2;\r
3423        attach(user);\r
3424        cpt_pli:=3;\r
3425        attach(adv1);\r
3426        cpt_pli:=4;\r
3427        attach(part);\r
3428      esac;\r
3429      (* on a effectue le premier pli *)\r
3430      k:=2;\r
3431      while k<=nb_pli \r
3432      do\r
3433        for i:=1 to 20000 do od;\r
3434        eval:=EVALUE_PLI;\r
3435        eval:=(eval+commence-1) mod 4;\r
3436        if eval=0 then eval:=4 fi;\r
3437        commence:=eval;\r
3438        call maj_pli;\r
3439        call move(150,80);\r
3440        call putmap(image2);\r
3441        call affiche_tapis;\r
3442        cpt_pli:=1;  \r
3443        case commence\r
3444         when 1 :\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
3448           attach(user);\r
3449           cpt_pli:=2;\r
3450           attach(adv1);\r
3451           cpt_pli:=3;\r
3452           attach(part);\r
3453           cpt_pli:=4;\r
3454           attach(adv2);\r
3455 \r
3456         when 2 :\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
3460           attach(adv1);\r
3461           cpt_pli:=2;\r
3462           attach(part);\r
3463           cpt_pli:=3;\r
3464           attach(adv2);\r
3465           cpt_pli:=4;\r
3466           attach(user);\r
3467           \r
3468         when 3 :\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
3472           attach(part);\r
3473           cpt_pli:=2;\r
3474           attach(adv2);\r
3475           cpt_pli:=3;\r
3476           attach(user);\r
3477           cpt_pli:=4;\r
3478           attach(adv1);\r
3479 \r
3480         when 4 :\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
3484           attach(adv2);\r
3485           cpt_pli:=2;\r
3486           attach(user);\r
3487           cpt_pli:=3;\r
3488           attach(adv1);\r
3489           cpt_pli:=4;\r
3490           attach(part);\r
3491        esac;\r
3492        k:=k+1;\r
3493      od;\r
3494      for i:=1 to 8\r
3495      do\r
3496       atout_joue(i):=false;\r
3497      od;\r
3498      eval:=EVALUE_PLI;\r
3499      eval:=(eval+commence-1) mod 4;\r
3500      if eval=0 then eval:=4 fi;\r
3501      commence:=eval;\r
3502      call maj_pli;\r
3503      case commence\r
3504       when 1 :\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
3508       when 2 :\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
3512       when 3 :\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
3516       when 4 :\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
3520      esac;\r
3521     call calcul_score;\r
3522     (* on remet tous les plis dans le jeu s *)\r
3523     while not(e11.empty)\r
3524     do\r
3525       call s.push(e11.pop);\r
3526     od;\r
3527     while not(e22.empty)\r
3528     do\r
3529       call s.push(e22.pop);\r
3530     od;\r
3531     \r
3532     on_prend:=false;\r
3533     joueur_prend:=false;\r
3534     adv1_prend:=false;\r
3535     part_prend:=false;\r
3536     adv2_prend:=false;\r
3537   else\r
3538     call personne_a_pris;\r
3539   fi;\r
3540   user:=new joueur;\r
3541   part:=new partenaire;\r
3542   adv1:=new adversaire1;\r
3543   adv2:=new adversaire2;\r
3544   call move(0,0);\r
3545   call putmap(depart);\r
3546   call affiche_score;\r
3547   tour:=tour+1;\r
3548 \r
3549  od;\r
3550  call affiche_vainqueur;\r
3551  \r
3552 od;\r
3553  end;  (* souris *)\r
3554  end;  (* IIUWgraph*)\r
3555 end;\r
3556 \r