program belote;

(* 
   ************************************************************************
   *                                                                      *
   *      TP LI1 : Mai 1995                                               *
   *                                                                      *
   *     Co-auteurs :   R‚gis BRETTE                                      *
   *                    Jean-Yves LAGARDE                                 * 
   *                                                                      *
   *                   SUJET : A partir du langage LOGLAN, r‚aliser       *
   *                           une application utilisant les coroutines.  *
   *                                                                      *
   *                 MACHINE : DOS 386, Systeme LOGLAN-82                 *
   *                           Version de classe graphisme : IIUWgraph    *
   *                           Ecran : 640 X 480                          *                 
   *                                                                      *
   *             REALISATION : Cette application permet de simuler un     *                                                 
   *                           jeu de cartes : la belote. Les diff‚rents  *
   *                           joueurs sont simul‚s par des coroutines.   *
   *                                                                      *
   *           MODE D'EMPLOI : On clique … la souris avec le bouton gauche*           
   *                           sur les boutons pr‚sents … l'‚cran.        *
   *                                                                      *
   *                                                                      * 
   *                                                                      * 
   *                                                                      *
   *                                                                      *
   ************************************************************************

*)


CONST
   noir          =0,
   bleu          =1,
   vert          =2,
   cyan          =3,
   rouge         =4,
   magenta       =5,
   marron        =6,
   gris_clair    =7,
   gris_fonce    =8,
   bleu_clair    =9,
   vert_clair    =10,
   cyan_clair    =11,
   rouge_clair   =12,
   magenta_clair =13,
   jaune         =14,
   blanc         =15,
   vide          =0,
   plein         =1,
  
  larg_caract = 8,
  haut_caract = 8,

  nb_pli = 8,
  defaut = 500,

  sept  = 1,
  huit  = 2,
  neuf  = 3,
  valet = 4,
  dame  = 5,
  roi   = 6,
  dix   = 7,
  as    = 8,

  P     = 1,
  T     = 2,
  CA    = 3,
  CO    = 4;

Begin    
Pref iiuwgraph block     (* fonctions graphiques *)
Begin
Pref mouse block        (* souris *)

 var 
    P1,P2,P3,P4,P5,P6,P7,P8,T1,T2,T3,T4,T5,T6,T7,T8   : carte,
    CA1,CA2,CA3,CA4,CA5,CA6,CA7,CA8,CO1,CO2,CO3,CO4,
    CO5,CO6,CO7,CO8                                   : carte,
    carte_ret,carte_oui                               : carte,
    atout_joue                                        : arrayof boolean,
    score1,score2,tour,atout,fin_donne1,fin_donne2    : integer,
    oui,non,b_pic,b_trefle,b_carreau,b_aide_atout     : bouton_relief,
    b_coeur,rien,carre,b_option,b_debut,b_fin         : bouton_relief,
    nom                                               : string,                                 
    image,image2,depart,save_menu                     : arrayof integer,
    del_menu,terrain,save_joueur                      : arrayof integer,
    he,ve,pe,le,re,ce                                 : integer,
    dede,on_prend,termine                             : boolean,
    joueur_prend,adv1_prend,part_prend,adv2_prend     : boolean,
    belote_joueur,belote_adversaire1                  : boolean,
    belote_partenaire,belote_adversaire2              : boolean,
    s,e1,e2,e11,e22                                   : PILE,
    user                                              : joueur,
    part                                              : partenaire,
    adv1                                              : adversaire1,
    adv2                                              : adversaire2,
    ca_u                                              : carte_user,
    j_jeu,p_jeu,a1_jeu,a2_jeu                         : arrayof carte_user,
    pli                                               : arrayof carte,
    tx,ty                                             : arrayof integer,
    commence,i,j,k,abscisse,ordonnee,coul,
    cpt_pli,eval,attente,total,lg                     : integer;

        (*************************************)
        (*        Bouton en relief           *) 
        (*************************************) 

