examples/jeu/dames.log

   1 program dames;\r
   2 (*----------------------------------------------------------------------*)\r
   3 (* Auteurs:BERNARD Didier                    licence informatique       *)\r
   4 (*         DUCAMP Denis                      ann\82e 1992-1993            *)\r
   5 (*                                                                      *)\r
   6 (*                      JEU DE DAMES                                    *)\r
   7 (*----------------------------------------------------------------------*)\r
   8 const vide=0,pion=1,dame=2,bloc=4,noir=-1,blanc=1,damenoire=-2,dameblanche=2;\r
   9     var quit:boolean,\r
  10         horiz,vert,debhoriz,debvert,horiz1,vert1,horiz2,\r
  11         coulblanc,coulnoir,coulrouge:integer,\r
  12         damier:arrayof integer,\r
  13         liste,h_g,h_d,b_g,b_d:arrayof arrayof integer,\r
  14         ap:aff_pions,\r
  15         arb:arbitre,\r
  16         cc:calc_coord,\r
  17         clc:calcul_liste_coup,\r
  18         clr:clear;\r
  19 \r
  20 unit init_deplact:procedure;\r
  21 (* Cette proc\82dure calcule pour chaque case le num\82ro de la case au *)\r
  22 (* dessus \85 gauche, au dessus \85 droite, en bas \85 gauche et en bas \85 droite *)\r
  23 \r
  24 var i,j,k:integer;\r
  25 begin\r
  26     array h_g dim(noir:blanc);\r
  27     array h_g(noir) dim(1:50); array h_g(blanc) dim(1:50);\r
  28     array h_d dim(noir:blanc);\r
  29     array h_d(noir) dim(1:50); array h_d(blanc) dim(1:50);\r
  30     array b_g dim(noir:blanc);\r
  31     array b_g(noir) dim(1:50); array b_g(blanc) dim(1:50);\r
  32     array b_d dim(noir:blanc);\r
  33     array b_d(noir) dim(1:50); array b_d(blanc) dim(1:50);\r
  34     for i:=1 to 50 do\r
  35         j:=i mod 10; k:=(i-1)mod 10;\r
  36         if i<=5 or j=6 then h_g(blanc,i):=0;\r
  37         else if k<5 then h_g(blanc,i):=i-5;\r
  38         else h_g(blanc,i):=i-6; fi; fi;\r
  39         if i<=5 or j=5 then h_d(blanc,i):=0;\r
  40         else if k<5 then h_d(blanc,i):=i-4;\r
  41         else h_d(blanc,i):=i-5; fi; fi;\r
  42         if i>=46 or j=6 then b_g(blanc,i):=0;\r
  43         else if k<5 then b_g(blanc,i):=i+5;\r
  44         else b_g(blanc,i):=i+4; fi; fi;\r
  45         if i>=46 or j=5 then b_d(blanc,i):=0;\r
  46         else if k<5 then b_d(blanc,i):=i+6;\r
  47         else b_d(blanc,i):=i+5; fi; fi;\r
  48         h_d(noir,i):=b_g(blanc,i); h_g(noir,i):=b_d(blanc,i);\r
  49         b_d(noir,i):=h_g(blanc,i); b_g(noir,i):=h_d(blanc,i);\r
  50     od;\r
  51 end init_deplact;\r
  52 \r
  53 unit calcul_liste_coup:coroutine;\r
  54 (* Cette coroutine calcule la liste des coups du joueur qui \85 la main *)\r
  55 \r
  56 var i,nc,joueur,nbmax,nb_coup:integer,\r
  57     coup,damier:arrayof integer,\r
  58     liste_coup:arrayof arrayof integer,\r
  59     saut:boolean,\r
  60     ec:enreg_coup;\r
  61 \r
  62 unit enreg_coup:coroutine;\r
  63 (* Cette coroutine enregistre un coup dans la liste des coups *)\r
  64 \r
  65 var i,nb:integer;\r
  66 begin\r
  67 return;\r
  68 do;\r
  69     if nb=nbmax then   \r
  70         nb_coup:=nb_coup+1;\r
  71         array liste_coup(nb_coup) dim(1:nb);\r
  72         for i:=1 to nb do liste_coup(nb_coup,i):=coup(i); od;\r
  73     else if nb>nbmax then\r
  74     (* La longueur du nouveau coup est sup\82rieure \85 celle des autres *)        \r
  75     (* donc on peut supprimer les anciens qui ne peuvent plus etre jou\82s *)\r
  76         for i:=1 to nb_coup do kill(liste_coup(i)); od;\r
  77         array liste_coup(1) dim(1:nb);\r
  78         nb_coup:=1;\r
  79         nbmax:=nb;\r
  80         for i:=1 to nb do liste_coup(1,i):=coup(i); od;\r
  81     fi; fi;\r
  82     detach;\r
  83 od;\r
  84 end enreg_coup;\r
  85 \r
  86 unit recurse_pion:procedure\r
  87 (damier:arrayof integer,num,sautee,caz:integer,prof:boolean);\r
  88 (* Cette proc\82dure recherche tous les coups possibles pour un pion donn\82 *)\r
  89 (* Elle s'appelle r\82cursivement si le pion peut en sauter au moins une fois *)\r
  90 \r
  91 var rec:boolean,\r
  92     nc,nc2:integer,\r
  93     damier2:arrayof integer;\r
  94 begin\r
  95     rec:=false;\r
  96     if prof then\r
  97         coup(num):=sautee;\r
  98         num:=num+1;\r
  99     fi;\r
 100     coup(num):=caz;\r
 101     nc:=h_g(joueur,caz);\r
 102     if nc=/=0 then\r
 103         if damier(nc)*joueur<0 then\r
 104             nc2:=h_g(joueur,nc);\r
 105             if nc2=/=0 then\r
 106                 if damier(nc2)=vide then\r
 107                     rec:=true;\r
 108                     damier2:=copy(damier);\r
 109                     damier2(nc2):=damier(caz);\r
 110                     damier2(nc),damier2(caz):=vide;\r
 111                     call recurse_pion(damier2,num+1,nc,nc2,true);\r
 112     fi; fi; fi; fi;\r
 113     nc:=h_d(joueur,caz);\r
 114     if nc=/=0 then\r
 115         if damier(nc)*joueur<0 then\r
 116             nc2:=h_d(joueur,nc);\r
 117             if nc2=/=0 then\r
 118                 if damier(nc2)=vide then\r
 119                     rec:=true;\r
 120                     if damier2<>none then kill(damier2); fi;\r
 121                     damier2:=copy(damier);\r
 122                     damier2(nc2):=damier(caz);\r
 123                     damier2(nc),damier2(caz):=vide;\r
 124                     call recurse_pion(damier2,num+1,nc,nc2,true);\r
 125     fi; fi; fi; fi;\r
 126     nc:=b_g(joueur,caz);\r
 127     if nc=/=0 then\r
 128         if damier(nc)*joueur<0 then\r
 129             nc2:=b_g(joueur,nc);\r
 130             if nc2=/=0 then\r
 131                 if damier(nc2)=vide then\r
 132                     rec:=true;\r
 133                     if damier2<>none then kill(damier2); fi;\r
 134                     damier2:=copy(damier);\r
 135                     damier2(nc2):=damier(caz);\r
 136                     damier2(nc),damier2(caz):=vide;\r
 137                     call recurse_pion(damier2,num+1,nc,nc2,true);\r
 138     fi; fi; fi; fi;\r
 139     nc:=b_d(joueur,caz);\r
 140     if nc=/=0 then\r
 141         if damier(nc)*joueur<0 then\r
 142             nc2:=b_d(joueur,nc);\r
 143             if nc2=/=0 then\r
 144                 if damier(nc2)=vide then\r
 145                     rec:=true;\r
 146                     if damier2<>none then kill(damier2); fi;\r
 147                     damier2:=copy(damier);\r
 148                     damier2(nc2):=damier(caz);\r
 149                     damier2(nc),damier2(caz):=vide;\r
 150                     call recurse_pion(damier2,num+1,nc,nc2,true);\r
 151     fi; fi; fi; fi;\r
 152     if rec then kill(damier2)\r
 153     else if prof then\r
 154         saut:=true;\r
 155         ec.nb:=num;\r
 156         attach(ec);\r
 157     fi; fi;\r
 158 end recurse_pion;\r
 159 \r
 160 unit recurse_dame:procedure\r
 161 (damier:arrayof integer,num,sautee,caz:integer,prof:boolean);\r
 162 (* Cette proc\82dure recherche tous les coups possible pour une dame *)\r
 163 (* Elle s'appelle r\82cursivement si la dame peut sauter au moins une fois *)\r
 164 \r
 165 var rec:boolean,\r
 166     nc,nc2:integer,\r
 167     damier2:arrayof integer;\r
 168 begin\r
 169     rec:=false;\r
 170     if prof then\r
 171         coup(num):=sautee;\r
 172         num:=num+1;\r
 173     fi;\r
 174     coup(num):=caz;\r
 175     nc:=caz;\r
 176     do\r
 177         nc:=h_g(joueur,nc);\r
 178         if nc=0 orif damier(nc)=/=vide then exit; fi;\r
 179     od;\r
 180     if nc=/=0 then\r
 181         if damier(nc)*joueur<0 then\r
 182             nc2:=h_g(joueur,nc);\r
 183             while nc2=/=0 do\r
 184                 if damier(nc2)=/=vide then exit; fi;\r
 185                 rec:=true;\r
 186                 damier2:=copy(damier);\r
 187                 damier2(nc2):=damier(caz);\r
 188                 damier2(nc):=bloc*joueur;\r
 189                 damier2(caz):=vide;\r
 190                 call recurse_dame(damier2,num+1,nc,nc2,true);\r
 191                 nc2:=h_g(joueur,nc2);\r
 192             od;\r
 193     fi; fi;\r
 194     nc:=caz;\r
 195     do\r
 196         nc:=h_d(joueur,nc);\r
 197         if nc=0 orif damier(nc)=/=vide then exit; fi;\r
 198     od;\r
 199     if nc=/=0 then\r
 200         if damier(nc)*joueur<0 then\r
 201             nc2:=h_d(joueur,nc);\r
 202             while nc2=/=0 do\r
 203                 if damier(nc2)=/=vide then exit; fi;\r
 204                 rec:=true;\r
 205                 if damier2=/=none then kill(damier2); fi;\r
 206                 damier2:=copy(damier);\r
 207                 damier2(nc2):=damier(caz);\r
 208                 damier2(nc):=bloc*joueur;\r
 209                 damier2(caz):=vide;\r
 210                 call recurse_dame(damier2,num+1,nc,nc2,true);\r
 211                 nc2:=h_d(joueur,nc2);\r
 212             od;\r
 213     fi; fi;\r
 214     nc:=caz;\r
 215     do\r
 216         nc:=b_g(joueur,nc);\r
 217         if nc=0 orif damier(nc)=/=vide then exit; fi;\r
 218     od;\r
 219     if nc=/=0 then\r
 220         if damier(nc)*joueur<0 then\r
 221             nc2:=b_g(joueur,nc);\r
 222             while nc2=/=0 do\r
 223                 if damier(nc2)=/=vide then exit; fi;\r
 224                 rec:=true;\r
 225                 if damier2=/=none then kill(damier2); fi;\r
 226                 damier2:=copy(damier);\r
 227                 damier2(nc2):=damier(caz);\r
 228                 damier2(nc):=bloc*joueur;\r
 229                 damier2(caz):=vide;\r
 230                 call recurse_dame(damier2,num+1,nc,nc2,true);\r
 231                 nc2:=b_g(joueur,nc2);\r
 232             od;\r
 233     fi; fi;\r
 234     nc:=caz;\r
 235     do\r
 236         nc:=b_d(joueur,nc);\r
 237         if nc=0 orif damier(nc)=/=vide then exit; fi;\r
 238     od;\r
 239     if nc=/=0 then\r
 240         if damier(nc)*joueur<0 then\r
 241             nc2:=b_d(joueur,nc);\r
 242             while nc2=/=0 do\r
 243                 if damier(nc2)=/=vide then exit; fi;\r
 244                 rec:=true;\r
 245                 if damier2=/=none then kill(damier2); fi;\r
 246                 damier2:=copy(damier);\r
 247                 damier2(nc2):=damier(caz);\r
 248                 damier2(nc):=bloc*joueur;\r
 249                 damier2(caz):=vide;\r
 250                 call recurse_dame(damier2,num+1,nc,nc2,true);\r
 251                 nc2:=b_d(joueur,nc2);\r
 252             od;\r
 253     fi; fi;\r
 254     if rec then kill(damier2)    \r
 255     else if prof then\r
 256         saut:=true;\r
 257         ec.nb:=num;\r
 258         attach(ec);\r
 259     fi; fi;\r
 260 end recurse_dame;\r
 261 \r
 262 begin (* calcul_liste_coup  *)\r
 263     ec:=new enreg_coup;\r
 264     array coup dim(1:21);\r
 265 return;\r
 266 do;\r
 267     saut:=false;\r
 268     nbmax:=2;\r
 269     nb_coup:=0;\r
 270     if liste_coup<>none then\r
 271         for i:=1 to upper(liste_coup) do\r
 272             if liste_coup(i)<>none then kill(liste_coup(i)); fi;\r
 273     od; fi;\r
 274     for i:=1 to 50 do\r
 275         if damier(i)*joueur>0 then\r
 276             if abs(damier(i))=pion then\r
 277                 call recurse_pion(damier,1,0,i,false);\r
 278                 if not saut then\r
 279                     nc:=h_g(joueur,i);\r
 280                     if nc=/=0 then\r
 281                         if damier(nc)=vide then\r
 282                             coup(1):=i;\r
 283                             coup(2):=nc;\r
 284                             ec.nb:=2;\r
 285                             attach(ec);\r
 286                     fi; fi;\r
 287                     nc:=h_d(joueur,i);\r
 288                     if nc=/=0 then\r
 289                         if damier(nc)=vide then\r
 290                             coup(1):=i;\r
 291                             coup(2):=nc;\r
 292                             ec.nb:=2;\r
 293                             attach(ec);\r
 294                 fi; fi; fi;\r
 295             else call recurse_dame(damier,1,0,i,false);\r
 296                 if not saut then\r
 297                     nc:=h_g(joueur,i);\r
 298                     while nc=/=0 do\r
 299                         if damier(nc)=/=vide then exit; fi;\r
 300                         coup(1):=i;\r
 301                         coup(2):=nc;\r
 302                             ec.nb:=2;\r
 303                             attach(ec);\r
 304                         nc:=h_g(joueur,nc);\r
 305                     od;\r
 306                     nc:=h_d(joueur,i);\r
 307                     while nc=/=0 do\r
 308                         if damier(nc)=/=vide then exit; fi;\r
 309                         coup(1):=i;\r
 310                         coup(2):=nc;\r
 311                             ec.nb:=2;\r
 312                             attach(ec);\r
 313                         nc:=h_d(joueur,nc);\r
 314                     od;\r
 315                     nc:=b_g(joueur,i);\r
 316                     while nc=/=0 do\r
 317                         if damier(nc)=/=vide then exit; fi;\r
 318                         coup(1):=i;\r
 319                         coup(2):=nc;\r
 320                             ec.nb:=2;\r
 321                             attach(ec);\r
 322                         nc:=b_g(joueur,nc);\r
 323                     od;\r
 324                     nc:=b_d(joueur,i);\r
 325                     while nc=/=0 do\r
 326                         if damier(nc)=/=vide then exit; fi;\r
 327                         coup(1):=i;\r
 328                         coup(2):=nc;\r
 329                             ec.nb:=2;\r
 330                             attach(ec);\r
 331                         nc:=b_d(joueur,nc);\r
 332                     od;\r
 333         fi; fi; fi;\r
 334     od;\r
 335     detach;\r
 336 od;\r
 337     kill(coup);\r
 338 end calcul_liste_coup;\r
 339 \r
 340 unit valide:coroutine;\r
 341 (* Renvoie TRUE si une ligne de Liste_Coup est \82gal \85 Coup, FALSE sinon *)\r
 342 \r
 343 var egaux:boolean,\r
 344     i,j,long1,long2,n_coup:integer,\r
 345     coup:arrayof integer,\r
 346     liste_coup:arrayof arrayof integer;\r
 347 begin\r
 348 return;\r
 349 do\r
 350     long1:=upper(coup);\r
 351     long2:=upper(liste_coup(1));\r
 352     if (long1=long2) then\r
 353         for i:=1 to n_coup do\r
 354             egaux:=true;\r
 355             for j:=1 to long1 do\r
 356                 if liste_coup(i,j)<>coup(j) then\r
 357                     egaux:=false;\r
 358                     exit;\r
 359                 fi;\r
 360             od;\r
 361             if egaux then exit; fi;\r
 362         od;\r
 363     else egaux:=false;\r
 364     fi;\r
 365     detach;\r
 366 od;\r
 367 end valide;\r
 368 \r
 369 unit init_damier:procedure(inout damier:arrayof integer);\r
 370 (* Initialise le damier en m\82moire *)\r
 371 (* en positionnant les pions comme en d\82but de partie *)\r
 372 \r
 373 var i:integer;\r
 374 begin\r
 375     if damier=none then array damier dim(1:50); fi;\r
 376     for i:=1 to 20 do damier(i):=noir; od;\r
 377     for i:=21 to 30 do damier(i):=vide; od;\r
 378     for i:=31 to 50 do damier(i):=blanc; od;\r
 379 end init_damier;\r
 380 \r
 381 unit aff_pions:coroutine;\r
 382 (* Coroutine qui affiche \85 l'\82cran tous les pions du *)\r
 383 (* damier en fonction du tableau damier en m\82moire *)\r
 384 \r
 385 var i:integer;\r
 386 begin\r
 387 return;\r
 388 do\r
 389     for i:=1 to 50 do\r
 390         if damier(i)=blanc then call aff_blanc(i)\r
 391         else if damier(i)=noir then call aff_noir(i)\r
 392         else if damier(i)=dameblanche then call aff_dameblanche(i)\r
 393         else if damier(i)=damenoire then call aff_damenoire(i)\r
 394         else call del_case(i);\r
 395         fi; fi; fi; fi;\r
 396     od;\r
 397     detach;\r
 398 od;\r
 399 end aff_pions;\r
 400 \r
 401 unit calc_coord:coroutine;\r
 402 (* Calcule les coordonn\82es du coin haut gauche de la case caz *)\r
 403 \r
 404 var caz,h,v:integer;\r
 405 begin\r
 406 return;\r
 407 do\r
 408     caz:=caz-1;\r
 409     if((caz div 5)mod 2=0)then h:=debhoriz+horiz+(caz mod 5)*horiz2;\r
 410     else h:=debhoriz+(caz mod 5)*horiz2; fi;\r
 411     v:=debvert+vert*(caz div 5);\r
 412     detach;\r
 413 od;\r
 414 end calc_coord;\r
 415 \r
 416 unit aff_dameblanche:procedure(caz:integer);\r
 417 (* Affiche une dame blanche sur la case caz *)\r
 418 \r
 419 var h,v:integer;\r
 420 begin\r
 421     cc.caz:=caz;   attach(cc);   h:=cc.h;   v:=cc.v;   clr.h:=h;   clr.v:=v;\r
 422     clr.long:=horiz1;   clr.haut:=vert1;   clr.col:=coulnoir;   attach(clr);\r
 423     clr.h:=h+9;   clr.v:=v+4;   clr.long:=15;   clr.haut:=12;\r
 424     clr.col:=coulblanc;   attach(clr);\r
 425     clr.h:=h+5;   clr.v:=v+8;   attach(clr);\r
 426 end aff_dameblanche;\r
 427 \r
 428 unit aff_damenoire:IIUWGraph procedure(caz:integer);\r
 429 (* Affiche une dame noire sur la case caz *)\r
 430 \r
 431 var h,v:integer;\r
 432 begin\r
 433     cc.caz:=caz;   attach(cc);   h:=cc.h;   v:=cc.v;\r
 434     clr.h:=h;   clr.v:=v;   clr.long:=horiz1;   clr.haut:=vert1;\r
 435     clr.col:=coulnoir;   attach(clr);\r
 436     call color(coulblanc);   call move(h+9,v+8);\r
 437     call draw(h+9,v+4);   call draw(h+24,v+4);\r
 438     call draw(h+24,v+16);   call draw(h+20,v+16);\r
 439     call move(h+5,v+8);\r
 440     call draw(h+20,v+8);   call draw(h+20,v+20);\r
 441     call draw(h+5,v+20);   call draw(h+5,v+8);\r
 442 end aff_damenoire;\r
 443 \r
 444 unit aff_blanc:procedure(caz:integer);\r
 445 (* affiche un pion blanc sur la case caz *)\r
 446 \r
 447 var h,v:integer;\r
 448 begin\r
 449     cc.caz:=caz;   attach(cc);   h:=cc.h;   v:=cc.v;\r
 450     clr.h:=h;   clr.v:=v;   clr.long:=horiz1;   clr.haut:=vert1;\r
 451     clr.col:=coulnoir;   attach(clr);\r
 452     clr.h:=h+7;   clr.v:=v+6;   clr.long:=14;   clr.haut:=12;\r
 453     clr.col:=coulblanc;   attach(clr);\r
 454 end aff_blanc;\r
 455 \r
 456 unit aff_noir:IIUWGraph procedure(caz:integer);\r
 457 (* Affiche un pion noir sur la case caz *)\r
 458 \r
 459 var h,v:integer;\r
 460 begin\r
 461     cc.caz:=caz;   attach(cc);   h:=cc.h;   v:=cc.v;\r
 462     clr.h:=h;   clr.v:=v;   clr.long:=horiz1;   clr.haut:=vert1;\r
 463     clr.col:=coulnoir;   attach(clr);\r
 464     call color(coulblanc);   call move(h+7,v+6);   call draw(h+21,v+6);\r
 465     call draw(h+21,v+18);   call draw(h+7,v+18);   call draw(h+7,v+6);\r
 466 end aff_noir;\r
 467 \r
 468 unit aff_damier:IIUWGraph procedure;\r
 469 (* Affiche un damier vide \85 l'\82cran *)\r
 470 \r
 471 var i,j,bord,h,v:integer;\r
 472 begin\r
 473     clr.h:=debhoriz-1;   clr.v:=debvert-1;\r
 474     clr.long:=10*horiz+1;   clr.haut:=10*vert+1;\r
 475     clr.col:=coulblanc;   attach(clr);\r
 476     bord:=horiz;   clr.v:=debvert;\r
 477     clr.long:=horiz1;   clr.haut:=vert1;   clr.col:=coulnoir;\r
 478     for i:=1 to 10 do\r
 479         clr.h:=debhoriz+bord;\r
 480         for j:=1 to 5 do\r
 481             attach(clr);\r
 482             clr.h:=clr.h+60;\r
 483         od;\r
 484         bord:=horiz-bord;\r
 485         clr.v:=clr.v+vert;\r
 486     od;\r
 487 end aff_damier;\r
 488 \r
 489 unit del_case:procedure(caz:integer);\r
 490 (* Efface tout ce qui pourrait se trouver sur la case caz *) \r
 491 \r
 492 var h,v:integer;\r
 493 begin\r
 494     cc.caz:=caz;   attach(cc);   h:=cc.h;   v:=cc.v;\r
 495     clr.h:=h;   clr.v:=v;   clr.long:=horiz1;   clr.haut:=vert1;\r
 496     clr.col:=coulnoir;   attach(clr);\r
 497 end del_case;\r
 498 \r
 499 unit clear:IIUWGraph coroutine;\r
 500 (* Dessine un rectangle de coin haut gauche h,v et bas droit h+long,v+haut *)\r
 501 \r
 502 var h,v,long,haut,col,i:integer;\r
 503 begin\r
 504 return;\r
 505 do\r
 506     call color(col);\r
 507     for i:=0 to haut do\r
 508         call move(h,v+i);\r
 509         call draw(h+long,v+i);\r
 510     od;\r
 511     detach;\r
 512 od;\r
 513 end clear;\r
 514 \r
 515 unit aff_tab_car:IIUWGraph procedure(h,v:integer,tab:arrayof char);\r
 516 (* Affiche une cha\8cne de caract\8ares \85 l'\82cran *)\r
 517 \r
 518 var i:integer;\r
 519 begin\r
 520     clr.h:=h;   clr.v:=v;   clr.long:=(upper(tab)-lower(tab)+1)*8-1;\r
 521     clr.haut:=7;   clr.col:=coulnoir;   attach(clr);\r
 522     call color(coulblanc);   call move(h,v);\r
 523     for i:=lower(tab) to upper(tab) do\r
 524         call hascii(ord(tab(i)));\r
 525     od;\r
 526 end aff_tab_car;\r
 527 \r
 528 unit aff_nb:procedure(h,v,n,l:integer);\r
 529 (* Transforme un nombre en tableau de chiffres puis appelle la *)\r
 530 (* proc\82dure Aff_Tab_Car pour l'afficher sur un \82cran graphique *)\r
 531 \r
 532 var tab,bat:arrayof char,\r
 533     i,j,k:integer;\r
 534 begin\r
 535     if n=0 then\r
 536         array tab dim(1:l);\r
 537         tab(1):='0';\r
 538         for i:=2 to l do tab(i):=' '; od;\r
 539         call aff_tab_car(h,v,tab);\r
 540     else\r
 541         array tab dim(1:6);\r
 542         if n<0 then\r
 543             tab(1):='-';\r
 544             i:=1;\r
 545             n:=-n;\r
 546         fi;\r
 547         while n>0 do\r
 548             i:=i+1;\r
 549             tab(i):=chr((n mod 10)+48);\r
 550             n:=n div 10;\r
 551         od;\r
 552         array bat dim(1:l);\r
 553         if tab(1)='-' then\r
 554             bat(1):='-';\r
 555             k:=1;\r
 556         fi;\r
 557         for j:=k+1 to i do\r
 558             bat(j):=tab(i);\r
 559             i:=i-1;\r
 560         od;\r
 561         for i:=j to l do bat(i):=' '; od;\r
 562         call aff_tab_car(h,v,bat);\r
 563         kill(bat);\r
 564     fi;\r
 565     kill(tab);\r
 566 end aff_nb;\r
 567 \r
 568 unit attend_bouton:mouse procedure(output h,v:integer);\r
 569 (* Cette proc\82dure renvoie les coordonn\82es du pixel point\82 par la *)\r
 570 (* souris lorsque le bouton gauche a \82t\82 cliqu\82 pour la derni\8are fois *)\r
 571 \r
 572 var l,r,c:boolean,\r
 573     h1,v1,p:integer;\r
 574 begin\r
 575     do\r
 576         call getpress(0,h1,v1,p,l,r,c);\r
 577         if not l and not r and not c then exit fi;\r
 578     od;\r
 579     do\r
 580         call getpress(0,h,v,p,l,r,c);\r
 581         if l or r then exit fi;\r
 582     od;\r
 583         if r then \r
 584             pref IIUWGraph block begin\r
 585                 call groff;\r
 586                 writeln("Abandon d'un joueur");\r
 587                 call endrun;\r
 588             end;\r
 589         fi; \r
 590 end attend_bouton;\r
 591 \r
 592 unit sur_damier:function(h,v:integer):boolean;\r
 593 (* Retourne TRUE si le pixel de coordonn\82es *)\r
 594 (* (h,v) est sur une case num\82rot\82e du damier *) \r
 595 \r
 596 begin\r
 597     if h>=debhoriz and v>=debvert and h<debhoriz+10*horiz and v<debvert+10*vert\r
 598     then result:=true\r
 599     else result:=false;\r
 600     fi;\r
 601 end sur_damier;\r
 602 \r
 603 unit num_caz:function(h,v:integer):integer;\r
 604 (* Calcule le num\82ro de la case \85 laquelle *)\r
 605 (* appartient le pixel de coordonn\82e (h,v) *)\r
 606 \r
 607 var ligne,colon:integer;\r
 608 begin\r
 609     ligne:=(v-debvert)div vert;\r
 610     colon:=(h-debhoriz)div horiz;\r
 611     if(ligne mod 2)+(colon mod 2)=1\r
 612     then result:=1+(5*ligne)+(colon div 2)\r
 613     else result:=0;\r
 614     fi;\r
 615 end num_caz;\r
 616 \r
 617 \r
 618 unit quelle_caz:IIUWGraph function:integer;       \r
 619 (* Renvoie le num\82ro de la case o\97 on vient de cliquer *)\r
 620 \r
 621 var h,v,n_c:integer;\r
 622 begin\r
 623     do\r
 624         call attend_bouton(h,v);\r
 625         if sur_damier(h,v) then n_c:=num_caz(h,v); fi;\r
 626         if(h=0 or v=0)then quit:=true; fi;\r
 627         if n_c<>0 or quit then exit fi;\r
 628     od;\r
 629     result:=n_c;\r
 630 end quelle_caz;\r
 631 \r
 632 unit maj_aff:procedure(damier,coup:arrayof integer);\r
 633 (* Met \85 jour l'affichage du damier en actualisant *)\r
 634 (* \85 l'\82cran les cases point\82es par le tableau Coup *)\r
 635 \r
 636 var i,n:integer;\r
 637 begin\r
 638     for i:=1 to upper(coup) do\r
 639         n:=coup(i);\r
 640         case damier(n)\r
 641         when blanc:       call aff_blanc(n);\r
 642         when noir:        call aff_noir(n);\r
 643         when dameblanche: call aff_dameblanche(n);\r
 644         when damenoire:   call aff_damenoire(n);\r
 645         otherwise         call del_case(n);\r
 646         esac;\r
 647     od;\r
 648 end maj_aff;\r
 649 \r
 650 unit maj_damier:procedure(damier,coup:arrayof integer,joueur:integer);\r
 651 (* Met \85 jour le damier en m\82moire en jouant le coup *)\r
 652 \r
 653 var deb,fin,i,n:integer;\r
 654 begin\r
 655     n:=upper(coup);\r
 656     deb:=coup(1);\r
 657     fin:=coup(n);\r
 658     for i:=2 step 2 to n-1 do damier(coup(i)):=0; od;\r
 659     if joueur=blanc then\r
 660         if fin<6\r
 661         then damier(fin):=dameblanche\r
 662         else damier(fin):=damier(deb); fi;\r
 663     else if fin>45\r
 664         then damier(fin):=damenoire\r
 665         else damier(fin):=damier(deb); fi;\r
 666     fi;\r
 667     if fin<>deb then damier(deb):=vide; fi;\r
 668 end maj_damier;\r
 669 \r
 670 unit aff_croix:IIUWGraph procedure(caz:integer);\r
 671 (* Affiche une croix sur la case caz du damier *)\r
 672 \r
 673 var h,v:integer;\r
 674 begin\r
 675     cc.caz:=caz;   attach(cc);   h:=cc.h;   v:=cc.v;\r
 676     call color(coulrouge);   call move(h,v);\r
 677     call draw(h+horiz1,v+vert1);\r
 678     call move(h,v+vert1);\r
 679     call draw(h+horiz1,v);\r
 680     call color(coulblanc);\r
 681 end aff_croix;\r
 682 \r
 683 unit arbitre:IIUWGraph coroutine;\r
 684 (* Cette coroutine initialise la partie (damier et coroutines), *)\r
 685 (* g\8are la partie en donnant alternativement la main aux deux joueurs, *)\r
 686 (* v\82rifie la validit\82 des coups jou\82s et g\8are leur affichage *)\r
 687 \r
 688 var joueur,nmax,ncoup,coul,rep,rep1,i:integer,\r
 689     coup:arrayof integer,\r
 690     liste:arrayof arrayof integer,\r
 691     joueur1,joueur2:participant,\r
 692     val:valide;\r
 693 begin\r
 694     call init_damier(damier);\r
 695     array liste dim(1:50);\r
 696     call init_deplact;\r
 697     clc:=new calcul_liste_coup;\r
 698     cc:=new calc_coord;\r
 699     ap:=new aff_pions;\r
 700     clr:=new clear;\r
 701     val:=new valide;\r
 702     for i:=1 to 25 do writeln; od;\r
 703     writeln("             JEU DE DAMES");\r
 704     writeln;\r
 705     writeln("Voici les options de ce jeu:");\r
 706     writeln;writeln;\r
 707     writeln("1 - Jouer contre l'ordinateur");\r
 708     writeln("2 - Deux joueurs");\r
 709     writeln("3 - Deux ordinateurs");\r
 710     writeln;\r
 711     do\r
 712         write("Quel est votre choix ? ");read(rep);writeln;\r
 713         if(rep>=1 and rep<=3) then exit; fi;\r
 714     od;\r
 715     case rep\r
 716     when 1:\r
 717         do \r
 718             write("Sous quelle couleur voulez-vous jouer (noir=-1/blanc=1)? ");\r
 719             read(coul);writeln;\r
 720             if (abs(coul)=1) then exit; fi;\r
 721         od;\r
 722         do\r
 723             write("A quel niveau l'ordinateur doit-il jouer (1,2,etc)? ");\r
 724             read(rep);writeln;\r
 725             if rep>0 then exit; fi;\r
 726         od;\r
 727         if coul=blanc then\r
 728             joueur1:=new player(damier,coul);\r
 729             joueur2:=new computer(damier,-coul,rep);\r
 730             rep1:=rep;\r
 731         else\r
 732             joueur1:=new computer(damier,-coul,rep);\r
 733             joueur2:=new player(damier,coul);\r
 734         fi;\r
 735     when 2:\r
 736         joueur1:=new player(damier,blanc);\r
 737         joueur2:=new player(damier,noir);\r
 738     when 3:\r
 739         do\r
 740             write("A quel niveau l'ordinateur BLANC doit-il jouer (1,2,etc)? ");\r
 741             read(rep);writeln;\r
 742             if rep>0 then exit; fi;\r
 743         od;\r
 744         joueur1:=new computer(damier,blanc,rep);\r
 745         do\r
 746             write("A quel niveau l'ordinateur NOIR doit-il jouer (1,2,etc)? ");\r
 747             read(rep1);writeln;\r
 748             if rep1>0 then exit; fi;\r
 749         od;\r
 750         joueur2:=new computer(damier,noir,rep);\r
 751     esac;\r
 752     call gron(5);\r
 753     call cls;\r
 754     call aff_damier;\r
 755     attach(ap);\r
 756     call aff_tab_car((debhoriz-40)div 2,debvert,unpack("Blanc"));\r
 757     call aff_tab_car(debhoriz+10*horiz+(debhoriz-32)div 2,debvert,\r
 758         unpack("Noir"));\r
 759     call aff_tab_car(240,(debvert-8)div 2,unpack("Joueur actif:"));\r
 760     if joueur1 is computer then\r
 761         call aff_tab_car((debhoriz-144)div 2,debvert+vert,\r
 762             unpack("Machine niveau:"));\r
 763         call aff_nb((debhoriz-144)div 2+128,debvert+vert,rep,1);\r
 764     else\r
 765         call aff_tab_car((debhoriz-48)div 2,debvert+vert,unpack("Humain"));\r
 766     fi;\r
 767     if joueur2 is computer then\r
 768         call aff_tab_car(debhoriz+10*horiz+(debhoriz-144)div 2,debvert+vert,\r
 769             unpack("Machine niveau:"));\r
 770         call aff_nb(debhoriz+10*horiz+(debhoriz-144)div 2+128,debvert+vert,rep1,1);\r
 771     else\r
 772         call aff_tab_car(debhoriz+10*horiz+(debhoriz-48)div 2,debvert+vert,\r
 773             unpack("Humain"));\r
 774     fi;\r
 775     joueur:=blanc;\r
 776     call aff_tab_car((debhoriz-144)div 2,debvert+2*vert,\r
 777         unpack("Dernier coup jou\82:"));\r
 778     call aff_tab_car(debhoriz+10*horiz+(debhoriz-144)div 2,debvert+2*vert,\r
 779         unpack("Dernier coup jou\82:"));\r
 780     return;\r
 781     pref mouse block begin\r
 782         call showcursor;\r
 783     end;\r
 784     do\r
 785         clc.joueur:=joueur;   clc.damier:=damier;   clc.liste_coup:=liste;\r
 786         attach(clc);   nmax:=clc.nbmax;   ncoup:=clc.nb_coup;\r
 787         if ncoup=0 then\r
 788             call groff;\r
 789             if joueur=blanc\r
 790             then writeln("Les BLANCS ont PERDU...")\r
 791             else writeln("Les NOIRS ont PERDU...");\r
 792             fi;\r
 793             call endrun;\r
 794         fi;\r
 795         for i:=1 to ncoup do\r
 796             kill(liste(i));\r
 797         od;\r
 798         pref mouse block begin    \r
 799             call hidecursor;\r
 800             if(joueur=blanc) then\r
 801                 call aff_tab_car(360,(debvert-8)div 2,unpack("blanc"));\r
 802                 call showcursor;\r
 803                 attach(joueur1);\r
 804                 coup:=joueur1.coupjou;\r
 805             else\r
 806                 call aff_tab_car(360,(debvert-8)div 2,unpack("noir "));\r
 807                 call showcursor;\r
 808                 attach(joueur2);\r
 809                 coup:=joueur2.coupjou;\r
 810             fi;\r
 811         end;\r
 812         do\r
 813             clc.joueur:=joueur;   clc.damier:=damier;   clc.liste_coup:=liste;\r
 814             attach(clc);   nmax:=clc.nbmax;   ncoup:=clc.nb_coup;\r
 815             val.liste_coup:=liste;   val.coup:=coup;   val.n_coup:=ncoup;\r
 816             attach(val);   if val.egaux then exit; fi;\r
 817             if (joueur=blanc) then\r
 818                 attach(joueur1);\r
 819                 coup:=joueur1.coupjou;\r
 820             else\r
 821                 attach(joueur2);\r
 822                 coup:=joueur2.coupjou;\r
 823             fi;\r
 824         od;\r
 825         pref mouse block begin\r
 826             call hidecursor;\r
 827             call maj_damier(damier,coup,joueur);\r
 828             call maj_aff(damier,coup);\r
 829             if (joueur=blanc) then\r
 830                 call aff_nb((debhoriz-40)div 2,debvert+3*vert,coup(1),2);\r
 831                 call aff_nb((debhoriz-40)div 2+24,debvert+3*vert,\r
 832                     coup(upper(coup)),2);\r
 833             else\r
 834                 call aff_nb(debhoriz+10*horiz+(debhoriz-40)div 2,\r
 835                     debvert+3*vert,coup(1),2);\r
 836                 call aff_nb(debhoriz+10*horiz+(debhoriz-40)div 2+24,\r
 837                     debvert+3*vert,coup(upper(coup)),2);\r
 838             fi;\r
 839             call showcursor;\r
 840             joueur:=-joueur;\r
 841         end;\r
 842     od;\r
 843 end arbitre;\r
 844 \r
 845 unit participant:mouse coroutine(damier:arrayof integer,moi:integer);\r
 846 (* Cette coroutine pr\82fixe les coroutines computer et player *)\r
 847 \r
 848 var coupjou:arrayof integer;\r
 849 begin\r
 850 end participant;\r
 851 \r
 852 unit computer:participant coroutine(prof:integer);\r
 853 (* Calcule le coup que l'ordianteur va jouer *)\r
 854 \r
 855 var alf,i,k,maxi,ncoup,nmax,num,valeur:integer,\r
 856     damierec:arrayof integer,\r
 857     listejou:arrayof arrayof integer,\r
 858     rec:recurrence;\r
 859  \r
 860 unit recurrence:coroutine(jeu:arrayof integer);\r
 861 (* Cette coroutine pr\82fixe les coroutines note, alpha et beta *)\r
 862 \r
 863 var alf,bet,resultat:integer;\r
 864 begin\r
 865 end recurrence;\r
 866 \r
 867 unit note:recurrence coroutine(moi:integer);\r
 868 (* Attribut une note \85 la position du damier: *)\r
 869 (* positive si elle est favorable \85 l'ordinateur, n\82gative sinon *)\r
 870 \r
 871 var c,i,k:integer,\r
 872     val,val2,val3,val4:arrayof integer;\r
 873 begin\r
 874     array val dim(1:50);   array val2 dim(1:50);\r
 875     array val3 dim(1:50);   array val4 dim(1:50);\r
 876     val(3):=18;\r
 877     val(2),val(8),val(13),val(9),val(4):=17;\r
 878     val(1),val(7),val(12),val(18),val(23),val(19),val(14),val(10),val(5):=16;\r
 879     val(6),val(11),val(17),val(22),val(28):=15;\r
 880         val(33),val(29),val(24),val(20),val(15):=15;\r
 881     val(16),val(21),val(27),val(32),val(38):=14;\r
 882         val(43),val(39),val(34),val(30),val(25):=14;\r
 883     val(26),val(31),val(37),val(42),val(48):=13;\r
 884         val(49),val(44),val(40),val(35):=13;\r
 885     val(36),val(41),val(47),val(50),val(45):=12;\r
 886     val(46):=11;\r
 887     if moi=noir then\r
 888         i:=50;\r
 889         for c:=1 to 50 do\r
 890             k:=val(c); val(c):=val(i); val(i):=k; i:=i-1;\r
 891     od; fi;\r
 892     i:=50;\r
 893     for c:=1 to 50 do\r
 894             val2(c):=val(i); i:=i-1;\r
 895             val3(c):=30+val(c);\r
 896             val4(c):=30+val2(c);\r
 897     od;\r
 898 return;\r
 899 do\r
 900     resultat:=0;\r
 901     for i:=1 to 50 do\r
 902         k:=jeu(i)*moi;\r
 903         case k\r
 904         when blanc:       resultat:=resultat+val(i);\r
 905         when noir:        resultat:=resultat-val2(i);\r
 906         when dameblanche: resultat:=resultat+val3(i);\r
 907         when damenoire:   resultat:=resultat-val4(i);\r
 908         esac;\r
 909     od;\r
 910     detach;\r
 911 od;\r
 912 end note;\r
 913 \r
 914 unit alpha:recurrence coroutine(qui,prof:integer);\r
 915 (* Maximise les coups de l'ordinateur *)\r
 916 \r
 917 var i,k,maxi,ncoup,nmax,valeur:integer,\r
 918     damier:arrayof integer,\r
 919     liste:arrayof arrayof integer,\r
 920     rec:recurrence;\r
 921 begin\r
 922     array damier dim(1:50);\r
 923     array liste dim(1:50);\r
 924     if prof>1\r
 925     then rec:=new beta(damier,-qui,prof-1)\r
 926     else rec:=new note(damier,moi);\r
 927     fi;\r
 928 return;\r
 929 do\r
 930     clc.joueur:=qui;   clc.damier:=jeu;   clc.liste_coup:=liste;\r
 931     attach(clc);   nmax:=clc.nbmax;   ncoup:=clc.nb_coup;\r
 932     if ncoup<=0\r
 933     then resultat:=-999\r
 934     else\r
 935         maxi:=-1000;\r
 936         for i:=1 to ncoup do\r
 937             for k:=1 to 50 do damier(k):=jeu(k); od;\r
 938             call maj_damier(damier,liste(i),qui);\r
 939                 rec.alf:=alf;\r
 940                 rec.bet:=bet;\r
 941                 attach(rec);\r
 942                 valeur:=rec.resultat;\r
 943                 if maxi<valeur then\r
 944                     maxi:=valeur;\r
 945                     if alf<maxi then alf:=maxi; fi;\r
 946                     if maxi>=bet then\r
 947                         exit;\r
 948                 fi; fi;\r
 949             kill(liste(i));\r
 950         od;\r
 951         for k:=i to ncoup do kill(liste(k));od;\r
 952         resultat:=maxi;\r
 953     fi;\r
 954     detach;\r
 955 od;\r
 956 end alpha;\r
 957 \r
 958 unit beta:recurrence coroutine(qui,prof:integer);\r
 959 (* Minimise les coups du joueur *)\r
 960 \r
 961 var i,k,maxi,ncoup,nmax,valeur:integer,\r
 962     damier:arrayof integer,\r
 963     liste:arrayof arrayof integer,\r
 964     rec:recurrence;\r
 965 begin\r
 966     array damier dim(1:50);\r
 967     array liste dim(1:50);\r
 968     if prof>1\r
 969     then rec:=new alpha(damier,-qui,prof-1)\r
 970     else rec:=new note(damier,moi);\r
 971     fi;\r
 972 return;\r
 973 do\r
 974     clc.joueur:=qui;   clc.damier:=jeu;   clc.liste_coup:=liste;\r
 975     attach(clc);   nmax:=clc.nbmax;   ncoup:=clc.nb_coup;\r
 976     if ncoup<=0\r
 977     then resultat:=999\r
 978     else\r
 979         maxi:=1000;\r
 980         for i:=1 to ncoup do\r
 981             for k:=1 to 50 do damier(k):=jeu(k); od;\r
 982             call maj_damier(damier,liste(i),qui);\r
 983                 rec.alf:=alf;\r
 984                 rec.bet:=bet;\r
 985                 attach(rec);\r
 986                 valeur:=rec.resultat;\r
 987             if maxi>valeur then\r
 988                 maxi:=valeur;\r
 989                 if bet>maxi then bet:=maxi; fi;\r
 990                 if maxi<=alf then\r
 991                     exit;\r
 992             fi; fi;\r
 993             kill(liste(i));\r
 994         od;\r
 995         for k:=i to ncoup do kill(liste(k));od;\r
 996         resultat:=maxi;\r
 997     fi;\r
 998     detach;\r
 999 od;\r
1000 end beta;\r
1001 \r
1002 begin (*computer*)\r
1003     array listejou dim(1:50);\r
1004     array damierec dim(1:50);\r
1005     rec:=new beta(damierec,-moi,prof);\r
1006 return;\r
1007     call hidecursor;\r
1008     if moi=blanc then\r
1009         call aff_tab_car((debhoriz-80)div 2,debvert+6*vert,unpack("Note: "));\r
1010         call aff_tab_car((debhoriz-112)div 2,debvert+4*vert,\r
1011             unpack("Meilleur coup:"));\r
1012         call aff_tab_car((debhoriz-120)div 2,debvert+7*vert,\r
1013             unpack("Coup en calcul:"));\r
1014     else\r
1015         call aff_tab_car((debhoriz+10*horiz+(debhoriz-80)div 2),\r
1016             debvert+6*vert,unpack("Note: "));\r
1017         call aff_tab_car((debhoriz+10*horiz+(debhoriz-112)div 2),\r
1018             debvert+4*vert,unpack("Meilleur coup:"));\r
1019         call aff_tab_car((debhoriz+10*horiz+(debhoriz-120)div 2),\r
1020             debvert+7*vert,unpack("Coup en calcul:"));\r
1021     fi;\r
1022     do\r
1023         if moi=blanc then\r
1024             call aff_tab_car((debhoriz-40)div 2,debvert+5*vert,unpack("-- --"));\r
1025             call aff_tab_car(((debhoriz-80)div 2)+48,debvert+6*vert,\r
1026                 unpack("    "));\r
1027         else\r
1028             call aff_tab_car((debhoriz+10*horiz+(debhoriz-40)div 2),\r
1029                 debvert+5*vert,unpack("-- --"));\r
1030             call aff_tab_car((debhoriz+10*horiz+(debhoriz-80)div 2+48),\r
1031                 debvert+6*vert,unpack("    "));\r
1032         fi;\r
1033         call showcursor;\r
1034         clc.joueur:=moi;   clc.damier:=damier;   clc.liste_coup:=listejou;\r
1035         attach(clc);   nmax:=clc.nbmax;   ncoup:=clc.nb_coup;\r
1036         if ncoup=1 then\r
1037             coupjou:=listejou(1);\r
1038             listejou(1):=none;\r
1039         else\r
1040             maxi:=-1000;\r
1041             alf:=-999;\r
1042             for i:=1 to ncoup do\r
1043                 call hidecursor;\r
1044                 if moi=blanc then\r
1045                     call aff_nb(((debhoriz-40)div 2),debvert+8*vert,\r
1046                         listejou(i,1),4);\r
1047                     call aff_nb(((debhoriz-40)div 2)+24,debvert+8*vert,\r
1048                         listejou(i,upper(listejou(i))),4);\r
1049                 else\r
1050                     call aff_nb((debhoriz+10*horiz+(debhoriz-40)div 2),\r
1051                         debvert+8*vert,listejou(i,1),4);\r
1052                     call aff_nb((debhoriz+10*horiz+(debhoriz-40)div 2)+24,\r
1053                         debvert+8*vert,listejou(i,upper(listejou(i))),4);\r
1054                 fi;\r
1055                 call showcursor;\r
1056                 for k:=1 to 50 do damierec(k):=damier(k); od;\r
1057                 call maj_damier(damierec,listejou(i),moi);\r
1058                 rec.alf:=alf;\r
1059                 rec.bet:=999;\r
1060                 attach(rec);\r
1061                 valeur:=rec.resultat;\r
1062                 if valeur=maxi then\r
1063                     if moi=blanc then\r
1064                         if random<0.75 then\r
1065                             kill(coupjou);\r
1066                             coupjou:=copy(listejou(i));\r
1067                             kill(listejou(i));\r
1068                         fi;\r
1069                     else if random>0.75 then\r
1070                         kill(coupjou);\r
1071                         coupjou:=copy(listejou(i));\r
1072                         kill(listejou(i));\r
1073                 fi; fi; fi;\r
1074                 if maxi<valeur then\r
1075                     maxi:=valeur;\r
1076                     if alf<maxi then alf:=maxi; fi;\r
1077                     kill(coupjou);\r
1078                     coupjou:=copy(listejou(i));\r
1079                     kill(listejou(i));\r
1080                 fi;\r
1081                 call hidecursor;\r
1082                 if moi=blanc then\r
1083                     call aff_nb(((debhoriz-80)div 2)+48,debvert+6*vert,maxi,4);\r
1084                     call aff_nb(((debhoriz-40)div 2),debvert+5*vert,\r
1085 coupjou(1) (*listejou(num,1)*) ,4);\r
1086                     call aff_nb(((debhoriz-40)div 2)+24,debvert+5*vert,\r
1087 coupjou(nmax) (*listejou(num,upper(listejou(num)))*) ,4);\r
1088                 else\r
1089                     call aff_nb((debhoriz+10*horiz+(debhoriz-80)div 2)+48,\r
1090                         debvert+6*vert,maxi,4);\r
1091                     call aff_nb((debhoriz+10*horiz+(debhoriz-40)div 2),\r
1092 debvert+5*vert,coupjou(1) (*listejou(num,1)*) ,4);\r
1093                     call aff_nb((debhoriz+10*horiz+(debhoriz-40)div 2)+24,\r
1094 debvert+5*vert,coupjou(nmax) (*listejou(num,upper(listejou(num)))*) ,4);\r
1095                 fi;\r
1096                 call showcursor;\r
1097             od;\r
1098             call hidecursor;\r
1099             if moi=blanc then\r
1100                 call aff_tab_car((debhoriz-40)div 2,debvert+8*vert,unpack("-- --"));\r
1101             else\r
1102                 call aff_tab_car((debhoriz+10*horiz+(debhoriz-40)div 2),\r
1103                     debvert+8*vert,unpack("-- --"));\r
1104             fi;\r
1105             call showcursor;\r
1106 (*coupjou:=listejou(num);*)\r
1107         fi;\r
1108         detach;\r
1109         call showcursor;\r
1110     od;\r
1111 end computer;\r
1112 \r
1113 unit player:participant coroutine;\r
1114 (* Enregistre le coup jou\82 par l'utilisateur *)\r
1115 \r
1116 var ok,q,ret,saute:boolean,\r
1117     cas,deb,fin,i,j,k,ncoup,nmax,prof:integer,\r
1118     coupe,damierjou:arrayof integer,\r
1119     listejou:arrayof arrayof integer;\r
1120 begin\r
1121     array listejou dim(1:50);\r
1122 return;\r
1123 do\r
1124     clc.joueur:=moi;   clc.damier:=damier;   clc.liste_coup:=listejou;\r
1125     attach(clc);   nmax:=clc.nbmax;   ncoup:=clc.nb_coup;\r
1126     damierjou:=damier;   array coupe dim(1:21);  \r
1127     do\r
1128         do      \r
1129             ok:=false;\r
1130             deb:=1;\r
1131             prof:=1;\r
1132             cas:=quelle_caz;\r
1133             if(cas<>0) then\r
1134                 if(damier(cas)=moi or damier(cas)=(moi+moi))then\r
1135                     i:=1;\r
1136                     coupe(i):=cas;\r
1137                     exit;\r
1138             fi; fi;\r
1139         od;\r
1140         j:=deb;\r
1141         while(j<=ncoup) do\r
1142             if coupe(1)=listejou(j,1) then \r
1143                 ok:=true;\r
1144                 deb:=j;\r
1145                 exit;\r
1146             fi;\r
1147             j:=j+1;      \r
1148         od;\r
1149         while((j<=ncoup) and ok) do\r
1150             if coupe(1)=listejou(j,1)\r
1151             then j:=j+1;\r
1152             else exit;\r
1153             fi;\r
1154         od;\r
1155         fin:=j-1;\r
1156         if ok then exit; fi;\r
1157     od;   \r
1158 (*    pref mouse block begin*)\r
1159         call hidecursor;\r
1160         call aff_croix(cas);\r
1161         call showcursor;\r
1162         cas:=quelle_caz;\r
1163         if (upper(listejou(1))>2)\r
1164         then saute:=true;\r
1165         else saute:=false;\r
1166         fi;\r
1167         do\r
1168             deb:=1;\r
1169             fin:=ncoup;\r
1170             ret:=false;\r
1171             if saute\r
1172             then i:=i+2;\r
1173             else i:=i+1;\r
1174             fi;\r
1175             coupe(i):=cas;\r
1176             q:=false;\r
1177             ok:=false;\r
1178             if i>1 andif not(saute) andif coupe(i)=coupe(i-1) then \r
1179                 i:=i-1;\r
1180                 ret:=true;\r
1181             fi;\r
1182             if i>2 andif saute andif coupe(i)=coupe(i-2) then   \r
1183                 i:=i-2;\r
1184                 ret:=true;\r
1185             fi;\r
1186             if ret then   \r
1187                 call hidecursor;\r
1188                 case damier(coupe(i))\r
1189                 when blanc:       call aff_blanc(coupe(i));\r
1190                 when noir:        call aff_noir(coupe(i));\r
1191                 when dameblanche: call aff_dameblanche(coupe(i));\r
1192                 when damenoire:   call aff_damenoire(coupe(i));\r
1193                 otherwise         call del_case(coupe(i));\r
1194                 esac;\r
1195                 if saute\r
1196                 then i:=i-2;\r
1197                 else i:=i-1;\r
1198                 fi;\r
1199                 call showcursor;\r
1200             else          \r
1201                 if i=2 then\r
1202                     if (damier(coupe(1))=moi and(coupe(2)=h_d(moi,coupe(1)) \r
1203                     or coupe(2)=h_g(moi,coupe(1))))\r
1204                     then saute:=false;\r
1205                     else\r
1206                         if (damier(coupe(1))=moi) then\r
1207                             i:=i+1;\r
1208                             coupe(3):=coupe(2);\r
1209                             saute:=true;\r
1210                 fi; fi; fi;\r
1211                 j:=deb;\r
1212                 if (i<=nmax) then\r
1213                     while(j<=fin) do\r
1214                         ok:=true;\r
1215                         k:=1;\r
1216                         while k<=i do\r
1217                             if coupe(k)<>listejou(j,k) then \r
1218                                 ok:=false;\r
1219                                 exit;\r
1220                             fi;\r
1221                             if saute\r
1222                             then k:=k+2;\r
1223                             else k:=k+1;\r
1224                             fi;\r
1225                         od;\r
1226                         if ok then\r
1227                             deb:=j;\r
1228                             exit;\r
1229                         else j:=j+1;      \r
1230                         fi;\r
1231                     od;\r
1232                     j:=deb;\r
1233                     while((j<=fin) and ok) do\r
1234                         k:=1;\r
1235                         while k<=i do\r
1236                             if coupe(k)<>listejou(j,k) then\r
1237                                 q:=true;\r
1238                                 exit; \r
1239                             fi;\r
1240                             if saute\r
1241                             then k:=k+2;\r
1242                             else k:=k+1;\r
1243                             fi;\r
1244                         od;\r
1245                         if q then exit; fi;\r
1246                         j:=j+1;\r
1247                     od;\r
1248                     fin:=j-1;\r
1249                 else\r
1250                     saute:=false;\r
1251                     i:=i-1;\r
1252                 fi;\r
1253                 if ok then\r
1254                     call hidecursor;\r
1255                     call aff_croix(cas);\r
1256                     call showcursor;\r
1257                 else\r
1258                     if saute\r
1259                     then i:=i-2;\r
1260                     else i:=i-1;\r
1261                 fi; fi;\r
1262                 if (i=nmax) then exit; fi;\r
1263             fi;         \r
1264             cas:=quelle_caz;\r
1265         od;\r
1266         array coupjou dim (1:i);\r
1267         for i:=1 to upper(coupjou) do\r
1268             coupjou(i):=listejou(deb,i);\r
1269         od;\r
1270 (*    end;*)\r
1271     detach;\r
1272 od;\r
1273 end player;\r
1274 \r
1275 begin (*main*)\r
1276     pref mouse block;\r
1277     var driver:boolean,\r
1278         bouton:integer;\r
1279     begin\r
1280         (* v\82rifie qu'un gestionnaire de souris est install\82 *)\r
1281 \r
1282         driver:=init(bouton);\r
1283         if driver\r
1284         then writeln("Une souris avec ",bouton:1, " boutons a \82t\82 d\82tect\82e");\r
1285         else writeln("Erreur: aucune souris n'a \82t\82 d\82tect\82e\r
1286             , celle-ci est obligatoire"); exit;\r
1287         fi;\r
1288         pref IIUWGraph block\r
1289         begin\r
1290         (*v\82rifie que la carte vid\82o pr\82sente est support\82e par le programme*)\r
1291 \r
1292             case nocard\r
1293                 when 5:\r
1294                 (* Cas d'une carte EGA/VGA/SVGA *)\r
1295                     writeln("Une carte EGA ou compatible VGA a \82t\82 d\82tect\82e");\r
1296                     coulblanc:=15;coulnoir:=0;coulrouge:=12;\r
1297                     horiz:=30;vert:=25;debhoriz:=160;debvert:=50;\r
1298                     horiz1:=29;vert1:=24;horiz2:=60;\r
1299                 otherwise\r
1300                     writeln("La carte vid\82o pr\82sente n'est pas supportee\r
1301                         par le programme: ",nocard);\r
1302                     writeln("Une carte EGA ou compatible VGA est obligatoire");\r
1303                     exit;\r
1304             esac;\r
1305             arb:=new arbitre;\r
1306             attach(arb);\r
1307         end (*IIUWGraph*);\r
1308     end (* mouse *)\r
1309 end (* program *)\r