examples/jeu/reversi.log

   1 PROGRAM Reversi;\r
   2 \r
   3 (*** 2ø PROJET DE LI1 DU BINOME : LAPORTE-FAURET Olivier\r
   4                                   GOUDOU Pascal          ***)\r
   5 \r
   6 CONST noir=0, bleu=1, rouge=4, jaune=14, blanc=15,\r
   7       bas_g=1,  gauche=2, haut_g=3, haut=4,\r
   8       haut_d=5, droite=6, bas_d=7,  bas=8;\r
   9 \r
  10 VAR   nb_rouges,nb_bleus,libre : INTEGER,\r
  11       grille                   : ARRAYOF ARRAYOF rectangle,\r
  12       gr_prio                  : ARRAYOF ARRAYOF INTEGER,\r
  13       meill_coup               : ARRAYOF infos,\r
  14       som_prio,nb_pions_pris   : INTEGER,\r
  15       ligne,colonne            : INTEGER;\r
  16 \r
  17 \r
  18 \r
  19 (***********************************************************************)\r
  20 \r
  21 UNIT points : CLASS;\r
  22 VAR x,y : INTEGER;\r
  23 END points;\r
  24 \r
  25 (***********************************************************************)\r
  26 \r
  27 UNIT rectangle : CLASS;\r
  28 VAR p1, p2 : points,\r
  29     occupe : INTEGER;\r
  30 END rectangle;\r
  31 \r
  32 (***********************************************************************)\r
  33 \r
  34 UNIT infos : CLASS;\r
  35 VAR sens  : INTEGER,\r
  36     li,co : INTEGER;\r
  37 END infos;\r
  38 \r
  39 (***********************************************************************)\r
  40 \r
  41 UNIT affiche_grille : PROCEDURE;\r
  42 \r
  43   UNIT init_grille : PROCEDURE;\r
  44   (*** Cette proc\82dure permet d'initialiser les grilles et les tableaux\r
  45        n\82cessaires au bon d\82roulement du programme. ***)\r
  46 \r
  47   VAR i,j,icks,igrec : INTEGER;\r
  48   BEGIN\r
  49   (* initialisation de la grille devant contenir les pions rouges et bleus *)\r
  50     ARRAY grille DIM (1:8);\r
  51     FOR i:=1 TO 8\r
  52     DO\r
  53       ARRAY grille(i) DIM (1:8);\r
  54     OD;\r
  55     igrec:=40;\r
  56     FOR i:=1 TO 8\r
  57     DO\r
  58       icks:=10;\r
  59       FOR j:=1 TO 8\r
  60       DO\r
  61         grille(i,j):=NEW rectangle;\r
  62         grille(i,j).p1:=NEW points;\r
  63         grille(i,j).p2:=NEW points;\r
  64         grille(i,j).p1.x:=icks;\r
  65         grille(i,j).p1.y:=igrec;\r
  66         grille(i,j).p2.x:=icks+36;\r
  67         grille(i,j).p2.y:=igrec+30;\r
  68         grille(i,j).occupe:=noir;\r
  69         icks:=icks+36;\r
  70       OD;\r
  71       igrec:=igrec+30;\r
  72     OD;\r
  73   (* initialisation de la grille des priorit\82s *)\r
  74     ARRAY gr_prio dim (1:8);\r
  75     FOR i:=1 TO 8\r
  76     DO\r
  77       ARRAY gr_prio(i) DIM (1:8);\r
  78     OD;\r
  79     gr_prio(1,1):=20;\r
  80     gr_prio(1,8):=20;\r
  81     gr_prio(8,1):=20;\r
  82     gr_prio(8,8):=20;\r
  83     gr_prio(1,3):=14;\r
  84     gr_prio(1,6):=14;\r
  85     gr_prio(8,3):=14;\r
  86     gr_prio(8,6):=14;\r
  87     gr_prio(3,1):=14;\r
  88     gr_prio(6,1):=14;\r
  89     gr_prio(3,8):=14;\r
  90     gr_prio(6,8):=14;\r
  91     gr_prio(1,4):=12;\r
  92     gr_prio(1,5):=12;\r
  93     gr_prio(8,4):=12;\r
  94     gr_prio(8,5):=12;\r
  95     gr_prio(4,1):=12;\r
  96     gr_prio(5,1):=12;\r
  97     gr_prio(4,8):=12;\r
  98     gr_prio(5,8):=12;\r
  99     gr_prio(1,2):=9;\r
 100     gr_prio(1,7):=9;\r
 101     gr_prio(8,2):=9;\r
 102     gr_prio(8,7):=9;\r
 103     gr_prio(2,1):=9;\r
 104     gr_prio(7,1):=9;\r
 105     gr_prio(2,8):=9;\r
 106     gr_prio(7,8):=9;\r
 107     gr_prio(3,3):=6;\r
 108     gr_prio(3,6):=6;\r
 109     gr_prio(6,3):=6;\r
 110     gr_prio(6,6):=6;\r
 111     gr_prio(3,4):=4;\r
 112     gr_prio(3,5):=4;\r
 113     gr_prio(6,4):=4;\r
 114     gr_prio(6,5):=4;\r
 115     gr_prio(4,3):=4;\r
 116     gr_prio(5,3):=4;\r
 117     gr_prio(4,6):=4;\r
 118     gr_prio(5,6):=4;\r
 119     gr_prio(2,3):=2;\r
 120     gr_prio(2,4):=2;\r
 121     gr_prio(2,5):=2;\r
 122     gr_prio(2,6):=2;\r
 123     gr_prio(7,3):=2;\r
 124     gr_prio(7,4):=2;\r
 125     gr_prio(7,5):=2;\r
 126     gr_prio(7,6):=2;\r
 127     gr_prio(3,2):=2;\r
 128     gr_prio(4,2):=2;\r
 129     gr_prio(5,2):=2;\r
 130     gr_prio(6,2):=2;\r
 131     gr_prio(3,7):=2;\r
 132     gr_prio(4,7):=2;\r
 133     gr_prio(5,7):=2;\r
 134     gr_prio(6,7):=2;\r
 135     gr_prio(4,4):=2;\r
 136     gr_prio(4,5):=2;\r
 137     gr_prio(5,4):=2;\r
 138     gr_prio(5,5):=2;\r
 139     gr_prio(2,2):=1;\r
 140     gr_prio(2,7):=1;\r
 141     gr_prio(7,2):=1;\r
 142     gr_prio(7,7):=1;\r
 143   END init_grille;\r
 144 \r
 145   UNIT cercles_au_centre : PROCEDURE;\r
 146   VAR i,j : INTEGER;\r
 147   BEGIN\r
 148     CALL dessine_cercle(4,4,rouge);\r
 149     CALL dessine_cercle(4,5,bleu);\r
 150     CALL dessine_cercle(5,4,bleu);\r
 151     CALL dessine_cercle(5,5,rouge);\r
 152     nb_rouges:=2;  nb_bleus:=2;  libre:=60;\r
 153   END cercles_au_centre;\r
 154 \r
 155   UNIT chiffres : IIUWGRAPH PROCEDURE;\r
 156   VAR i,col,lig : INTEGER;\r
 157   BEGIN\r
 158     CALL COLOR(blanc);\r
 159     col:=28;\r
 160     FOR i:=49 TO 56\r
 161     DO\r
 162       CALL MOVE(col,30);\r
 163       CALL HASCII(i);\r
 164       col:=col+36;\r
 165     OD;\r
 166     lig:=55;\r
 167     FOR i:=49 TO 56\r
 168     DO\r
 169       CALL MOVE(0,lig);\r
 170       CALL HASCII(i);\r
 171       lig:=lig+30;\r
 172     OD;\r
 173   END chiffres;\r
 174 \r
 175   UNIT quadrillage : IIUWGRAPH PROCEDURE;\r
 176   VAR col,lig : INTEGER;\r
 177   BEGIN\r
 178     CALL COLOR(blanc);\r
 179     col:=10;\r
 180     WHILE col<=298\r
 181     DO\r
 182       CALL MOVE(col,40);\r
 183       CALL DRAW(col,280);\r
 184       col:=col+36;\r
 185     OD;\r
 186     lig:=40;\r
 187     WHILE lig<=280\r
 188     DO\r
 189       CALL MOVE(10,lig);\r
 190       CALL DRAW(296,lig);\r
 191       lig:=lig+30;\r
 192     OD;\r
 193   END quadrillage;\r
 194 \r
 195 VAR col,lig,tch : INTEGER;\r
 196 BEGIN\r
 197   CALL init_grille;\r
 198   CALL quadrillage;\r
 199   CALL cercles_au_centre;\r
 200   CALL chiffres;\r
 201 END affiche_grille;\r
 202 \r
 203 (***********************************************************************)\r
 204 \r
 205 UNIT dessine_cercle : IIUWGRAPH PROCEDURE(ptx,pty,couleur : INTEGER);\r
 206 VAR cx,cy : INTEGER;\r
 207 BEGIN\r
 208   PREF MOUSE BLOCK\r
 209   BEGIN\r
 210     CALL COLOR(couleur);\r
 211     cx:=(grille(ptx,pty).p1.x + grille(ptx,pty).p2.x)/2;\r
 212     cy:=(grille(ptx,pty).p1.y + grille(ptx,pty).p2.y)/2;\r
 213     CALL HIDECURSOR;\r
 214     CALL CIRB(cx,cy,16,0.0,0.0,couleur,1,1,1);\r
 215     CALL SHOWCURSOR;\r
 216     grille(ptx,pty).occupe:=couleur;\r
 217   END;\r
 218 END dessine_cercle;\r
 219 \r
 220 (***********************************************************************)\r
 221 \r
 222 UNIT efface : IIUWGRAPH PROCEDURE(x,y : INTEGER);\r
 223 VAR abscis : INTEGER;\r
 224 BEGIN\r
 225   CALL COLOR(noir);\r
 226   CALL MOVE (x,y);\r
 227   FOR abscis:=x TO 639\r
 228   DO\r
 229     CALL OUTSTRING(" ");\r
 230     CALL MOVE(abscis,y);\r
 231   OD;\r
 232 END efface;\r
 233 \r
 234 (***********************************************************************)\r
 235 \r
 236 UNIT texte : IIUWGRAPH PROCEDURE (x,y,c : INTEGER; s : STRING);\r
 237 BEGIN\r
 238   PREF MOUSE BLOCK\r
 239   BEGIN\r
 240     CALL COLOR(c);\r
 241     CALL MOVE (x,y);\r
 242     CALL OUTSTRING(s);\r
 243   END;\r
 244 END texte;\r
 245 \r
 246 (***********************************************************************)\r
 247 \r
 248 UNIT fill : IIUWGRAPH PROCEDURE (x,y,large,haut,couleur:INTEGER) ;\r
 249 VAR i : INTEGER ;\r
 250 BEGIN\r
 251   CALL COLOR(couleur);\r
 252   FOR i:=y TO y+haut\r
 253   DO\r
 254     CALL MOVE(x,i) ;\r
 255     CALL DRAW(x+large,i) ;\r
 256   OD ;\r
 257 END fill;\r
 258 \r
 259 (***********************************************************************)\r
 260 \r
 261 UNIT saisie_rep : IIUWGRAPH PROCEDURE (couleur : INTEGER;\r
 262                                        OUTPUT valeur   : CHAR);\r
 263 VAR c : INTEGER;\r
 264 BEGIN\r
 265   DO\r
 266     c:=INKEY;\r
 267     IF c=78 ORIF c=79 ORIF c=110 ORIF c=111 THEN EXIT FI;\r
 268       (* N *)   (* O *)   (* n *)    (* o *)\r
 269   OD;\r
 270   valeur:=CHR(c);\r
 271   (*CALL COLOR(couleur);\r
 272   CALL HASCII(c);\r
 273   CALL pause(1);*)\r
 274 END saisie_rep;\r
 275 \r
 276 (***********************************************************************)\r
 277 \r
 278 UNIT pause : PROCEDURE(seconde : INTEGER);\r
 279 VAR temps:INTEGER;\r
 280 BEGIN\r
 281   FOR temps:=1 TO (1000*seconde) DO OD;\r
 282 END pause;\r
 283 \r
 284 \r
 285 (***********************************************************************)\r
 286 \r
 287 UNIT test_couleur : PROCEDURE(couleur : INTEGER);\r
 288 BEGIN\r
 289   IF couleur=rouge THEN\r
 290     nb_rouges:=nb_rouges+1;\r
 291     nb_bleus:=nb_bleus-1\r
 292   ELSE\r
 293     nb_bleus:=nb_bleus+1;\r
 294     nb_rouges:=nb_rouges-1;\r
 295   FI;\r
 296 END test_couleur;\r
 297 \r
 298 (***********************************************************************)\r
 299 (* Dans les 4 proc\82dures qui suivent, les fl\8aches pr\82sentes sous les en_t\88tes\r
 300    indiquent le sens dans lequel s'effectue la coloration *)\r
 301 \r
 302 UNIT diagonale_droite : PROCEDURE(xd,yd,xa,ya,colorie : INTEGER);\r
 303 (*     > *)\r
 304 (*    /  *)\r
 305 (*   /   *)\r
 306 (*  /    *)\r
 307 (* /     *)\r
 308 VAR i,j : INTEGER;\r
 309 BEGIN\r
 310   i:=xd;\r
 311   j:=yd;\r
 312   WHILE i>=xa AND j<=ya\r
 313   DO\r
 314     CALL dessine_cercle(i,j,colorie);\r
 315     CALL test_couleur(colorie);\r
 316     i:=i-1;\r
 317     j:=j+1;\r
 318   OD;\r
 319 END diagonale_droite;\r
 320 \r
 321 (***********************************************************************)\r
 322 \r
 323 UNIT diagonale_gauche : PROCEDURE(xd,yd,xa,ya,colorie : INTEGER);\r
 324 (* <     *)\r
 325 (*  \    *)\r
 326 (*   \   *)\r
 327 (*    \  *)\r
 328 (*     \ *)\r
 329 VAR i,j : INTEGER;\r
 330 BEGIN\r
 331   i:=xd;\r
 332   j:=yd;\r
 333   WHILE i>=xa AND j>=ya\r
 334   DO\r
 335     CALL dessine_cercle(i,j,colorie);\r
 336     CALL test_couleur(colorie);\r
 337     i:=i-1;\r
 338     j:=j-1;\r
 339   OD;\r
 340 END diagonale_gauche;\r
 341 \r
 342 (***********************************************************************)\r
 343 \r
 344 UNIT verticale : PROCEDURE(xd,xa,y,colorie : INTEGER);\r
 345 (*   |   *)\r
 346 (*   |   *)\r
 347 (*   |   *)\r
 348 (*   |   *)\r
 349 (*   v   *)\r
 350 VAR i : INTEGER;\r
 351 BEGIN\r
 352   i:=xd;\r
 353   WHILE i<=xa\r
 354   DO\r
 355     CALL dessine_cercle(i,y,colorie);\r
 356     CALL test_couleur(colorie);\r
 357     i:=i+1;\r
 358   OD;\r
 359 END verticale;\r
 360 \r
 361 (***********************************************************************)\r
 362 \r
 363 UNIT horizontale : PROCEDURE(x,yd,ya,colorie : INTEGER);\r
 364 (*        *)\r
 365 (*        *)\r
 366 (* -----> *)\r
 367 (*        *)\r
 368 (*        *)\r
 369 VAR j : INTEGER;\r
 370 BEGIN\r
 371   j:=yd;\r
 372   WHILE j<=ya\r
 373   DO\r
 374     CALL dessine_cercle(x,j,colorie);\r
 375     CALL test_couleur(colorie);\r
 376     j:=j+1;\r
 377   OD;\r
 378 END horizontale;\r
 379 \r
 380 (***********************************************************************)\r
 381 \r
 382 UNIT cherche_intervalle : IIUWGRAPH PROCEDURE(abscis,ordon,couleur : INTEGER;\r
 383                                               dessinez             : BOOLEAN;\r
 384                                               OUTPUT trouve        : BOOLEAN);\r
 385 VAR i,j,inverse          : INTEGER,\r
 386     somme,nb_pris,so,nbp : INTEGER;\r
 387 BEGIN\r
 388   IF couleur=rouge THEN inverse:=bleu ELSE inverse:=rouge FI;\r
 389   IF ordon>2 THEN\r
 390   (* recherche en bas \85 gauche *)\r
 391     IF abscis<7 THEN\r
 392       i:=abscis;  j:=ordon;\r
 393       DO\r
 394         so:=so+gr_prio(i,j);\r
 395         i:=i+1;  j:=j-1;\r
 396         IF i>8 ORIF j<1 THEN EXIT FI;\r
 397         IF grille(i,j).occupe<>inverse THEN EXIT FI;\r
 398         nbp:=nbp+1;\r
 399       OD;\r
 400       IF i<=8 ANDIF i<>abscis+1 ANDIF j>=1 ANDIF j<>ordon-1\r
 401       ANDIF grille(i,j).occupe=couleur THEN\r
 402         somme:=so;  nb_pris:=nbp;\r
 403         trouve:=TRUE;\r
 404         IF dessinez THEN\r
 405           CALL diagonale_droite(i-1,j+1,abscis+1,ordon-1,couleur);\r
 406         ELSE\r
 407           IF couleur=rouge THEN RETURN FI;\r
 408         FI;\r
 409       FI;\r
 410     FI; (*abscis<7*)\r
 411 \r
 412   (* recherche vers la gauche *)\r
 413     so:=0; nbp:=0;\r
 414     j:=ordon;\r
 415     DO\r
 416       so:=so+gr_prio(abscis,j);\r
 417       j:=j-1;\r
 418       IF j<1 THEN EXIT FI;\r
 419       IF grille(abscis,j).occupe<>inverse THEN EXIT FI;\r
 420       nbp:=nbp+1;\r
 421     OD;\r
 422     IF j>=1 ANDIF j<>ordon-1 ANDIF grille(abscis,j).occupe=couleur THEN\r
 423       somme:=somme+so;  nb_pris:=nb_pris+nbp;\r
 424       trouve:=TRUE;\r
 425       IF dessinez THEN\r
 426         CALL horizontale(abscis,j+1,ordon-1,couleur);\r
 427       ELSE\r
 428         IF couleur=rouge THEN RETURN FI;\r
 429       FI;\r
 430     FI;\r
 431 \r
 432   (* recherche en haut \85 gauche *)\r
 433     IF abscis>2 THEN\r
 434       so:=0; nbp:=0;\r
 435       i:=abscis;  j:=ordon;\r
 436       DO\r
 437         so:=so+gr_prio(i,j);\r
 438         i:=i-1; j:=j-1;\r
 439         IF i<1 ORIF j<1 THEN EXIT FI;\r
 440         IF grille(i,j).occupe<>inverse THEN EXIT FI;\r
 441         nbp:=nbp+1;\r
 442       OD;\r
 443       IF i>=1 ANDIF i<>abscis-1 ANDIF j>=1 ANDIF j<>ordon-1\r
 444       ANDIF grille(i,j).occupe=couleur THEN\r
 445         somme:=somme+so;  nb_pris:=nb_pris+nbp;\r
 446         trouve:=TRUE;\r
 447         IF dessinez THEN\r
 448           CALL diagonale_gauche(abscis-1,ordon-1,i+1,j+1,couleur);\r
 449         ELSE\r
 450           IF couleur=rouge THEN RETURN FI;\r
 451         FI;\r
 452       FI;\r
 453     FI; (*abscis>2*)\r
 454   FI; (*ordon>2*)\r
 455 \r
 456   (* recherche vers le haut *)\r
 457   IF abscis>2 THEN\r
 458     so:=0; nbp:=0;\r
 459     i:=abscis;\r
 460     DO\r
 461       so:=so+gr_prio(i,ordon);\r
 462       i:=i-1;\r
 463       IF i<1 THEN EXIT FI;\r
 464       IF grille(i,ordon).occupe<>inverse THEN EXIT FI;\r
 465       nbp:=nbp+1;\r
 466     OD;\r
 467     IF i>=1 ANDIF i<>abscis-1 ANDIF grille(i,ordon).occupe=couleur THEN\r
 468       somme:=somme+so;  nb_pris:=nb_pris+nbp;\r
 469       trouve:=TRUE;\r
 470       IF dessinez THEN\r
 471         CALL verticale(i+1,abscis-1,ordon,couleur);\r
 472       ELSE\r
 473         IF couleur=rouge THEN RETURN FI;\r
 474       FI;\r
 475     FI;\r
 476   FI; (*abscis>2*)\r
 477 \r
 478   IF ordon<7 THEN\r
 479   (* recherche en haut \85 droite *)\r
 480     IF abscis>2 THEN\r
 481       so:=0; nbp:=0;\r
 482       i:=abscis;  j:=ordon;\r
 483       DO\r
 484         so:=so+gr_prio(i,j);\r
 485         i:=i-1;  j:=j+1;\r
 486         IF i<1 ORIF j>8 THEN EXIT FI;\r
 487         IF grille(i,j).occupe<>inverse THEN EXIT FI;\r
 488         nbp:=nbp+1;\r
 489       OD;\r
 490       IF i>=1 ANDIF i<>abscis-1 ANDIF j<=8 ANDIF j<>ordon+1\r
 491       ANDIF grille(i,j).occupe=couleur THEN\r
 492         somme:=somme+so;  nb_pris:=nb_pris+nbp;\r
 493         trouve:=TRUE;\r
 494         IF dessinez THEN\r
 495           CALL diagonale_droite(abscis-1,ordon+1,i+1,j-1,couleur);\r
 496         ELSE\r
 497           IF couleur=rouge THEN RETURN FI;\r
 498         FI;\r
 499       FI;\r
 500     FI; (*abscis>2*)\r
 501 \r
 502   (* recherche vers la droite *)\r
 503     so:=0; nbp:=0;\r
 504     j:=ordon;\r
 505     DO\r
 506       so:=so+gr_prio(abscis,j);\r
 507       j:=j+1;\r
 508       IF j>8 THEN EXIT FI;\r
 509       IF grille(abscis,j).occupe<>inverse THEN EXIT FI;\r
 510       nbp:=nbp+1;\r
 511     OD;\r
 512     IF j<=8 ANDIF j<>ordon+1 ANDIF grille(abscis,j).occupe=couleur THEN\r
 513       somme:=somme+so;  nb_pris:=nb_pris+nbp;\r
 514       trouve:=TRUE;\r
 515       IF dessinez THEN\r
 516         CALL horizontale(abscis,ordon+1,j-1,couleur);\r
 517       ELSE\r
 518         IF couleur=rouge THEN RETURN FI;\r
 519       FI;\r
 520     FI;\r
 521 \r
 522   (* recherche en bas \85 droite *)\r
 523     IF abscis<7 THEN\r
 524       so:=0; nbp:=0;\r
 525       i:=abscis;  j:=ordon;\r
 526       DO\r
 527         so:=so+gr_prio(i,j);\r
 528         i:=i+1; j:=j+1;\r
 529         IF i>8 ORIF j>8 THEN EXIT FI;\r
 530         IF grille(i,j).occupe<>inverse THEN EXIT FI;\r
 531         nbp:=nbp+1;\r
 532       OD;\r
 533       IF i<=8 ANDIF i<>abscis+1 ANDIF j<=8 ANDIF j<>ordon+1\r
 534       ANDIF grille(i,j).occupe=couleur THEN\r
 535         somme:=somme+so;  nb_pris:=nb_pris+nbp;\r
 536         trouve:=TRUE;\r
 537         IF dessinez THEN\r
 538           CALL diagonale_gauche(i-1,j-1,abscis+1,ordon+1,couleur)\r
 539         ELSE\r
 540           IF couleur=rouge THEN RETURN FI;\r
 541         FI;\r
 542       FI;\r
 543     FI; (*abscis<7*)\r
 544   FI; (*ordon<7*)\r
 545 \r
 546   (* recherche vers le bas *)\r
 547   IF abscis<7 THEN\r
 548     so:=0; nbp:=0;\r
 549     i:=abscis;\r
 550     DO\r
 551       so:=so+gr_prio(i,ordon);\r
 552       i:=i+1;\r
 553       IF i>8 THEN EXIT FI;\r
 554       IF grille(i,ordon).occupe<>inverse THEN EXIT FI;\r
 555       nbp:=nbp+1;\r
 556     OD;\r
 557     IF i<=8 ANDIF i<>abscis+1 ANDIF grille(i,ordon).occupe=couleur THEN\r
 558       somme:=somme+so;  nb_pris:=nb_pris+nbp;\r
 559       trouve:=TRUE;\r
 560       IF dessinez THEN CALL verticale(abscis+1,i-1,ordon,couleur) FI;\r
 561     FI;\r
 562   FI; (*abscis<7*)\r
 563   IF trouve ANDIF dessinez THEN\r
 564     CALL dessine_cercle(abscis,ordon,couleur);\r
 565     IF couleur=rouge THEN nb_rouges:=nb_rouges+1\r
 566     ELSE nb_bleus:=nb_bleus+1;\r
 567     FI;\r
 568   FI;\r
 569   IF somme>=som_prio THEN\r
 570     IF nb_pris>nb_pions_pris THEN\r
 571       som_prio:=somme;\r
 572       nb_pions_pris:=nb_pris;\r
 573       ligne:=abscis;\r
 574       colonne:=ordon;\r
 575     FI;\r
 576   FI;\r
 577 END cherche_intervalle;\r
 578 \r
 579 (***********************************************************************)\r
 580 \r
 581 \r
 582 UNIT cherche_case : PROCEDURE(abscis,ordon  : INTEGER;\r
 583                               OUTPUT trouve : BOOLEAN);\r
 584 \r
 585  (* Cette proc\82dure va permettre de rechercher dans la matrice "grille",\r
 586     la position du point de coordonn\82es (abscis,ordon) - ce point correspond\r
 587     en fait au point de clic de la souris. La case ainsi obtenue se situe\r
 588     \85 la ligne lig et en colonne col *)\r
 589 \r
 590 VAR verif   : BOOLEAN,\r
 591     lig,col : INTEGER;\r
 592 BEGIN\r
 593   FOR lig:=1 TO 8\r
 594   DO\r
 595     IF grille(lig,1).p1.y<=ordon ANDIF ordon<=grille(lig,1).p2.y THEN\r
 596       FOR col:=1 TO 8\r
 597       DO\r
 598         IF grille(lig,col).p1.x<=abscis ANDIF\r
 599         abscis<=grille(lig,col).p2.x THEN\r
 600           IF grille(lig,col).occupe=noir THEN\r
 601             CALL cherche_intervalle(lig,col,rouge,TRUE,trouve);\r
 602           FI;\r
 603           EXIT;\r
 604         FI;\r
 605       OD;\r
 606       EXIT;\r
 607     FI;\r
 608   OD;\r
 609 END cherche_case;\r
 610 \r
 611 (***********************************************************************)\r
 612 \r
 613 UNIT app_tch : IIUWGRAPH PROCEDURE;\r
 614 VAR tch : INTEGER;\r
 615 BEGIN\r
 616   CALL texte(150,310,jaune,"APPUYER SUR ENTREE");\r
 617   DO\r
 618     tch:=INKEY;\r
 619     IF tch=13 THEN EXIT FI;\r
 620   OD;\r
 621 END app_tch;\r
 622 \r
 623 (***********************************************************************)\r
 624 \r
 625 UNIT resultat : PROCEDURE;\r
 626 BEGIN\r
 627   WRITELN("Rouges = ",nb_rouges :2    ,", Bleus = ",nb_bleus :2);\r
 628   IF nb_rouges>nb_bleus THEN\r
 629     WRITE("Les Rouges ont gagn\82 de ",nb_rouges-nb_bleus :2," point(s)") FI;\r
 630   IF nb_rouges<nb_bleus THEN\r
 631     WRITE("Les Bleus ont gagn\82 de ",nb_bleus-nb_rouges :2," point(s)") FI;\r
 632   IF nb_rouges=nb_bleus THEN\r
 633     WRITE("Egalit\82") FI;\r
 634   CALL app_tch;\r
 635 END resultat;\r
 636 \r
 637 (***********************************************************************)\r
 638 \r
 639 UNIT peut_jouer : PROCEDURE(pion : INTEGER; OUTPUT passe : BOOLEAN);\r
 640 VAR lig,col      : INTEGER,\r
 641     trouve       : BOOLEAN;\r
 642 BEGIN\r
 643   FOR lig:=1 TO 8\r
 644   DO\r
 645     FOR col:=1 TO 8\r
 646     DO\r
 647       IF grille(lig,col).occupe=noir THEN\r
 648         CALL cherche_intervalle(lig,col,pion,FALSE,trouve);\r
 649       FI;\r
 650       IF trouve ANDIF pion=rouge THEN EXIT FI;\r
 651     OD;\r
 652     IF trouve ANDIF pion=rouge THEN EXIT FI;\r
 653   OD;\r
 654   IF NOT trouve ANDIF pion=rouge THEN passe:=TRUE FI;\r
 655   IF nb_pions_pris=0 ANDIF pion=bleu THEN passe:=TRUE FI;\r
 656 END peut_jouer;\r
 657 \r
 658 (***********************************************************************)\r
 659 \r
 660 UNIT passe_son_tour : PROCEDURE(message : STRING);\r
 661 BEGIN\r
 662   CALL fill(339,249,160,10,noir);\r
 663   CALL texte(340,150,blanc,message);\r
 664   CALL pause(3);\r
 665   CALL fill(339,149,240,10,noir);\r
 666 END passe_son_tour;\r
 667 \r
 668 (***********************************************************************)\r
 669 \r
 670 UNIT init_souris : MOUSE PROCEDURE;\r
 671 VAR nb : INTEGER;\r
 672 BEGIN\r
 673   IF NOT INIT(nb) THEN\r
 674     CALL texte(300,100,rouge,"Erreur d'installation de la souris");EXIT;\r
 675   FI;\r
 676   CALL DEFCURSOR(1,11,12);\r
 677   CALL SHOWCURSOR;\r
 678   CALL SETWINDOW(0,625,0,330);\r
 679 END init_souris;\r
 680 \r
 681 (***********************************************************************)\r
 682 \r
 683 UNIT jeu : MOUSE PROCEDURE;\r
 684 VAR h,v,b,p                : INTEGER,\r
 685     couleur,indx,indy      : INTEGER,\r
 686     l,r,c,trouve           : BOOLEAN,\r
 687     rouge_passe,bleu_passe : BOOLEAN,\r
 688     rep                    : CHAR;\r
 689 BEGIN\r
 690   CALL init_souris;\r
 691   DO\r
 692   (*** Bloc concernant les pions rouges ***)\r
 693     CALL peut_jouer(rouge,rouge_passe);\r
 694     IF NOT rouge_passe THEN\r
 695       bleu_passe:=FALSE;\r
 696       CALL efface(340,250);\r
 697       CALL texte(340,250,blanc,"Les Rouges jouent...");\r
 698       DO\r
 699         CALL GETPRESS(1,h,v,p,l,r,c);\r
 700         IF r THEN (* right button *)\r
 701           CALL fill(339,249,160,10,noir);\r
 702           CALL texte(115,310,jaune,"Etes-vous s\96r de vouloir sortir (o/n) ? ");\r
 703           CALL saisie_rep(blanc,rep);\r
 704           IF rep='n' OR rep='N' THEN\r
 705             CALL fill(114,309,320,10,noir);\r
 706             CALL texte(340,250,blanc,"Les Rouges jouent...");\r
 707           ELSE RETURN;\r
 708           FI;\r
 709         FI;\r
 710         CALL GETPRESS(0,h,v,p,l,r,c);\r
 711         IF l THEN (* left button *)\r
 712           IF 10<h ANDIF h<298 ANDIF 40<v ANDIF v<280 THEN\r
 713             CALL cherche_case(h,v,rouge,trouve);\r
 714             IF trouve THEN\r
 715               libre:=64-(nb_rouges+nb_bleus);\r
 716               CALL efface(340,250);\r
 717               EXIT;\r
 718             ELSE\r
 719               CALL texte(320,130,blanc,"Vous ne pouvez pas jouer ici !");\r
 720               CALL pause(3);\r
 721               CALL fill(319,129,250,10,noir);\r
 722             FI;(* trouve *)\r
 723           FI; (* 10<h ANDIF h<298 ... *)\r
 724         FI; (* l ANDIF p=1 *)\r
 725       OD;\r
 726       IF libre=0 THEN EXIT FI;\r
 727     ELSE (* Les Rouges passent leur tour ! *)\r
 728       IF bleu_passe THEN EXIT FI;\r
 729       CALL passe_son_tour("Vous devez passer votre tour !");\r
 730     FI; (* NOT rouge_passe *)\r
 731 \r
 732   (*** Bloc concernant les pions bleus ***)\r
 733     CALL texte(340,250,blanc,"Les Bleus jouent...");\r
 734     som_prio:=0;  nb_pions_pris:=0;\r
 735     CALL peut_jouer(bleu,bleu_passe);\r
 736     IF NOT bleu_passe THEN\r
 737       rouge_passe:=FALSE;\r
 738       CALL cherche_intervalle(ligne,colonne,bleu,TRUE,trouve);\r
 739       libre:=64-(nb_rouges+nb_bleus);\r
 740       CALL efface(340,250);\r
 741     ELSE\r
 742       IF rouge_passe THEN EXIT FI;\r
 743       CALL passe_son_tour("Les Bleus passent leur tour.");\r
 744     FI; (* NOT bleu_passe *)\r
 745     IF libre=0 THEN EXIT FI;\r
 746   OD;\r
 747   CALL HIDECURSOR;\r
 748   CALL resultat;\r
 749 END jeu;\r
 750 \r
 751 \r
 752 \r
 753 (****************** PROGRAMME PRINCIPAL ******************)\r
 754 \r
 755 BEGIN\r
 756   PREF IIUWGRAPH BLOCK\r
 757   BEGIN\r
 758     CALL GRON(0);\r
 759     CALL affiche_grille;\r
 760     CALL jeu;\r
 761     CALL GROFF;\r
 762   END; (* IIUWGRAPH *)\r
 763 END Reversi;\r
 764 \1a