Unit BOUTON_RELIEF :  class (x1,y1,x2,y2,nb_car:integer,titre:string);
var selectionne : boolean;  

  Unit print : procedure;
  begin
   if not selectionne 
   then
    call patern(x1,y1,x2,y2,gris_clair,plein);
    call patern(x1,y1,x2,y2,noir,vide);
    call patern(x1+1,y1+1,x1+1,y2-1,blanc,plein);
    call patern(x1+2,y1+2,x1+2,y2-2,blanc,plein);
    call patern(x1+1,y1+1,x2-1,y1+1,blanc,plein);
    call patern(x1+2,y1+2,x2-2,y1+2,blanc,plein);
    call patern(x2-1,y1+1,x2-1,y2-1,gris_fonce,plein);
    call patern(x2-2,y1+2,x2-2,y2-2,gris_fonce,plein);
    call patern(x1+1,y2-1,x2-1,y2-1,gris_fonce,plein);
    call patern(x1+2,y2-2,x2-2,y2-2,gris_fonce,plein);
    call patern(x1+5,y1+5,x2-5,y2-5,gris_fonce,vide);
    call outstring(ENTIER((x2-x1-nb_car*larg_caract)/2)+x1,
         ENTIER((y2-y1-haut_caract)/2)+y1,titre,noir,gris_clair);
   else
    call patern(x1,y1,x2,y2,gris_clair,plein);
    call patern(x1,y1,x2,y2,noir,vide);
    call patern(x1+1,y1+1,x1+1,y2-1,noir,plein);
    call patern(x1+2,y1+2,x1+2,y2-2,noir,plein); 
    call patern(x1+1,y1+1,x2-1,y1+1,noir,plein);
    call patern(x1+2,y1+2,x2-2,y1+2,noir,plein); 
    call patern(x1+5,y1+5,x2-5,y2-5,gris_fonce,vide);
    call outstring(ENTIER((x2-x1-nb_car*larg_caract)/2)+x1+1,
         ENTIER((y2-y1-haut_caract)/2)+y1+1,titre,noir,gris_clair);
   fi ;
  end print;

  Unit choix : procedure ;
  var pause : integer;
  begin
   selectionne:=TRUE;
   call print;
   (* on attend un peu pour visualiser l'effet de pression..*)
   for pause:=1 to 1000 do od;
   selectionne:=FALSE;
   call print;
  end choix; 

  Unit dedans : function(h,v :integer):boolean;
  begin
   result := (v>y1 and v<y2 and h>x1 and h<x2);
  end dedans ;


begin 
(* On initialise le bouton_relief … faux *)
selectionne:=FALSE;

end BOUTON_RELIEF;



        (*************************************)
        (*        Bouton en relief 2         *) 
        (*************************************) 

Unit BOUTON_ENFONCE :  class (x1,y1,x2,y2,nb_car:integer,titre:string);

  Unit print : procedure;
  begin
    call patern(x1,y1,x2,y2,gris_clair,plein);
    call patern(x1,y1,x2,y2,noir,vide);
    call patern(x1+1,y1+1,x1+1,y2-1,blanc,plein);
    call patern(x1+2,y1+2,x1+2,y2-2,blanc,plein);
    call patern(x1+1,y1+1,x2-1,y1+1,blanc,plein);
    call patern(x1+2,y1+2,x2-2,y1+2,blanc,plein);
    call patern(x2-1,y1+1,x2-1,y2-1,gris_fonce,plein);
    call patern(x2-2,y1+2,x2-2,y2-2,gris_fonce,plein);
    call patern(x1+1,y2-1,x2-1,y2-1,gris_fonce,plein);
    call patern(x1+2,y2-2,x2-2,y2-2,gris_fonce,plein);
    call outstring(ENTIER((x2-x1-nb_car*larg_caract)/2)+x1,
         ENTIER((y2-y1-haut_caract)/2)+y1,titre,noir,gris_clair);
  end print;

  Unit choix : procedure ;
  begin
    call patern(x1,y1,x2,y2,gris_clair,plein);
    call patern(x1,y1,x2,y2,noir,vide);
    call patern(x1+1,y1+1,x1+1,y2-1,noir,plein);
    call patern(x1+2,y1+2,x1+2,y2-2,noir,plein); 
    call patern(x1+1,y1+1,x2-1,y1+1,noir,plein);
    call patern(x1+2,y1+2,x2-2,y1+2,noir,plein); 
    call outstring(ENTIER((x2-x1-nb_car*larg_caract)/2)+x1+1,
         ENTIER((y2-y1-haut_caract)/2)+y1+1,titre,noir,gris_clair);
  end choix; 

  Unit dedans : function(h,v :integer):boolean;
  begin
   result := (v>y1 and v<y2 and h>x1 and h<x2);
  end dedans ;

end bouton_enfonce;

(********************************************************************)
            (****************************************)
            (*       Representation des cartes      *)
            (****************************************)

 Unit sept_print : procedure(x,y:integer,couleur:integer);
 begin
   call outstring(x+3,y+2,"7",couleur,blanc);
   call outstring(x+40,y+87,"7",couleur,blanc);
   call outstring(x+40,y+2,"7",couleur,blanc);
   call outstring(x+3,y+87,"7",couleur,blanc);

 end sept_print;

 Unit huit_print : procedure(x,y:integer,couleur:integer);
 begin
   call outstring(x+3,y+2,"8",couleur,blanc);
   call outstring(x+40,y+87,"8",couleur,blanc);
   call outstring(x+40,y+2,"8",couleur,blanc);
   call outstring(x+3,y+87,"8",couleur,blanc);

 end huit_print;

 Unit neuf_print : procedure(x,y:integer,couleur:integer);
 begin
   call outstring(x+3,y+2,"9",couleur,blanc);
   call outstring(x+40,y+87,"9",couleur,blanc);
   call outstring(x+40,y+2,"9",couleur,blanc);
   call outstring(x+3,y+87,"9",couleur,blanc);

 end neuf_print;

 Unit dix_print : procedure(x,y:integer,couleur:integer);
 begin
   call outstring(x+3,y+2,"10",couleur,blanc);
   call outstring(x+34,y+87,"10",couleur,blanc);
   call outstring(x+34,y+2,"10",couleur,blanc);
   call outstring(x+3,y+87,"10",couleur,blanc);

 end dix_print;

 Unit valet_print : procedure(x,y:integer,couleur:integer);
 begin
   call outstring(x+3,y+2,"V",couleur,blanc);
   call outstring(x+40,y+87,"V",couleur,blanc);
   call outstring(x+40,y+2,"V",couleur,blanc);
   call outstring(x+3,y+87,"V",couleur,blanc);

 end valet_print;

 Unit dame_print : procedure(x,y:integer,couleur:integer);
 begin
   call outstring(x+3,y+2,"D",couleur,blanc);
   call outstring(x+40,y+87,"D",couleur,blanc);
   call outstring(x+40,y+2,"D",couleur,blanc);
   call outstring(x+3,y+87,"D",couleur,blanc);

 end dame_print;

 Unit roi_print : procedure(x,y:integer,couleur:integer);
 begin
   call outstring(x+3,y+2,"R",couleur,blanc);
   call outstring(x+40,y+87,"R",couleur,blanc);
   call outstring(x+40,y+2,"R",couleur,blanc);
   call outstring(x+3,y+87,"R",couleur,blanc);

 end roi_print;

 Unit as_print : procedure(x,y:integer,couleur:integer);
 begin
   call outstring(x+3,y+2,"1",couleur,blanc);
   call outstring(x+40,y+87,"1",couleur,blanc);
   call outstring(x+40,y+2,"1",couleur,blanc);
   call outstring(x+3,y+87,"1",couleur,blanc);

 end as_print;



 Unit pic : procedure(x,y : integer);
 var tabx,taby : arrayof integer; 
 begin
    array tabx dim(1:7);
    array taby dim(1:7);
    tabx(1):=X+10;taby(1):=Y+25;
    tabx(2):=X+6;taby(2):=Y+38;
    tabx(3):=X+14;taby(3):=Y+38;
    tabx(4):=X+10;taby(4):=Y+25;
    tabx(5):=X+0;taby(5):=Y+25;
    tabx(6):=X+10;taby(6):=Y+10;
    tabx(7):=X+20;taby(7):=Y+25;
    call intens(7,tabx,taby,noir,plein);
    call cirb(x+5+6/2,y+25+6/2,6/2,6/2,0,3600,noir,plein);
    call cirb(x+15+6/2,y+25+6/2,6/2,6/2,0,3600,noir,plein);
 end pic;

 Unit trefle : procedure(x,y : integer);
 var tabx,taby : arrayof integer;  
 begin
    array tabx dim(1:3);
    array taby dim(1:3);
    tabx(1):=X+10;taby(1):=Y+23;
    tabx(2):=X+6;taby(2):=Y+38;
    tabx(3):=X+14;taby(3):=Y+38;
    call intens(3,tabx,taby,noir,plein);
    call cirb(x+10+6/2,y+15+6/2,6/2,6/2,0,3600,noir,plein);
    call cirb(x+1+6/2,y+25+6/2,6/2,6/2,0,3600,noir,plein);
    call cirb(x+19+6/2,y+25+6/2,6/2,6/2,0,3600,noir,plein);
 end trefle;

 Unit carreau : procedure(x,y : integer);
 var tabx,taby : arrayof integer;  
 begin
    array tabx dim(1:4);
    array taby dim(1:4);
    tabx(1):=X+0;taby(1):=Y+25;
    tabx(2):=X+10;taby(2):=Y+40;
    tabx(3):=X+20;taby(3):=Y+25;
    tabx(4):=X+10;taby(4):=Y+10; 
    call intens(4,tabx,taby,rouge,plein);
 end carreau;

 Unit coeur : procedure(x,y : integer);
 var tabx,taby : arrayof integer; 
 begin
    array tabx dim(1:4);
    array taby dim(1:4);
    tabx(1):=X+10;taby(1):=Y+25;
    tabx(2):=X-2;taby(2):=Y+25;
    tabx(3):=X+10;taby(3):=Y+40;
    tabx(4):=X+22;taby(4):=Y+25;
    call intens(4,tabx,taby,rouge,plein);
    call cirb(x+5+7/2,y+22+7/2,7/2,7/2,0,3600,rouge,plein);
    call cirb(x+15+7/2,y+22+7/2,7/2,7/2,0,3600,rouge,plein);
 
 end coeur;

                (******************************************)
                (*          Creation des cartes           *)
                (******************************************)

 Unit carte : class(couleur,valeur:integer);

  Unit dedans :function(h,v : integer):boolean;
  begin
   result := (v>y and v<y+100 and h>x and h<x+50);
  end dedans ;

  Unit print : procedure;
  var tmp : integer;
   begin
   call patern(x,y,x+50,y+100,blanc,plein);
   call patern(x-1,y-1,x+51,y+101,noir,vide);
   case couleur
    when P : call pic(x+15,y+30);
             tmp:=noir;
    when T : call trefle(x+15,y+30);
             tmp:=noir;
    when CA : call carreau(x+15,y+30);
              tmp:=rouge;
    when CO : call coeur(x+15,y+30);
              tmp:=rouge;
   esac;
   case valeur
    when sept : call sept_print(x,y,tmp);
    when huit : call huit_print(x,y,tmp);
    when neuf : call neuf_print(x,y,tmp);
    when dix : call dix_print(x,y,tmp);
    when valet : call valet_print(x,y,tmp);
    when dame : call dame_print(x,y,tmp);
    when roi : call roi_print(x,y,tmp);
    when as : call as_print(x,y,tmp);

   esac;
  end print;

  Unit efface : procedure;
   begin
   call patern(x-1,y-1,x+51,y+101,bleu,plein);
  end efface;

 var
   x,y:integer;
 begin
  x:=0;
  y:=0;
 end carte;
        
 Unit CARTE_USER : class;
 var       c : carte,
     present : boolean;
 begin
   c:=new carte(P,sept);
   present:=FALSE;
 end carte_user; 


        (*************************************)
        (*     Implementation d'une pile     *) 
        (*             de cartes             *)
        (*************************************) 


Unit PILE:class;
  unit elem:class (valeur:carte,suivant:elem);
  end elem;
  var sommet:elem;
      
  unit empty:function:boolean;
  begin
    if sommet=none
    then result:=true;
    else result:=false;
    fi;
  end empty;

  unit push:procedure(c:carte);
  begin
    sommet:=new elem(c,sommet);
  end push;

  unit pop:function:carte;
  begin
    if sommet=/=none
    then 
      result:=sommet.valeur;
      sommet:=sommet.suivant;
    fi;
  end pop;
end PILE;

(*********************************************************************)

        (*************************************)
        (*     Creation des 4 coroutines     *) 
        (*************************************) 


Unit joueur : coroutine;
var i,n,abscisse,ordonnee:integer;

 Unit donne1 : procedure;   
 begin 
  call patern(0,362,640,480,bleu,plein);
  call b_aide_atout.print;
  abscisse:=100;
  ordonnee:=370;
  for i:=1 to 2
   do
     j_jeu(i).c:=s.pop;
     j_jeu(i).present:=true;
     j_jeu(i).c.x:=abscisse;
     j_jeu(i).c.y:=ordonnee;
     call j_jeu(i).c.print;
     abscisse:=abscisse+55;
   od;
  attach(adv1);
  for i:=1 to 7000 do od;
  for i:=3 to 5
   do
     j_jeu(i).c:=s.pop;
     j_jeu(i).present:=true;
     j_jeu(i).c.x:=abscisse;
     j_jeu(i).c.y:=ordonnee;
     call j_jeu(i).c.print;
     abscisse:=abscisse+55;
   od;
   for i:=1 to 7000 do od;
   fin_donne1:=fin_donne1+1;
   attach(adv1);
   if fin_donne1=4
   then
    fin_donne1:=0;
    attach(main);
   fi;
 end donne1;

 Unit tour1 : procedure;
 begin
   on_prend:=false;
   joueur_prend:=false;
   do
     dede:=getpress(he,ve,pe,le,re,ce);
     case (ce)
      when 1 :  
         if (oui.dedans(he,ve))
          then
            call oui.choix;
            on_prend:=true;
            atout:=carte_ret.couleur;
            joueur_prend:=true;
            call move(0,0);
            call putmap(image);
            call move(0,41);
            call putmap(terrain);
            attach(main);
            exit;
         fi;
         if (non.dedans(he,ve))
          then
            call non.choix;
            call move(0,0);
            call putmap(image);
            call move(0,41);
            call putmap(terrain);
            call carte_ret.print;
            attach(adv1);
            exit;  
         fi;
       esac
   od;
   
   end tour1;

 Unit tour2 : procedure;
 begin
   dede:=false;
   do
     dede:=getpress(he,ve,pe,le,re,ce);
     case (ce)
      when 1 :  
         if (b_pic.dedans(he,ve))
          then
            call b_pic.choix;
            on_prend:=true;
            joueur_prend:=true;
            atout:=P;
            call move(0,0);
            call putmap(image);
            call move(0,41);
            call putmap(terrain);
            attach(main);
            exit;
         fi;
         if (b_trefle.dedans(he,ve))
          then
            call b_trefle.choix;
            on_prend:=true;
            joueur_prend:=true;
            atout:=T;
            call move(0,0);
            call putmap(image);
            call move(0,41);
            call putmap(terrain);
            attach(main);
            exit;
         fi;
         if (b_carreau.dedans(he,ve))
          then
            call b_carreau.choix;
            on_prend:=true;
            joueur_prend:=true;
            atout:=CA;
            call move(0,0);
            call putmap(image);
            call move(0,41);
            call putmap(terrain);
            attach(main);
            exit;
         fi;
         if (b_coeur.dedans(he,ve))
          then
            call b_coeur.choix;
            on_prend:=true;
            joueur_prend:=true;
            atout:=CO;
            call move(0,0);
            call putmap(image);
            call move(0,41);
            call putmap(terrain);
            attach(main);
            exit;
         fi;

         if (rien.dedans(he,ve))
          then
            call rien.choix;
            call move(0,0);
            call putmap(image);
            call move(0,41);
            call putmap(terrain);
            call carte_ret.print;
            attach(adv1);
            exit;  
         fi;
       esac
   od;
 end tour2;

 Unit donne2 : procedure;
 var i,j,abscisse,ordonnee : integer;
 begin
   call move(0,0);
   call putmap(image);
   abscisse:=375;
   ordonnee:=370;
   if joueur_prend
    then
      for j:=1 to 7000 do od;
      j_jeu(6).c:=carte_ret;  
      j_jeu(6).present:=true;
      j_jeu(6).c.x:=abscisse;
      j_jeu(6).c.y:=ordonnee;
      call j_jeu(6).c.print;
      abscisse:=abscisse+55;
 
      for j:=1 to 7000 do od;
      for i:=7 to 8
       do
         j_jeu(i).c:=s.pop;
         j_jeu(i).present:=true;
         j_jeu(i).c.x:=abscisse;
         j_jeu(i).c.y:=ordonnee;
         call j_jeu(i).c.print;
         abscisse:=abscisse+55;
       od;
    else   
      for j:=1 to 7000 do od;
      for i:=6 to 8
       do
         j_jeu(i).c:=s.pop;
         j_jeu(i).present:=true;
         j_jeu(i).c.x:=abscisse;
         j_jeu(i).c.y:=ordonnee;
         call j_jeu(i).c.print;
         abscisse:=abscisse+55;
       od;
   fi;  
   (* belote ou non ? *)
   belote_joueur:=false;
   for i:=1 to 8
   do
    if j_jeu(i).c.couleur=atout and j_jeu(i).c.valeur=dame
    then
     for j:=1 to 8
     do
      if j_jeu(j).c.couleur=atout and j_jeu(j).c.valeur=roi
      then
       belote_joueur:=true;
      fi;
     od;
    fi;
   od;
   fin_donne2:=fin_donne2+1;
   attach(adv1);
   if fin_donne2=4
   then
    fin_donne2:=0;
    attach(main);
   fi;
   
end donne2;

Unit jouer_carte : procedure;
var
 dede              : boolean,
 he,ve,pe,le,re,ce : integer;
begin
  dede:=false;
  
   do
     dede:=getpress(he,ve,pe,le,re,ce);
     case (ce)
      when 1 :  
         if b_aide_atout.dedans(he,ve)
         then
          call b_aide_atout.choix;
          call move(0,0);
          save_joueur:=getmap(640,480);
          call affiche_atout;
          call move(0,0);
          call putmap(save_joueur);
         fi;
         if (j_jeu(1).c.dedans(he,ve))
         then
          if j_jeu(1).present
          then
           for i:=1 to 10000 do od;
           pli(cpt_pli):=j_jeu(1).c;
           j_jeu(1).present:=false;
           if j_jeu(1).c.couleur=atout
           then
            atout_joue(j_jeu(1).c.valeur):=true;
           fi;
           call j_jeu(1).c.efface;
           exit;
          fi;
         fi;
         if (j_jeu(2).c.dedans(he,ve))
         then
          if j_jeu(2).present
          then
           for i:=1 to 10000 do od;
           pli(cpt_pli):=j_jeu(2).c;
           j_jeu(2).present:=false;
           if j_jeu(2).c.couleur=atout
           then
            atout_joue(j_jeu(2).c.valeur):=true;
           fi;
           call j_jeu(2).c.efface;
           exit;
          fi;
         fi;
         if (j_jeu(3).c.dedans(he,ve))
         then
          if j_jeu(3).present
          then
           for i:=1 to 10000 do od;
           pli(cpt_pli):=j_jeu(3).c;
           j_jeu(3).present:=false;
           if j_jeu(3).c.couleur=atout
           then
            atout_joue(j_jeu(3).c.valeur):=true;
           fi;
           call j_jeu(3).c.efface;
           exit;
          fi;
         fi;
         if (j_jeu(4).c.dedans(he,ve))
         then
          if j_jeu(4).present
          then
           for i:=1 to 10000 do od;
           pli(cpt_pli):=j_jeu(4).c;
           j_jeu(4).present:=false;
           if j_jeu(4).c.couleur=atout
           then
            atout_joue(j_jeu(4).c.valeur):=true;
           fi;
           call j_jeu(4).c.efface;
           exit;
          fi;
         fi;
         if (j_jeu(5).c.dedans(he,ve))
         then
          if j_jeu(5).present
          then
           for i:=1 to 10000 do od;
           pli(cpt_pli):=j_jeu(5).c;
           j_jeu(5).present:=false;
           if j_jeu(5).c.couleur=atout
           then
            atout_joue(j_jeu(5).c.valeur):=true;
           fi;
           call j_jeu(5).c.efface;
           exit;
          fi;
         fi;
         if (j_jeu(6).c.dedans(he,ve))
         then
          if j_jeu(6).present
          then
           for i:=1 to 10000 do od;
           pli(cpt_pli):=j_jeu(6).c;
           j_jeu(6).present:=false;
           if j_jeu(6).c.couleur=atout
           then
            atout_joue(j_jeu(6).c.valeur):=true;
           fi;
           call j_jeu(6).c.efface;
           exit;
          fi;
         fi;
         if (j_jeu(7).c.dedans(he,ve))
         then
          if j_jeu(7).present
          then
           for i:=1 to 10000 do od;
           pli(cpt_pli):=j_jeu(7).c;
           j_jeu(7).present:=false;
           if j_jeu(7).c.couleur=atout
           then
            atout_joue(j_jeu(7).c.valeur):=true;
           fi;
           call j_jeu(7).c.efface;
           exit;
          fi;
         fi;
         if (j_jeu(8).c.dedans(he,ve))
         then
          if j_jeu(8).present
          then
           for i:=1 to 10000 do od;
           pli(cpt_pli):=j_jeu(8).c;
           j_jeu(8).present:=false;
           if j_jeu(8).c.couleur=atout
           then
            atout_joue(j_jeu(8).c.valeur):=true;
           fi;
           call j_jeu(8).c.efface;
           exit;
          fi;
         fi;
      esac;
   od;
   pli(cpt_pli).x:=295;
   pli(cpt_pli).y:=240;
   call pli(cpt_pli).print; 
   for i:=1 to 30000 do od;

  
end jouer_carte;

begin
  return;

   call donne1;
   if not(on_prend)
   then
    oui:=new bouton_relief(260,95,310,125,3,"oui");
    non:=new bouton_relief(330,95,390,125,3,"non");
    call patern(200,55,440,135,gris_clair,plein);
    call patern(200,55,440,135,noir,vide);
    call outstring(235,60,"Desirez-vous prendre ?",noir,gris_clair);
    call oui.print;
    call non.print;
    call tour1;
   fi;
(* 2ieme tour *)      
   if not(on_prend)
   then
    call move(0,0);
    call putmap(image);
    b_pic:=new bouton_relief(210,85,280,125,3,"Pic");
    b_trefle:=new bouton_relief(290,85,360,125,6,"Trefle");
    b_carreau:=new bouton_relief(210,135,280,175,7,"Carreau");
    b_coeur:=new bouton_relief(290,135,360,175,5,"Coeur");
    rien:=new bouton_relief(370,110,430,150,6,"Aucune");
    carre:=new bouton_relief(175,55,465,195,0,"");
    call carre.print;
    call outstring(235,60,"choisissez une couleur ?",noir,gris_clair);
    call b_pic.print;
    call b_trefle.print;
    call b_carreau.print;
    call b_coeur.print;
    call rien.print;
    call tour2;
   fi;
   if on_prend   
   then
    call donne2;
    for n:=1 to 8
    do
     call jouer_carte;
     attach(main);
    od;
   fi;

  attach(main);
end joueur;




Unit adversaire1 : coroutine;
var  i,j,n,cumul,attente : integer;

 Unit donne1 : procedure;
 begin
  for i:=1 to 2
   do
     a1_jeu(i).c:=s.pop;
     a1_jeu(i).present:=true;
   od;
  attach(part);
  for i:=1 to 7000 do od;
  for i:=3 to 5
   do
     a1_jeu(i).c:=s.pop;
     a1_jeu(i).present:=true;
   od;
   fin_donne1:=fin_donne1+1;
   attach(part);
   if fin_donne1=4
   then
    fin_donne1:=0;
    attach(main);
   fi;
 
 end donne1;

 Unit tour1 : procedure;
 begin
   on_prend:=false;
   adv1_prend:=false;
 (* peut-il prendre ? *)  
   cumul:=evalue(carte_ret);
   for i:=1 to 5
   do
    if (a1_jeu(i).c.couleur=carte_ret.couleur)
    then
     cumul:=cumul+evalue(a1_jeu(i).c);
    fi;
   od;
   if (cumul>=50) 
   then
    call outstring(300,26,"EST prend",noir,gris_clair);
    for i:=1 to 27000 do od;
    call outstring(300,26,"             ",noir,gris_clair);    
    adv1_prend:=true;
    on_prend:=true;
    atout:=carte_ret.couleur;
    attach(main);
   else
    call outstring(250,26,"EST ne prend pas ",noir,gris_clair);
    for i:=1 to 27000 do od;
    call outstring(250,26,"                     ",noir,gris_clair);
    attach(part);
   fi;

 end tour1;

 Unit tour2 : procedure;
 begin
  j:=1;
  while ((j<=4) and not(on_prend))
  do
   coul:=j;
   cumul:=0;
   if (coul=/=carte_ret.couleur)
   then
    for i:=1 to 5
    do
     if (a1_jeu(i).c.couleur=coul)
     then
      cumul:=cumul+evalue(a1_jeu(i).c);
     fi;
    od;
    if (cumul>=50) 
    then
     call outstring(300,26,"EST prend",noir,gris_clair);
     for i:=1 to 17000 do od;
     call outstring(300,26,"             ",noir,gris_clair);
     adv1_prend:=true;
     on_prend:=true;
     atout:=coul;
    else
     call outstring(250,26,"EST ne prend pas ",noir,gris_clair);
     for i:=1 to 17000 do od;
     call outstring(250,26,"                     ",noir,gris_clair);
    fi;
   fi;
   j:=j+1;
  od;
  if adv1_prend
  then
   attach(main);
  else
   attach(part);
  fi;

end tour2;

 Unit donne2 : procedure;
 var i : integer;
 begin
   if adv1_prend
    then
      a1_jeu(6).c:=carte_ret;  
      a1_jeu(6).present:=true;
      for i:=7 to 8
       do
         a1_jeu(i).c:=s.pop;
         a1_jeu(i).present:=true;
       od;
    else   
      for i:=6 to 8
       do
         a1_jeu(i).c:=s.pop;
         a1_jeu(i).present:=true;
       od;
   fi;  
   (* belote ou non ? *)
   belote_adversaire1:=false;
   for i:=1 to 8
   do
    if a1_jeu(i).c.couleur=atout and a1_jeu(i).c.valeur=dame
    then
     for j:=1 to 8
     do
      if a1_jeu(j).c.couleur=atout and a1_jeu(j).c.valeur=roi
      then
       belote_adversaire1:=true;
      fi;
     od;
    fi;
   od;

   fin_donne2:=fin_donne2+1;
   attach(part);
   if fin_donne2=4
   then
    fin_donne2:=0;
    attach(main);
   fi;

end donne2;


Unit jouer_carte : procedure;
var trouve,pas_encore : boolean,
    i,remember,forte  : integer;

begin
 i:=1;
 remember:=0;
 trouve:=false;    
 if cpt_pli=1        (* c'est lui qui joue en premier *)
 then
  if adv1_prend or adv2_prend
  then
   (* ils ont pris *)
   (* adv1 joue atout si possible *)
   while i<9 and not trouve
   do
    if a1_jeu(i).c.couleur=atout and a1_jeu(i).present
    then 
     pli(cpt_pli):=a1_jeu(i).c;
     a1_jeu(i).present:=false;
     atout_joue(a1_jeu(i).c.valeur):=true;
     trouve:=true;
    fi;
    i:=i+1;
   od;
   i:=1;
   pas_encore:=true;
   while i<9 and not trouve
   do
    (* adv1 n'a pas d'atout, alors il joue as sinon indien *)
    if a1_jeu(i).present
    then
     if pas_encore
     then
      pli(cpt_pli):=a1_jeu(i).c;
      remember:=i;
      pas_encore:=false;
      if pli(cpt_pli).valeur=as
      then 
       trouve:=true;
      fi;
     else
      (* il n'a pas encore trouve d'as, et il lui reste des cartes
         a comparer *)
      if a1_jeu(i).c.valeur=as
      then
       pli(cpt_pli):=a1_jeu(i).c;
       remember:=i;
       trouve:=true;
      else
       (* si toujours pas d'as, il prend la plus petite de son jeu *)
       if pli(cpt_pli).valeur>a1_jeu(i).c.valeur
       then
        pli(cpt_pli):=a1_jeu(i).c;
        remember:=i;
       fi;
      fi;
     fi;
    fi;
    i:=i+1;
   od;
   (* il joue donc la carte nø remember *)
   if remember<>0
   then
    a1_jeu(remember).present:=false;
    if a1_jeu(remember).c.couleur=atout
    then
     atout_joue(a1_jeu(remember).c.valeur):=true;
    fi;
   fi;
  else
   (* Ils n'ont pas pris *)
   i:=1;
   pas_encore:=true;
   while i<9 and not trouve
   do
    (* adv1 joue as sinon indien different d'atout *)
    if a1_jeu(i).c.couleur<>atout
    then
     if a1_jeu(i).present
     then
      if pas_encore
      then
       pli(cpt_pli):=a1_jeu(i).c;
       remember:=i;
       pas_encore:=false;
       if pli(cpt_pli).valeur=as
       then 
        trouve:=true;
        a1_jeu(remember).present:=false;
        if a1_jeu(remember).c.couleur=atout
        then
         atout_joue(a1_jeu(remember).c.valeur):=true;
        fi;
       fi;
      else
       (* il n'a pas encore trouve d'as, et il lui reste des cartes
          a comparer *)
       if a1_jeu(i).c.valeur=as
       then
        pli(cpt_pli):=a1_jeu(i).c;
        remember:=i;
        a1_jeu(remember).present:=false;
        if a1_jeu(remember).c.couleur=atout
        then
         atout_joue(a1_jeu(remember).c.valeur):=true;
        fi;
        trouve:=true;
       else
        (* si toujours pas d'as, il prend la plus petite carte de son jeu *)
        if pli(cpt_pli).valeur>a1_jeu(i).c.valeur
        then
         pli(cpt_pli):=a1_jeu(i).c;
         remember:=i;
        fi;
       fi;
      fi;
     fi;
    fi;
    i:=i+1;
   od;
   if remember=0
   then
    (* il ne lui reste que de l'atout *)
    (* il est donc oblige de jouer atout *)
    i:=1;
    while i<9
    do
     (* adv1 joue le plus petit atout *)
     if a1_jeu(i).present
     then
      if remember=0
      then
       remember:=i;
      else
       if not compare_atout(a1_jeu(i).c.valeur,a1_jeu(remember).c.valeur)
        (*  a1_jeu(i).c.valeur<a1_jeu(remember).c.valeur *)
       then
        remember:=i;
       fi;
      fi;
     fi;
     i:=i+1;
    od;
   fi;
   a1_jeu(remember).present:=false;
   if a1_jeu(remember).c.couleur=atout
   then
    atout_joue(a1_jeu(remember).c.valeur):=true;
   fi;
   pli(cpt_pli):=a1_jeu(remember).c;
  fi;
 else    (* s'il ne joue pas en premier .............................. *)     
  i:=1;
  if pli(1).couleur<>atout
  then
   pas_encore:=true;
   while i<9 and not trouve
   do
    (* Il joue as sinon indien dans couleur demandee different d'atout *)
    if a1_jeu(i).present and a1_jeu(i).c.couleur=pli(1).couleur
    then
     if pas_encore
     then
      remember:=i;
      pas_encore:=false;
      if a1_jeu(remember).c.valeur=as
      then 
       trouve:=true;
      fi;
     else
      (* il n'a pas encore trouve d'as, et il lui reste des cartes
        a comparer *)
      if a1_jeu(i).c.valeur=as
      then
       remember:=i;
       trouve:=true;
      else
       (* si toujours pas d'as, il prend la plus petite de son jeu *)
       if a1_jeu(remember).c.valeur>a1_jeu(i).c.valeur
       then
        remember:=i;
       fi;
      fi;
     fi;
    fi;
    i:=i+1;
   od;
   if remember=0
   then
    (* il n'a pas de la couleur demandee, il essaie de jouer atout *)
    i:=1;
    while i<9
    do
     (* adv1 joue le plus petit atout *)
     if a1_jeu(i).present and a1_jeu(i).c.couleur=atout
     then
      if remember=0
      then
       remember:=i;
      else
       if not compare_atout(a1_jeu(i).c.valeur,a1_jeu(remember).c.valeur)
       then
        remember:=i;
       fi;
      fi;
     fi;
     i:=i+1;
    od;
    if remember=0
    then
     (* il ne peut pas couper *)
     i:=1;
     while i<9
     do
      (* adv1 joue sa plus petite carte *)
      if a1_jeu(i).present 
      then
       if remember=0
       then
        remember:=i;
       else
        if a1_jeu(i).c.valeur<a1_jeu(remember).c.valeur
        then
         remember:=i;
        fi;
       fi;
      fi;
      i:=i+1;
     od;
    fi;
   fi;
  else 
   (* c'est atout demandee *)
   (* il est oblige de monter *)
   forte:=0;
   for i:=1 to cpt_pli
   do
    if pli(i).couleur=atout
    then
     if not compare_atout(forte,pli(i).valeur)
     then 
      forte:=pli(i).valeur
     fi;
    fi;
   od;
   i:=1;
   while i<9 and not trouve
   do
    if a1_jeu(i).present and a1_jeu(i).c.couleur=atout
    then
     if remember=0
     then
      remember:=i;
      if compare_atout(a1_jeu(i).c.valeur,forte)
      then 
       trouve:=true;
      fi;
     else
      if compare_atout(a1_jeu(i).c.valeur,forte)
      then
       remember:=i;
       trouve:=true;
      else
       if not compare_atout(a1_jeu(i).c.valeur,a1_jeu(remember).c.valeur)
       then
        remember:=i;
       fi;
      fi;
     fi;
    fi;
    i:=i+1;
   od;
   if remember=0
   then
    (* adv1 n'a pas d'atout, il joue un indien *)
    i:=1;
    while i<9
    do
     (* adv1 joue sa plus petite carte *)
     if a1_jeu(i).present 
     then
      if remember=0
      then
       remember:=i;
      else
       if a1_jeu(i).c.valeur<a1_jeu(remember).c.valeur
       then
        remember:=i;
       fi;
      fi;
     fi;
     i:=i+1;
    od;
   fi;
  fi;
  pli(cpt_pli):=a1_jeu(remember).c;
  a1_jeu(remember).present:=false;
  if a1_jeu(remember).c.couleur=atout
  then
   atout_joue(a1_jeu(remember).c.valeur):=true;
  fi;
 fi;
 pli(cpt_pli).x:=400;
 pli(cpt_pli).y:=170;
 call pli(cpt_pli).print; 
 for i:=1 to 30000 do od;
 
end jouer_carte;


begin
  return;

  call donne1;
   if not(on_prend)
   then
       call tour1;
   fi;
(* 2ieme tour *)      
   if not(on_prend)
   then
       call tour2;
   fi;
   if on_prend
   then
    call donne2;
    for n:=1 to 8
    do
     call jouer_carte;
     attach(main);
    od;
   fi;

  attach(main);   
end adversaire1;


Unit partenaire : coroutine;
var i,j,n,cumul : integer;

 Unit donne1 : procedure;
 begin
  for i:=1 to 2
   do
     p_jeu(i).c:=s.pop;
     p_jeu(i).present:=true;
   od;
  for i:=1 to 7000 do od;
  attach(adv2);
  for i:=1 to 7000 do od;
  for i:=3 to 5
   do
     p_jeu(i).c:=s.pop;
     p_jeu(i).present:=true;
   od;
  for i:=1 to 7000 do od;
  fin_donne1:=fin_donne1+1;
  attach(adv2);
  if fin_donne1=4
  then
   fin_donne1:=0;
   attach(main);
  fi;


 end donne1;

 Unit tour1 : procedure;
 begin
  on_prend:=false;
  part_prend:=false;
 (* peut-il prendre ? *)  
  cumul:=evalue2(carte_ret);
  for i:=1 to 5
   do
    if (p_jeu(i).c.couleur=carte_ret.couleur)
    then
     cumul:=cumul+evalue2(p_jeu(i).c);
    fi;
   od;
   if (cumul>=50) 
   then
    call outstring(300,26,"NORD prend",noir,gris_clair);
    for i:=1 to 27000 do od;
    call outstring(300,26,"            ",noir,gris_clair);
    part_prend:=true;
    on_prend:=true;
    atout:=carte_ret.couleur;
    attach(main);
   else
    call outstring(250,26,"NORD ne prend pas ",noir,gris_clair);
    for i:=1 to 27000 do od;
    call outstring(250,26,"                    ",noir,gris_clair);
    attach(adv2);
   fi;

end tour1;

Unit tour2 : procedure;
begin
   j:=1;
   while ((j<=4) and not(on_prend))
   do
   coul:=j;
   cumul:=0;
   if (coul=/=carte_ret.couleur)
   then
    for i:=1 to 5
    do
     if (p_jeu(i).c.couleur=coul)
     then
      cumul:=cumul+evalue2(p_jeu(i).c);
     fi;
    od;
    if (cumul>=50) 
    then
     call outstring(300,26,"NORD prend",noir,gris_clair);
     for i:=1 to 17000 do od;
     call outstring(300,26,"            ",noir,gris_clair);
     part_prend:=true;
     on_prend:=true;
     atout:=coul;
    else
     call outstring(250,26,"NORD ne prend pas ",noir,gris_clair);
     for i:=1 to 17000 do od;
     call outstring(250,26,"                    ",noir,gris_clair);
    fi;
   fi;
   j:=j+1;
  od;
  if part_prend
  then
   attach(main);
  else
   attach(adv2);
  fi;

end tour2;

Unit donne2 : procedure;
 var i : integer;
 begin
   if part_prend
    then
      p_jeu(6).c:=carte_ret;  
      p_jeu(6).present:=true;
      for i:=7 to 8
       do
         p_jeu(i).c:=s.pop;
         p_jeu(i).present:=true;
       od;
    else   
      for i:=6 to 8
       do
         p_jeu(i).c:=s.pop;
         p_jeu(i).present:=true;
       od;
   fi;  
   belote_partenaire:=false;
   for i:=1 to 8
   do
    if p_jeu(i).c.couleur=atout and p_jeu(i).c.valeur=dame
    then
     for j:=1 to 8
     do
      if p_jeu(j).c.couleur=atout and p_jeu(j).c.valeur=roi
      then
       belote_partenaire:=true;
      fi;
     od;
    fi;
   od;

   fin_donne2:=fin_donne2+1;
   attach(adv2);
   if fin_donne2=4
   then
    fin_donne2:=0;
    attach(main);
   fi;

end donne2;

Unit jouer_carte : procedure;
var trouve,pas_encore                    : boolean,
    i,remember,forte,grand,petit,maitre  : integer;

begin
 i:=1;
 remember:=0;
 trouve:=false;    
 if cpt_pli=1        (* c'est lui qui joue en premier *)
 then
  if joueur_prend or part_prend
  then
   (* ils ont pris *)
   (* part joue atout si possible *)
   grand:=0;
   petit:=0;
   while i<9
   do
    if p_jeu(i).present
    then
     if p_jeu(i).c.couleur=atout and grand=0
     then
      grand:=i;
      petit:=i;
     else
      if p_jeu(i).c.couleur=atout
      then
       if compare_atout(p_jeu(i).c.valeur,p_jeu(grand).c.valeur)
       then
        grand:=i;
       fi;
       if not compare_atout(p_jeu(i).c.valeur,p_jeu(petit).c.valeur)
       then
        petit:=i;
       fi;
      fi;
     fi;
    fi;
    i:=i+1;
   od;
   if grand<>0
   then
    maitre:=at_fort;
    if p_jeu(grand).c.valeur=maitre
    then
     remember:=grand;
    else
     remember:=petit;
    fi;
    pli(cpt_pli):=p_jeu(remember).c;
   fi;
   i:=1;
   pas_encore:=true;
   while i<9 and not trouve and grand=0
   do
    (* part n'a pas d'atout, alors il joue as sinon indien *)
    if p_jeu(i).present
    then
     if pas_encore
     then
     pli(cpt_pli):=p_jeu(i).c;
      remember:=i;
      pas_encore:=false;
      if pli(cpt_pli).valeur=as
      then 
      trouve:=true;
      fi;
     else
      (* il n'a pas encore trouve d'as, et il lui reste des cartes
         a comparer *)
      if p_jeu(i).c.valeur=as
      then
       pli(cpt_pli):=p_jeu(i).c;
       remember:=i;
       trouve:=true;
      else
       (* si toujours pas d'as, il prend la plus petite de son jeu *)
       if pli(cpt_pli).valeur>p_jeu(i).c.valeur
       then
        pli(cpt_pli):=p_jeu(i).c;
        remember:=i;
       fi;
      fi;
     fi;
    fi;
    i:=i+1;
   od;
   (* il joue donc la carte nø remember *)
   if remember<>0
   then
    p_jeu(remember).present:=false;
   fi;
  else
   (* Ils n'ont pas pris *)
   i:=1;
   pas_encore:=true;
   while i<9 and not trouve
   do
    (* part joue as sinon indien different d'atout *)
    if p_jeu(i).c.couleur<>atout
    then
     if p_jeu(i).present
     then
      if pas_encore
      then
       pli(cpt_pli):=p_jeu(i).c;
       remember:=i;
       pas_encore:=false;
       if pli(cpt_pli).valeur=as
       then 
        trouve:=true;
        p_jeu(remember).present:=false;
       fi;
      else
       (* il n'a pas encore trouve d'as, et il lui reste des cartes
          a comparer *)
       if p_jeu(i).c.valeur=as
       then
        pli(cpt_pli):=p_jeu(i).c;
        remember:=i;
        p_jeu(remember).present:=false;
        trouve:=true;
       else
        (* si toujours pas d'as, il prend la plus petite carte de son jeu *)
        if pli(cpt_pli).valeur>p_jeu(i).c.valeur
        then
         pli(cpt_pli):=p_jeu(i).c;
         remember:=i;
        fi;
       fi;
      fi;
     fi;
    fi;
    i:=i+1;
   od;
   if remember=0
   then
    (* il ne lui reste que de l'atout *)
    (* il est donc oblige de jouer atout *)
    i:=1;
    while i<9
    do
     (* part joue le plus petit atout *)
     if p_jeu(i).present
     then
      if remember=0
      then
       remember:=i;
      else
       if not compare_atout(p_jeu(i).c.valeur,p_jeu(remember).c.valeur)
        (*  p_jeu(i).c.valeur<p_jeu(remember).c.valeur *)
       then
        remember:=i;
       fi;
      fi;
     fi;
     i:=i+1;
    od;
   fi;
   p_jeu(remember).present:=false;
   pli(cpt_pli):=p_jeu(remember).c;
  fi;
 else    (* s'il ne joue pas en premier .............................. *)     
  i:=1;
  if pli(1).couleur<>atout
  then
   pas_encore:=true;
   while i<9 and not trouve
   do
    (* Il joue as sinon indien dans couleur demandee different d'atout *)
    if p_jeu(i).present and p_jeu(i).c.couleur=pli(1).couleur
    then
     if pas_encore
     then
      remember:=i;
      pas_encore:=false;
      if p_jeu(remember).c.valeur=as
      then 
       trouve:=true;
      fi;
     else
      (* il n'a pas encore trouve d'as, et il lui reste des cartes
        a comparer *)
      if p_jeu(i).c.valeur=as
      then
       remember:=i;
       trouve:=true;
      else
       (* si toujours pas d'as, il prend la plus petite de son jeu *)
       if p_jeu(remember).c.valeur>p_jeu(i).c.valeur
       then
        remember:=i;
       fi;
      fi;
     fi;
    fi;
    i:=i+1;
   od;
   if remember=0
   then
    (* il n'a pas de la couleur demandee, il essaie de jouer atout *)
    i:=1;
    while i<9
    do
     (* part joue le plus petit atout *)
     if p_jeu(i).present and p_jeu(i).c.couleur=atout
     then
      if remember=0
      then
       remember:=i;
      else
       if not compare_atout(p_jeu(i).c.valeur,p_jeu(remember).c.valeur)
       then
        remember:=i;
       fi;
      fi;
     fi;
     i:=i+1;
    od;
    if remember=0
    then
     (* il ne peut pas couper *)
     i:=1;
     while i<9
     do
      (* part joue sa plus petite carte *)
      if p_jeu(i).present 
      then
       if remember=0
       then
        remember:=i;
       else
        if p_jeu(i).c.valeur<p_jeu(remember).c.valeur
        then
         remember:=i;
        fi;
       fi;
      fi;
      i:=i+1;
     od;
    fi;
   fi;
  else 
   (* c'est atout demandee *)
   (* il est oblige de monter *)
   forte:=0;
   for i:=1 to cpt_pli
   do
    if pli(i).couleur=atout
    then
     if not compare_atout(forte,pli(i).valeur)
     then 
      forte:=pli(i).valeur
     fi;
    fi;
   od;
   i:=1;
   while i<9 and not trouve
   do
    if p_jeu(i).present and p_jeu(i).c.couleur=atout
    then
     if remember=0
     then
      remember:=i;
      if compare_atout(p_jeu(i).c.valeur,forte)
      then 
       trouve:=true;
      fi;
     else
      if compare_atout(p_jeu(i).c.valeur,forte)
      then
       remember:=i;
       trouve:=true;
      else
       if not compare_atout(p_jeu(i).c.valeur,p_jeu(remember).c.valeur)
       then
        remember:=i;
       fi;
      fi;
     fi;
    fi;
    i:=i+1;
   od;
   if remember=0
   then
    (* part n'a pas d'atout, il joue un indien *)
    i:=1;
    while i<9
    do
     (* part joue sa plus petite carte *)
     if p_jeu(i).present 
     then
      if remember=0
      then
       remember:=i;
      else
       if p_jeu(i).c.valeur<p_jeu(remember).c.valeur
       then
        remember:=i;
       fi;
      fi;
     fi;
     i:=i+1;
    od;
   fi;
  fi;
  pli(cpt_pli):=p_jeu(remember).c;
  p_jeu(remember).present:=false;
 fi;
 if remember<>0
 then
  if p_jeu(remember).c.couleur=atout
  then
   atout_joue(p_jeu(remember).c.valeur):=true;
  fi;
 fi;
 

 pli(cpt_pli).x:=295;
 pli(cpt_pli).y:=100;
 call pli(cpt_pli).print; 
 for i:=1 to 30000 do od;

end jouer_carte;

begin
  return;

  call donne1;
  if not(on_prend)
    then
       call tour1;
  fi;
(* 2ieme tour *)      
   if not(on_prend)
   then
       call tour2;
   fi;

   if on_prend
   then    
    call donne2;
    for n:=1 to 8
    do
     call jouer_carte;
     attach(main);
    od;
   fi;


  attach(main);
end partenaire;




Unit adversaire2 : coroutine;
var i,j,n,cumul : integer;

 Unit donne1 : procedure;
 begin
  for i:=1 to 2
    do
      a2_jeu(i).c:=s.pop;
      a2_jeu(i).present:=true;
    od;
  for i:=1 to 7000 do od;
  attach(user);
  for i:=1 to 7000 do od;
  for i:=3 to 5
    do
      a2_jeu(i).c:=s.pop;
      a2_jeu(i).present:=true;
    od;
  for i:=1 to 7000 do od;
  fin_donne1:=fin_donne1+1;
  attach(user);
  if fin_donne1=4
  then
   fin_donne1:=0;
   attach(main);
  fi;

 end donne1;

 Unit tour1 : procedure;
 begin
  on_prend:=false;
  adv2_prend:=false;
 (* peut-il prendre ? *)  
  cumul:=evalue(carte_ret);
  for i:=1 to 5
   do
    if (a2_jeu(i).c.couleur=carte_ret.couleur)
    then
     cumul:=cumul+evalue(a2_jeu(i).c);
    fi;
   od;
   if (cumul>=50) 
   then
    call outstring(290,26,"OUEST prend",noir,gris_clair);
    for i:=1 to 27000 do od;
    call outstring(290,26,"                ",noir,gris_clair);
    adv2_prend:=true;
    on_prend:=true;
    atout:=carte_ret.couleur;
    attach(main);
   else
    call outstring(240,26,"OUEST ne prend pas",noir,gris_clair);
    for i:=1 to 27000 do od;
    call outstring(240,26,"                       ",noir,gris_clair);
    attach(user);   
   fi;

   (* attach(user); *)

end tour1;

Unit tour2 : procedure;
begin
   j:=1;
   while ((j<=4) and not(on_prend))
   do
   coul:=j;
   cumul:=0;
   if (coul=/=carte_ret.couleur)
   then
    for i:=1 to 5
    do
     if (a2_jeu(i).c.couleur=coul)
     then
      cumul:=cumul+evalue(a2_jeu(i).c);
     fi;
    od;
    if (cumul>=50) 
    then
     call outstring(290,26,"OUEST prend",noir,gris_clair);
     for i:=1 to 17000 do od;
     call outstring(290,26,"                ",noir,gris_clair);
     adv2_prend:=true;
     on_prend:=true;
     atout:=coul;
    else
     call outstring(240,26,"OUEST ne prend pas",noir,gris_clair);
     for i:=1 to 17000 do od;
     call outstring(240,26,"                       ",noir,gris_clair);
    fi;
   fi;
   j:=j+1;
  od;
  if adv2_prend
  then
   attach(main);
  else
   attach(user);
  fi;

end tour2;

 Unit donne2 : procedure;
 var i : integer;
 begin
   if adv2_prend
    then
      a2_jeu(6).c:=carte_ret;  
      a2_jeu(6).present:=true;
      for i:=7 to 8
       do
         a2_jeu(i).c:=s.pop;
         a2_jeu(i).present:=true;
       od;
    else   
      for i:=6 to 8
       do
         a2_jeu(i).c:=s.pop;
         a2_jeu(i).present:=true;
       od;
   fi;  
   belote_adversaire2:=false;
   for i:=1 to 8
   do
    if a2_jeu(i).c.couleur=atout and a2_jeu(i).c.valeur=dame
    then
     for j:=1 to 8
     do
      if a2_jeu(j).c.couleur=atout and a2_jeu(j).c.valeur=roi
      then
       belote_adversaire2:=true;
      fi;
     od;
    fi;
   od;

   fin_donne2:=fin_donne2+1;
   attach(user);
   if fin_donne2=4
   then
    fin_donne2:=0;
    attach(main);
   fi;
   
end donne2;

Unit jouer_carte : procedure;
var trouve,pas_encore                    : boolean,
    i,remember,forte,grand,petit,maitre  : integer;

begin
 i:=1;
 remember:=0;
 trouve:=false;    
 if cpt_pli=1        (* c'est lui qui joue en premier *)
 then
  if adv1_prend or adv2_prend
  then
   (* ils ont pris *)
   (* adv2 joue atout si possible *)
   grand:=0;
   petit:=0;
   while i<9
   do
    if a2_jeu(i).present
    then
     if a2_jeu(i).c.couleur=atout and grand=0
     then
      grand:=i;
      petit:=i;
     else
      if a2_jeu(i).c.couleur=atout
      then
       if compare_atout(p_jeu(i).c.valeur,a2_jeu(grand).c.valeur)
       then
        grand:=i;
       fi;
       if not compare_atout(a2_jeu(i).c.valeur,a2_jeu(petit).c.valeur)
       then
        petit:=i;
       fi;
      fi;
     fi;
    fi;
    i:=i+1;
   od;
   if grand<>0
   then
    maitre:=at_fort;
    if a2_jeu(grand).c.valeur=maitre
    then
     remember:=grand;
    else
     remember:=petit;
    fi;
    pli(cpt_pli):=a2_jeu(remember).c;
   fi;
   i:=1;
   pas_encore:=true;
   while i<9 and not trouve
   do
    (* adv2 n'a pas d'atout, alors il joue as sinon indien *)
    if a2_jeu(i).present
    then
     if pas_encore
     then
      pli(cpt_pli):=a2_jeu(i).c;
      remember:=i;
      pas_encore:=false;
      if pli(cpt_pli).valeur=as
      then 
       trouve:=true;
      fi;
     else
      (* il n'a pas encore trouve d'as, et il lui reste des cartes
         a comparer *)
      if a2_jeu(i).c.valeur=as
      then
       pli(cpt_pli):=a2_jeu(i).c;
       remember:=i;
       trouve:=true;
      else
       (* si toujours pas d'as, il prend la plus petite de son jeu *)
       if pli(cpt_pli).valeur>a2_jeu(i).c.valeur
       then
        pli(cpt_pli):=a2_jeu(i).c;
        remember:=i;
       fi;
      fi;
     fi;
    fi;
    i:=i+1;
   od;
   (* il joue donc la carte nø remember *)
   if remember<>0
   then
    a2_jeu(remember).present:=false;
   fi;
  else
   (* Ils n'ont pas pris *)
   i:=1;
   pas_encore:=true;
   while i<9 and not trouve
   do
    (* adv2 joue as sinon indien different d'atout *)
    if a2_jeu(i).c.couleur<>atout
    then
     if a2_jeu(i).present
     then
      if pas_encore
      then
       pli(cpt_pli):=a2_jeu(i).c;
       remember:=i;
       pas_encore:=false;
       if pli(cpt_pli).valeur=as
       then 
        trouve:=true;
        a2_jeu(remember).present:=false;
       fi;
      else
       (* il n'a pas encore trouve d'as, et il lui reste des cartes
          a comparer *)
       if a2_jeu(i).c.valeur=as
       then
        pli(cpt_pli):=a2_jeu(i).c;
        remember:=i;
        a2_jeu(remember).present:=false;
        trouve:=true;
       else
        (* si toujours pas d'as, il prend la plus petite carte de son jeu *)
        if pli(cpt_pli).valeur>a2_jeu(i).c.valeur
        then
         pli(cpt_pli):=a2_jeu(i).c;
         remember:=i;
        fi;
       fi;
      fi;
     fi;
    fi;
    i:=i+1;
   od;
   if remember=0
   then
    (* il ne lui reste que de l'atout *)
    (* il est donc oblige de jouer atout *)
    i:=1;
    while i<9
    do
     (* adv2 joue le plus petit atout *)
     if a2_jeu(i).present
     then
      if remember=0
      then
       remember:=i;
      else
       if not compare_atout(a2_jeu(i).c.valeur,a2_jeu(remember).c.valeur)
        (*  a2_jeu(i).c.valeur<a2_jeu(remember).c.valeur *)
       then
        remember:=i;
       fi;
      fi;
     fi;
     i:=i+1;
    od;
   fi;
   a2_jeu(remember).present:=false;
   pli(cpt_pli):=a2_jeu(remember).c;
  fi;
 else    (* s'il ne joue pas en premier .............................. *)     
  i:=1;
  if pli(1).couleur<>atout
  then
   pas_encore:=true;
   while i<9 and not trouve
   do
    (* Il joue as sinon indien dans couleur demandee different d'atout *)
    if a2_jeu(i).present and a2_jeu(i).c.couleur=pli(1).couleur
    then
     if pas_encore
     then
      remember:=i;
      pas_encore:=false;
      if a2_jeu(remember).c.valeur=as
      then 
       trouve:=true;
      fi;
     else
      (* il n'a pas encore trouve d'as, et il lui reste des cartes
        a comparer *)
      if a2_jeu(i).c.valeur=as
      then
       remember:=i;
       trouve:=true;
      else
       (* si toujours pas d'as, il prend la plus petite de son jeu *)
       if a2_jeu(remember).c.valeur>a2_jeu(i).c.valeur
       then
        remember:=i;
       fi;
      fi;
     fi;
    fi;
    i:=i+1;
   od;
   if remember=0
   then
    (* il n'a pas de la couleur demandee, il essaie de jouer atout *)
    i:=1;
    while i<9
    do
     (* adv2 joue le plus petit atout *)
     if a2_jeu(i).present and a2_jeu(i).c.couleur=atout
     then
      if remember=0
      then
       remember:=i;
      else
       if not compare_atout(a2_jeu(i).c.valeur,a2_jeu(remember).c.valeur)
       then
        remember:=i;
       fi;
      fi;
     fi;
     i:=i+1;
    od;
    if remember=0
    then
     (* il ne peut pas couper *)
     i:=1;
     while i<9
     do
      (* adv2 joue sa plus petite carte *)
      if a2_jeu(i).present 
      then
       if remember=0
       then
        remember:=i;
       else
        if a2_jeu(i).c.valeur<a2_jeu(remember).c.valeur
        then
         remember:=i;
        fi;
       fi;
      fi;
      i:=i+1;
     od;
    fi;
   fi;
  else 
   (* c'est atout demandee *)
   (* il est oblige de monter *)
   forte:=0;
   for i:=1 to cpt_pli
   do
    if pli(i).couleur=atout
    then
     if not compare_atout(forte,pli(i).valeur)
     then 
      forte:=pli(i).valeur
     fi;
    fi;
   od;
   i:=1;
   while i<9 and not trouve
   do
    if a2_jeu(i).present and a2_jeu(i).c.couleur=atout
    then
     if remember=0
     then
      remember:=i;
      if compare_atout(a2_jeu(i).c.valeur,forte)
      then 
       trouve:=true;
      fi;
     else
      if compare_atout(a2_jeu(i).c.valeur,forte)
      then
       remember:=i;
       trouve:=true;
      else
       if not compare_atout(a2_jeu(i).c.valeur,a2_jeu(remember).c.valeur)
       then
        remember:=i;
       fi;
      fi;
     fi;
    fi;
    i:=i+1;
   od;
   if remember=0
   then
    (* adv2 n'a pas d'atout, il joue un indien *)
    i:=1;
    while i<9
    do
     (* adv2 joue sa plus petite carte *)
     if a2_jeu(i).present 
     then
      if remember=0
      then
       remember:=i;
      else
       if a2_jeu(i).c.valeur<a2_jeu(remember).c.valeur
       then
        remember:=i;
       fi;
      fi;
     fi;
     i:=i+1;
    od;
   fi;
  fi;
  pli(cpt_pli):=a2_jeu(remember).c;
  a2_jeu(remember).present:=false;
 fi;
 if remember<>0
 then
  if a2_jeu(remember).c.couleur=atout
  then
   atout_joue(a2_jeu(remember).c.valeur):=true;
  fi;
 fi;


 pli(cpt_pli).x:=190;
 pli(cpt_pli).y:=170;
 call pli(cpt_pli).print; 
 for i:=1 to 30000 do od;

end jouer_carte;

begin
  return;

  call donne1;
  if not(on_prend)
   then
       call tour1;
  fi;
(* 2ieme tour *)      
  if not(on_prend)
   then
       call tour2;
  fi;
  if on_prend
  then
   call donne2;
   for n:=1 to 8
   do
    call jouer_carte;
    attach(main);
   od;
  fi;

  attach(main);
end adversaire2;

(* *********************** fin des coroutines ************************* *)


        (*************************************)
        (*     On coupe le jeu de cartes     *) 
        (*************************************) 


Unit COUPE_JEU : procedure;
var i,j        : integer,
    tmp1,tmp2  : pile;
begin
  tmp1:=new pile;
  tmp2:=new pile;
  call RANSET(1000);
  i:=entier(RANDOM*32);
  if i<3 or i>29
  then
   i:=15;
  fi;
  for j:=1 to i
  do
   call tmp1.push(s.pop);
  od;
  while not s.empty
  do
   call tmp2.push(s.pop);
  od;
  while not tmp1.empty
  do
   call s.push(tmp1.pop);
  od;
  while not tmp2.empty
  do
   call s.push(tmp2.pop);
  od;
  kill(tmp1);
  kill(tmp2);

end coupe_jeu;


        (*************************************)
        (*     Melange du jeu de cartes      *) 
        (*************************************) 

Unit MELANGE : procedure;
var
 tab : arrayof carte,
 tampon : carte,
 a,b,i,j,attente : integer;

begin
 array tab dim(0:31);
 tab(0):=P1;
 tab(1):=P2;
 tab(2):=P3;
 tab(3):=P4;
 tab(4):=P5;
 tab(5):=P6;
 tab(6):=P7;
 tab(7):=P8;
 tab(8):=T1;
 tab(9):=T2;
 tab(10):=T3;
 tab(11):=T4;
 tab(12):=T5;
 tab(13):=T6;
 tab(14):=T7;
 tab(15):=T8;
 tab(16):=CA1;
 tab(17):=CA2;
 tab(18):=CA3;
 tab(19):=CA4;
 tab(20):=CA5;
 tab(21):=CA6;
 tab(22):=CA7;
 tab(23):=CA8;
 tab(24):=CO1;
 tab(25):=CO2;
 tab(26):=CO3;
 tab(27):=CO4;
 tab(28):=CO5;
 tab(29):=CO6;
 tab(30):=CO7;
 tab(31):=CO8;
 for a:=1 to 10
 do
  call RANSET(1000);
  i:=entier(RANDOM*10);
  for attente:=1 to 2000 do od;
  call RANSET(1500);
  j:=entier(RANDOM*10);
  for b:=1 to 15
  do
   tampon:=tab(i);
   tab(i):=tab((i+j) mod 31);
   tab((i+j) mod 31):=tampon;
   i:=(i+4) mod 31;
   j:=(j+3) mod 31;
   tampon:=tab(i);
   tab(i):=tab((i+j) mod 31);
   tab((i+j) mod 31):=tampon;
   i:=(i+1) mod 31;
   j:=(j+7) mod 31;
  od;
 od;
 for a:=0 to 31 
 do
  call s.push(tab(a));
 od;

end melange;

        (**************************************************)
        (*    Renvoie la valeur de l'atout le plus fort   *) 
        (*         qui n'a pas encore ete joue            *)
        (**************************************************) 

Unit AT_FORT : function : integer;
begin
 if not atout_joue(valet)
 then
  result:=valet;
 else
  if not atout_joue(neuf)
  then
   result:=neuf;
  else
   for i:=8 downto 1
   do
    if not atout_joue(i)
    then
     result:=i;
    fi;
   od;
  fi;
 fi;
end at_fort;




        (**************************************************)
        (*    Ordre de croissance des cartes a l'atout    *) 
        (*          --> retourne vrai si c1>c2            *)
        (**************************************************) 

Unit COMPARE_ATOUT : function(c1,c2 : integer): boolean;
begin
 if c1=valet
 then 
  result:=true;
 else 
  if c2=valet
  then
   result:=false;
  else
   if c1=neuf
   then 
    result:=true;
   else 
    if c2=neuf
    then
     result:=false;
    else
     (* il n'y a ni valet ni neuf *)
     if c1>c2
     then
      result:=true;
     else
      result:=false;
     fi;
    fi;
   fi;
  fi;
 fi;
end compare_atout;

        (**************************************************)
        (*     Attribue une valeur pour chaque carte      *) 
        (**************************************************) 
        
Unit EVALUE : function(c : carte): integer;
begin
 case c.valeur
  when sept : result:=5;
  when huit : result:=7;
  when dame : result:=10;
  when roi  : result:=13;
  when dix  : result:=15;
  when as   : result:=18;
  when neuf : result:=22;
  when valet: result:=30;
 esac;
end evalue;

        (**************************************************)
        (*     Attribue une valeur pour chaque carte      *) 
        (**************************************************) 
        
Unit EVALUE2 : function(c : carte): integer;
begin
 case c.valeur
  when sept : result:=4;
  when huit : result:=4;
  when dame : result:=6;
  when roi  : result:=6;
  when dix  : result:=10;
  when as   : result:=15;
  when neuf : result:=15;
  when valet: result:=25;
 esac;
end evalue2;

        (*************************************)
        (*         Affichage du menu         *)
        (*************************************) 

Unit PREMIER_MENU : procedure;
begin
 b_option:=new bouton_relief(280,140,360,180,6,"Option");
 b_debut:=new bouton_relief(280,200,360,240,5,"Jouer");
 b_fin:=new bouton_relief(280,260,360,300,7,"Quitter");
 call patern(220,50,420,320,gris_clair,plein);
 call patern(220,50,420,320,gris_fonce,vide);
 call patern(221,51,419,51,gris_fonce,plein);
 call patern(222,52,418,52,gris_fonce,plein);
 call patern(221,51,221,319,gris_fonce,plein);
 call patern(222,52,222,318,gris_fonce,plein);
 call patern(419,51,419,319,gris_fonce,plein);
 call patern(418,52,418,318,gris_fonce,plein);
 call patern(221,319,419,319,gris_fonce,plein);
 call patern(222,318,418,318,gris_fonce,plein);
 
 call outstring(293,70,"M E N U",noir,gris_clair);
 call patern(285,85,355,85,noir,plein);
 call outstring(275,90 ,"JYL & REDGE ",noir,gris_clair);
 call outstring(275,105,"    1995 ",noir,gris_clair);
 call b_option.print;
 call b_debut.print;
 call b_fin.print;
 call patern(0,0,640,40,gris_clair,plein);
 (* affichage des bandes de commentaires en gris du haut *)
 call move(0,20);
 call color(noir);
 call draw(640,20);
 call move(0,40);
 call draw(640,40);
 call outstring(270,4,"B-E-L-O-T-E",noir,gris_clair);
 (* sauvegarde menu *)
 call move(100,50);
 save_menu:=getmap(540,370);
 call menu;
end premier_menu;


        (*************************************)
        (*                MENU               *)
        (*************************************) 

Unit MENU : procedure;
var h,v,p,l,r,c          : integer,
    d                    : boolean;
begin
 call move(100,50);
 call putmap(save_menu);
 d:=false;
  do
   d:=getpress(h,v,p,l,r,c);
   case (c)
    when 1 : 
     if b_option.dedans(h,v)
     then
      call b_option.choix;
      call option;
     else
      if b_debut.dedans(h,v)
      then
       call b_debut.choix;
       (* affichage des bandes de commentaires en gris du haut *)
       call move(0,20);
       call color(noir);
       call draw(640,20);
       call move(0,40);
       call draw(640,40);
       call outstring(270,2,"B-E-L-O-T-E",noir,gris_clair);
       call move(219,49);
       call putmap(del_menu);
       exit;
      else
       if b_fin.dedans(h,v)
       then
        call b_fin.choix;
        termine:=true;
        call fermeture;
        exit;
       fi;
      fi;
     fi;
   esac
  od;
end menu; 

        (*************************************)
        (*             SOUS-MENU             *)
        (*************************************) 
                                  
Unit OPTION : procedure;
var h,v,p,l,r,c,i : integer,
    op1,op2,op3   : bouton_enfonce,
    valide        : bouton_relief,
    d             : boolean;
begin
 op1:=new bouton_enfonce(210,200,270,240,3,"5OO");
 op2:=new bouton_enfonce(290,200,350,240,4,"1OOO");
 op3:=new bouton_enfonce(370,200,430,240,4,"15OO");
 valide:=new bouton_relief(280,255,360,295,2,"OK");
 call patern(190,130,450,310,gris_clair,plein);
 call patern(190,130,450,310,noir,vide);

 call patern(191,131,449,131,blanc,plein);
 call patern(192,132,448,132,blanc,plein);
 call patern(191,131,191,309,blanc,plein);
 call patern(192,132,192,308,blanc,plein);

 call patern(449,131,449,309,gris_fonce,plein);
 call patern(448,132,448,308,gris_fonce,plein);
 call patern(191,309,449,309,gris_fonce,plein);
 call patern(192,308,448,308,gris_fonce,plein);


 call outstring(260,145,"Nombre de points",noir,gris_clair);
 call outstring(260,165,"   par partie",noir,gris_clair);
 call op1.choix;
 call op2.print;
 call op3.print;
 call valide.print;

 d:=false;
  do
   d:=getpress(h,v,p,l,r,c);
   case (c)
    when 1 : 
     if op1.dedans(h,v)
     then
      call op1.choix;
      call op2.print;
      call op3.print;
      total:=300;
     fi;
     if op2.dedans(h,v)
     then
      call op1.print;
      call op2.choix;
      call op3.print;
      total:=1000;
     fi;
     if op3.dedans(h,v)
     then
      call op1.print;
      call op2.print;
      call op3.choix;
      total:=1500;
     fi;
     if valide.dedans(h,v)
     then
      call valide.choix;
      for i:=1 to 5000 do od;
      call move(100,50);
      call putmap(save_menu);
      exit;
     fi;

   esac
  od;
end option; 


        (*************************************)
        (*        Calcul du score pour       *)
        (*           chaque equipe           *)
        (*************************************) 
             
Unit CALCUL_SCORE : procedure;
var s1,s2,i,attente : integer,
    dedans,capot    : boolean;

begin
 s1:=0;
 s2:=0;
 (* prise en compte du 10 de der *)
 if commence=1 or commence=3
 then
  s1:=s1+10;
 else
  s2:=s2+10;
 fi;
 
 while not(e1.empty) 
 do
  if e1.sommet.valeur.couleur=atout and e1.sommet.valeur.valeur=valet
  then
   s1:=s1+20;
  else
   if e1.sommet.valeur.couleur=atout and e1.sommet.valeur.valeur=neuf
   then
    s1:=s1+14;
   else
    case e1.sommet.valeur.valeur
     when dix   : s1:=s1+10;
     when valet : s1:=s1+2;
     when dame  : s1:=s1+3;
     when roi   : s1:=s1+4;
     when as    : s1:=s1+11;
    esac;
   fi;
  fi;
  call e11.push(e1.pop);
 od;
 while not(e2.empty) 
 do
  if e2.sommet.valeur.couleur=atout and e2.sommet.valeur.valeur=valet
  then
   s2:=s2+20;
  else
   if e2.sommet.valeur.couleur=atout and e2.sommet.valeur.valeur=neuf
   then
   s2:=s2+14;
   else
    case e2.sommet.valeur.valeur
     when dix   : s2:=s2+10;
     when valet : s2:=s2+2;
     when dame  : s2:=s2+3;
     when roi   : s2:=s2+4;
     when as    : s2:=s2+11;
    esac;
   fi;
  fi;
  call e22.push(e2.pop);
 od;
 dedans:=false;
 capot:=false;
 if (s1=0)
  then 
    score2:=score2+250;
    capot:=true;
    call outstring(270,22,"Equipe1 est capot",noir,gris_clair);
    for i:=1 to 40000 do od;
    call outstring(270,22,"                 ",noir,gris_clair);    
  else
   if (s2=0)
    then 
      score1:=score1+250;
      capot:=true;
      call outstring(270,22,"Equipe2 est capot",noir,gris_clair);
      for i:=1 to 40000 do od;
      call outstring(270,22,"                 ",noir,gris_clair);    

    else
      if joueur_prend or part_prend
       then
         if s1<s2
          then
            score2:=score2+162;
            call outstring(255,22,"Equipe1 est dedans",noir,gris_clair);
            for i:=1 to 40000 do od;
            call outstring(255,22,"                  ",noir,gris_clair);    
            dedans:=true;
          fi;
       else 
         if s2<s1
          then
            score1:=score1+162;
            call outstring(255,22,"Equipe2 est dedans",noir,gris_clair);
            for i:=1 to 40000 do od;
            call outstring(255,22,"                  ",noir,gris_clair);    
            dedans:=true;                 
         fi;
      fi;
   fi;
   if not dedans and not capot
    then
      score1:=score1+s1;
      score2:=score2+s2;
   fi;
 fi;
 if belote_joueur or belote_partenaire
 then
  score1:=score1+20;
  call outstring(210,25,"Equipe1 avait la belote",noir,gris_clair);
  for attente:=1 to 30000 do od;
  call outstring(210,25,"                       ",noir,gris_clair); 
 fi;
 if belote_adversaire1 or belote_adversaire2
 then
  score2:=score2+20;
  call outstring(210,25,"Equipe2 avait la belote",noir,gris_clair);
  for attente:=1 to 30000 do od;
  call outstring(210,25,"                       ",noir,gris_clair); 
 fi;
 


end CALCUL_SCORE;


        (*************************************)
        (*        mise_a_jour des plis       *)
        (*             par equipe            *)
        (*************************************) 
             

Unit MAJ_PLI : procedure;
var i : integer;
begin
 if commence=1 or commence=3
 then 
  for i:=1 to 4
  do
   call e1.push(pli(i));
  od;
 else 
  for i:=1 to 4
  do
   call e2.push(pli(i));
  od;
 fi;
 
end maj_pli;

        (*************************************)
        (*         Qui a fait le pli ?       *) 
        (*************************************) 

Unit EVALUE_PLI : function : integer;
var
 i,gagnant : integer;
 
begin
  gagnant:=0;
  for i:=1 to 4
  do
    if pli(i).couleur=atout and pli(i).valeur=valet
     then gagnant:=i;
    fi;
  od;
  if gagnant=0
   then
     for i:=1 to 4
     do
       if pli(i).couleur=atout and pli(i).valeur=neuf
        then gagnant:=i;
       fi;
     od;
  fi;
  if gagnant=0
   then
     for i:=1 to 4
     do
       if pli(i).couleur=atout
        then
          if gagnant<>0
           then
             if pli(gagnant).valeur<pli(i).valeur
              then gagnant:=i;
             fi;
           else gagnant:=i;
          fi;
       fi;
     od;
  fi;              
  if gagnant=0
   then
     gagnant:=1;
     for i:=1 to 4
     do
       if pli(i).couleur=pli(gagnant).couleur
        and pli(i).valeur>pli(gagnant).valeur
        then gagnant:=i;
       fi;
     od;
   fi;
   result:=gagnant;
end EVALUE_PLI;

        (*******************************************************)
        (*    On remet les cartes des joueurs dans le jeu      *) 
        (*******************************************************) 

Unit PERSONNE_A_PRIS : procedure;
var
 i : integer;
begin
 for i:=1 to 5
 do 
  call s.push(j_jeu(i).c);
 od;
 for i:=1 to 5
 do 
  call s.push(a1_jeu(i).c);
 od;
 for i:=1 to 5
 do 
  call s.push(p_jeu(i).c);
 od;
 for i:=1 to 5
 do 
  call s.push(a2_jeu(i).c);
 od;
 call s.push(carte_ret);
end personne_a_pris;

        (*************************************)
        (*        Affichage des atouts       *) 
        (*************************************) 

Unit affiche_atout : procedure;
var i : integer;
begin
 call patern(180,395,460,460,gris_clair,plein);
 call patern(180,395,460,395,blanc,plein);        
 call patern(181,396,459,396,blanc,plein);        
 call patern(180,395,180,460,blanc,plein);        
 call patern(181,396,181,459,blanc,plein);        

 call patern(182,397,458,397,blanc,plein);        
 call patern(182,397,182,458,blanc,plein);        
 call patern(458,397,458,458,gris_fonce,plein);        
 call patern(182,458,458,458,gris_fonce,plein);        

 call patern(180,460,460,460,gris_fonce,plein);        
 call patern(181,459,459,459,gris_fonce,plein);        
 call patern(460,395,460,460,gris_fonce,plein);        
 call patern(459,396,459,459,gris_fonce,plein);        
 call outstring(200,400," 7 ",noir,blanc); 
 call outstring(230,400," 8 ",noir,blanc); 
 call outstring(260,400," 9 ",noir,blanc); 
 call outstring(290,400," V ",noir,blanc); 
 call outstring(320,400," D ",noir,blanc); 
 call outstring(350,400," R ",noir,blanc); 
 call outstring(380,400," 10 ",noir,blanc); 
 call outstring(410,400," A ",noir,blanc); 
 for i:=1 to 8
 do
  if atout_joue(i)
  then 
   call patern(200+(i-1)*30,420,200+i*30,450,gris_fonce,plein);
  fi;
  call patern(200+(i-1)*30,420,200+i*30,450,noir,vide);
 od;
 for i:=1 to 100000 do od;
end affiche_atout;

        (*************************************)
        (*         Affichage du score        *) 
        (*************************************) 
                                      
Unit AFFICHE_SCORE : procedure;
begin
 call outstring(500,2,"Equipe 1 :",noir,gris_clair);
 call track(600,2,score1,gris_clair,noir);
 call outstring(500,22,"Equipe 2 :",noir,gris_clair);
 call track(600,22,score2,gris_clair,noir);
end affiche_score;

        (*************************************)
        (*      Affichage du vainqueur       *) 
        (*************************************) 
                                      
Unit AFFICHE_VAINQUEUR : procedure;
var 
    d           : boolean,
    h,v,p,l,r,c : integer,
    ok          : bouton_relief;

begin
 ok:=new bouton_relief(270,150,370,190,4,"O.K.");
 call move(0,0);
 call putmap(depart);
 if score1<score2
 then
  call outstring(240,22,"Vainqueur : Equipe2",noir,gris_clair);
 else
  if score1>score2
  then
   call outstring(240,22,"Vainqueur : Equipe1",noir,gris_clair);
  else
   (* on ne sait jamais ... *)
   call outstring(240,22,"     Match nul !",noir,gris_clair);
  fi;
 fi;
 call affiche_score;
 call ok.print;
 d:=false;
  do
   d:=getpress(h,v,p,l,r,c);
   case (c)
    when 1 : 
       if ok.dedans(h,v)
       then
        call ok.choix;
        call move(0,0);
        call putmap(depart);
        call MENU;   
        exit;
       fi;
   esac
  od;

end affiche_vainqueur;
                

        (***************************************)
        (*     Affichage du tapis de cart      *) 
        (***************************************) 

Unit Affiche_tapis : procedure;
begin
 call patern(160,90,480,350,25,plein);
 call patern(160,90,480,350,gris_fonce,vide);
 call patern(161,91,479,349,gris_fonce,vide);
 call intens(4,tx,ty,26,plein);
 call coeur(170,95);
 call carreau(445,290);
 call pic(170,290);
 call trefle(445,95);
end affiche_tapis;

        (***************************************)
        (*     Initialisation de l'ecran       *) 
        (***************************************) 
                                           
Unit INIT_ECRAN : procedure;
var nord,est,ouest:bouton_relief;
begin
  nord:=new bouton_relief(280,49,360,79,4,"NORD");
  est:=new bouton_relief(540,195,620,235,3,"EST");
  ouest:=new bouton_relief(20,195,100,235,5,"OUEST");
  call patern(0,0,640,40,gris_clair,plein);
  (* affichage des bandes de commentaires en gris du haut *)
  call move(0,20);
  call color(noir);
  call draw(640,20);
  call move(0,40);
  call draw(640,40);
  call outstring(270,2,"B-E-L-O-T-E",noir,gris_clair);
  call nord.print;
  call est.print;
  call ouest.print;
  call move(0,41);
  terrain:=getmap(640,361);
  (* sauvegarde de l'ecran *)
  call move(0,0);
  depart:=getmap(640,480);
end init_ecran;

        (*****************************************************)
        (*     Initialisation diverses (cartes, jeu...)      *) 
        (*****************************************************) 

Unit INITIALISATION : procedure;
var i : integer;
begin
 P1:=new carte(P,sept);  
 P2:=new carte(P,huit);
 P3:=new carte(P,neuf);  
 P4:=new carte(P,dix);
 P5:=new carte(P,valet);  
 P6:=new carte(P,dame);
 P7:=new carte(P,roi);  
 P8:=new carte(P,as);
 T1:=new carte(T,sept);  
 T2:=new carte(T,huit);
 T3:=new carte(T,neuf);  
 T4:=new carte(T,dix);
 T5:=new carte(T,valet);  
 T6:=new carte(T,dame);
 T7:=new carte(T,roi);  
 T8:=new carte(T,as);
 CA1:=new carte(CA,sept);  
 CA2:=new carte(CA,huit);
 CA3:=new carte(CA,neuf);  
 CA4:=new carte(CA,dix);
 CA5:=new carte(CA,valet);  
 CA6:=new carte(CA,dame);
 CA7:=new carte(CA,roi);  
 CA8:=new carte(CA,as);
 CO1:=new carte(CO,sept);  
 CO2:=new carte(CO,huit);
 CO3:=new carte(CO,neuf);  
 CO4:=new carte(CO,dix);
 CO5:=new carte(CO,valet);  
 CO6:=new carte(CO,dame);
 CO7:=new carte(CO,roi);  
 CO8:=new carte(CO,as);
 s:=new pile;
 e1:=new pile;
 e2:=new pile;
 e11:=new pile;
 e22:=new pile;
 b_aide_atout:=new bouton_relief(600,420,630,450,1,"?");
 user:=new joueur;
 part:=new partenaire;
 adv1:=new adversaire1;
 adv2:=new adversaire2;
 array j_jeu dim(1:8);
 array p_jeu dim(1:8);
 array a1_jeu dim(1:8);
 array a2_jeu dim(1:8);
 array pli dim(1:4);
 array atout_joue dim(1:8);
 for i:=1 to 8
 do 
  j_jeu(i):=new carte_user;
  p_jeu(i):=new carte_user;
  a1_jeu(i):=new carte_user;
  a2_jeu(i):=new carte_user;
  atout_joue(i):=false;
 od;
 for i:=1 to 4
 do 
  pli(i):=new carte(P,SEPT);
 od;
 array tx dim(1:4);
 array ty dim(1:4);
 tx(1):=320;
 tx(2):=162;
 tx(3):=320;
 tx(4):=478;
 ty(1):=92;
 ty(2):=220;
 ty(3):=348;
 ty(4):=220;

end initialisation;

        (*****************************************)
        (*     Initialisation des variables      *) 
        (*****************************************) 

Unit INIT_VARIABLES : procedure;
var i : integer;
begin
 s:=new pile;
 e1:=new pile;
 e2:=new pile;
 e11:=new pile;
 e22:=new pile;
 user:=new joueur;
 part:=new partenaire;
 adv1:=new adversaire1;
 adv2:=new adversaire2;
 array pli dim(1:4);
 for i:=1 to 8
 do 
  j_jeu(i):=new carte_user;
  p_jeu(i):=new carte_user;
  a1_jeu(i):=new carte_user;
  a2_jeu(i):=new carte_user;
 od;
 for i:=1 to 4
 do 
  pli(i):=new carte(P,SEPT);
 od;
 score1:=0;
 score2:=0;
 tour:=1;
 for i:=1 to 8
 do 
  j_jeu(i):=new carte_user;
  p_jeu(i):=new carte_user;
  a1_jeu(i):=new carte_user;
  a2_jeu(i):=new carte_user;
 od;
 for i:=1 to 4
 do 
  pli(i):=new carte(P,SEPT);
 od;


end init_variables;


        (******************************************************)
        (*     Distribue 5 cartes pour chaque joueur puis     *)
        (*             retourne une carte                     *)
        (******************************************************) 

Unit DISTRIBUE_1 : procedure;
begin
  (* on desire distribuer les cartes *)
  case tour
   when 1 : attach(user);
   when 2 : attach(adv1);
   when 3 : attach(part);
   when 4 : attach(adv2);
  esac;
  
  call move(0,0);
  image:=getmap(640,480);
(* on retourne une carte *)
  carte_ret:=s.pop;  
  carte_ret.x:=295;
  carte_ret.y:=190;
  call carte_ret.print;
end distribue_1;

        (*********************************)
        (*  On demande qui veut prendre  *)
        (*********************************)

Unit QUI_PREND : procedure;
begin
 case tour
  when 1 : attach(user);
  when 2 : attach(adv1);
  when 3 : attach(part);
  when 4 : attach(adv2);
 esac;
end qui_prend;

       (*************************************************************)
       (*  On distribue les cartes restantes et on affiche l'atout  *)
       (*************************************************************)
        
Unit DISTRIBUE_2 : procedure;
begin
 (* on effectue la troisieme donne *)
 case tour
  when 1 : attach(user);
  when 2 : attach(adv1);
  when 3 : attach(part);
  when 4 : attach(adv2);
 esac;
 (* on affiche l'atout *)
 case atout
   when 1 :
    call outstring(2,5,"ATOUT PIC",noir,gris_clair);
  when 2 :
     call outstring(2,5,"ATOUT TREFLE",noir,gris_clair);
  when 3 :
    call outstring(2,5,"ATOUT CARREAU",noir,gris_clair);
   when 4 :
     call outstring(2,5,"ATOUT COEUR",noir,gris_clair);
  esac;
  if joueur_prend
   then 
    call outstring(2,25,"Preneur : SUD",noir,gris_clair);
  fi; 
  if adv1_prend
   then 
    call outstring(2,25,"Preneur : EST",noir,gris_clair);
  fi; 
  if part_prend
   then 
    call outstring(2,25,"Preneur : NORD",noir,gris_clair);
  fi; 
  if adv2_prend
   then 
    call outstring(2,25,"Preneur : OUEST",noir,gris_clair);
  fi; 
end distribue_2;

        (*************************************)
        (*     Ouverture mode graphique      *) 
        (*************************************) 

Unit OUVERTURE : procedure;
begin
 call gron(1);
 call border(bleu_clair);
 call cls;
 (*for i:=32 to 40
 do
 call patern(300,300,100,100,i,plein);
 call track(50,40,i,noir,blanc);
 for attente:=1 to 10000 do od;
 od;
 *)
 call cls;
 call init(1,0);
 call showcursor;
 call move(219,49);
 del_menu:=getmap(421,361);
 call move(150,80);
 image2:=getmap(500,360);
end OUVERTURE;

        (*************************************)
        (*     Fermeture mode graphique      *) 
        (*************************************) 
           
Unit FERMETURE : procedure;
begin
 call groff;
end FERMETURE;

 (******************************************************************)
 (*                  debut PROGRAMME PRINCIPAL                     *) 
 (******************************************************************) 



begin

call OUVERTURE;
total:=defaut;
termine:=false;
call initialisation;
call init_ecran;
call premier_menu;
while not termine
do
 call init_variables;
 call melange;
 call move(0,0);
 call putmap(depart);
 call affiche_score;

 while score1<total and score2<total
 do
  call coupe_jeu;
  if tour=5 
  then
   tour:=1;
  fi;
  case tour
   when 1 : 
     call outstring(270,22,"OUEST distribue...",noir,gris_clair);
   when 2 : 
     call outstring(275,22,"SUD distribue...",noir,gris_clair);
   when 3 : 
     call outstring(275,22,"EST distribue...",noir,gris_clair);
   when 4 : 
     call outstring(270,22,"NORD distribue...",noir,gris_clair);
  esac;
  for attente:=1 to 30000 do od;
  call outstring(270,22,"                  ",noir,gris_clair);
  call distribue_1;
  call qui_prend;
  if on_prend
  then
   call distribue_2;
     cpt_pli:=1;
     commence:=tour;
     call affiche_tapis;
     case commence
     when 1 :
       attach(user);
       cpt_pli:=2;
       attach(adv1);
       cpt_pli:=3;
       attach(part);
       cpt_pli:=4;
       attach(adv2);
     when 2 :
       attach(adv1);
       cpt_pli:=2;
       attach(part);
       cpt_pli:=3;
       attach(adv2);
       cpt_pli:=4;
       attach(user);
     when 3 :
       attach(part);
       cpt_pli:=2;
       attach(adv2);
       cpt_pli:=3;
       attach(user);
       cpt_pli:=4;
       attach(adv1);
     when 4 :
       attach(adv2);
       cpt_pli:=2;
       attach(user);
       cpt_pli:=3;
       attach(adv1);
       cpt_pli:=4;
       attach(part);
     esac;
     (* on a effectue le premier pli *)
     k:=2;
     while k<=nb_pli 
     do
       for i:=1 to 20000 do od;
       eval:=EVALUE_PLI;
       eval:=(eval+commence-1) mod 4;
       if eval=0 then eval:=4 fi;
       commence:=eval;
       call maj_pli;
       call move(150,80);
       call putmap(image2);
       call affiche_tapis;
       cpt_pli:=1;  
       case commence
        when 1 :
          call outstring(240,22,"SUD remporte le pli !",noir,gris_clair);
          for attente:=1 to 35000 do od;
          call outstring(240,22,"                       ",noir,gris_clair);
          attach(user);
          cpt_pli:=2;
          attach(adv1);
          cpt_pli:=3;
          attach(part);
          cpt_pli:=4;
          attach(adv2);

        when 2 :
          call outstring(235,22,"EST remporte le pli !",noir,gris_clair);
          for attente:=1 to 35000 do od;
          call outstring(235,22,"                         ",noir,gris_clair);
          attach(adv1);
          cpt_pli:=2;
          attach(part);
          cpt_pli:=3;
          attach(adv2);
          cpt_pli:=4;
          attach(user);
          
        when 3 :
          call outstring(240,22,"NORD remporte le pli !",noir,gris_clair);
          for attente:=1 to 35000 do od;
          call outstring(240,22,"                       ",noir,gris_clair);
          attach(part);
          cpt_pli:=2;
          attach(adv2);
          cpt_pli:=3;
          attach(user);
          cpt_pli:=4;
          attach(adv1);

        when 4 :
          call outstring(230,22,"OUEST remporte le pli !",noir,gris_clair);
          for attente:=1 to 35000 do od;
          call outstring(230,22,"                            ",noir,gris_clair);
          attach(adv2);
          cpt_pli:=2;
          attach(user);
          cpt_pli:=3;
          attach(adv1);
          cpt_pli:=4;
          attach(part);
       esac;
       k:=k+1;
     od;
     for i:=1 to 8
     do
      atout_joue(i):=false;
     od;
     eval:=EVALUE_PLI;
     eval:=(eval+commence-1) mod 4;
     if eval=0 then eval:=4 fi;
     commence:=eval;
     call maj_pli;
     case commence
      when 1 :
        call outstring(240,22,"SUD remporte le pli !",noir,gris_clair);
        for attente:=1 to 35000 do od;
        call outstring(240,22,"                       ",noir,gris_clair);
      when 2 :
        call outstring(235,22,"EST remporte le pli !",noir,gris_clair);
        for attente:=1 to 35000 do od;
        call outstring(235,22,"                         ",noir,gris_clair);
      when 3 :
        call outstring(240,22,"NORD remporte le pli !",noir,gris_clair);
        for attente:=1 to 35000 do od;
        call outstring(240,22,"                       ",noir,gris_clair);
      when 4 :
        call outstring(230,22,"OUEST remporte le pli !",noir,gris_clair);
        for attente:=1 to 35000 do od;
        call outstring(230,22,"                            ",noir,gris_clair);
     esac;
    call calcul_score;
    (* on remet tous les plis dans le jeu s *)
    while not(e11.empty)
    do
      call s.push(e11.pop);
    od;
    while not(e22.empty)
    do
      call s.push(e22.pop);
    od;
    
    on_prend:=false;
    joueur_prend:=false;
    adv1_prend:=false;
    part_prend:=false;
    adv2_prend:=false;
  else
    call personne_a_pris;
  fi;
  user:=new joueur;
  part:=new partenaire;
  adv1:=new adversaire1;
  adv2:=new adversaire2;
  call move(0,0);
  call putmap(depart);
  call affiche_score;
  tour:=tour+1;

 od;
 call affiche_vainqueur;
 
od;
 end;  (* souris *)
 end;  (* IIUWgraph*)
end;