examples/grazyna.xmp/morp3d.log

   1 program morp3d;\r
   2 (***************************************************************************)\r
   3 (* Fabien JOBIN                                           Fr\82d\82ric GAUTIER *)\r
   4 (*                      LICENCE INFORMATIQUE 1995                          *)\r
   5 (*                              2eme Groupe                                *)\r
   6 (*                          MORPION en 3 DIMENSIONS                        *)\r
   7 (***************************************************************************)\r
   8 \r
   9  begin\r
  10    pref iiuwgraph block\r
  11      begin\r
  12      pref mouse block\r
  13 \r
  14         (* Fonction de lecture au clavier *)\r
  15         unit inchar:function:integer;\r
  16         var i:integer;\r
  17         begin\r
  18           do\r
  19             i:=inkey;\r
  20             if i<>0 then exit fi;\r
  21           od;\r
  22           result:=i;\r
  23         end inchar;\r
  24 \r
  25 (*--------------------------------------------------------------------------*)\r
  26 (*                  OPERATIONS SUR LA MATRICE EN 3 DIMENSION                *)\r
  27 (*--------------------------------------------------------------------------*)\r
  28 \r
  29     (* Description d'un \82l\82ment d'une matrice en 3 dimensions               *)\r
  30     (* val : valeur du cube plac\82e par le joueur  lorsqu'il colorie celui-ci*)\r
  31     (* marque : indique si le cube a \82t\82 jou\82 (= 1) ou non (=0)             *)\r
  32     (* x,y : position du cube \85 l'\82cran                                     *)\r
  33     unit elem:class;\r
  34     var x,y,val,marque:integer;\r
  35     end elem;\r
  36 \r
  37     (* Description d'une matrice en 3 dimensions *)\r
  38     unit mat_3d:class(l,c,e:integer);\r
  39 \r
  40     (* Copie le contenu d'une matrice 3d dans une autre *)\r
  41     unit copy_mat3d:function:mat_3d;\r
  42     var i,j,k:integer;\r
  43     begin\r
  44       result:=new mat_3d(l,c,e);\r
  45       for i:=1 to l\r
  46        do\r
  47           for j:=1 to c\r
  48           do\r
  49               for k:=1 to e\r
  50               do\r
  51                  result.tab(i,j,k).val := tab(i,j,k).val;\r
  52                  result.tab(i,j,k).marque := tab(i,j,k).marque;\r
  53                  result.tab(i,j,k).x := tab(i,j,k).x;\r
  54                  result.tab(i,j,k).y := tab(i,j,k).y;\r
  55               od;\r
  56           od;\r
  57        od;\r
  58     end copy_mat3d;\r
  59 \r
  60     var tab:arrayof arrayof arrayof elem,\r
  61           i,j,k:integer;\r
  62     begin\r
  63       array tab dim(1:l);\r
  64       for i:=1 to l\r
  65        do\r
  66           array tab(i) dim (1:c);\r
  67        od;\r
  68       for i:=1 to l\r
  69        do\r
  70           for j:=1 to c\r
  71           do\r
  72              array tab(i,j) dim (1:e);\r
  73           od;\r
  74        od;\r
  75 \r
  76       for i:=1 to l\r
  77        do\r
  78           for j:=1 to c\r
  79           do\r
  80               for k:=1 to e\r
  81               do\r
  82                  tab(i,j,k) := new elem;\r
  83               od;\r
  84           od;\r
  85        od;\r
  86     end mat_3d;\r
  87 \r
  88     (* Initialise la matrice *)\r
  89     unit init_mat:procedure(inout mat:mat_3d);\r
  90     var i,j,k,x,y:integer;\r
  91     begin\r
  92       for i:=1 to mat.l\r
  93       do\r
  94           for j:=1 to mat.c\r
  95            do\r
  96               x := 292-((j-1)*20);\r
  97               y := 100+((j-1)*20)+((i-1)*110);\r
  98               for k:=1 to mat.e\r
  99                do\r
 100                   mat.tab(i,j,k).x :=x;\r
 101                   mat.tab(i,j,k).y :=y;\r
 102                   mat.tab(i,j,k).val := 0;\r
 103                   mat.tab(i,j,k).marque := 0;\r
 104                   x := x + 25;\r
 105                od;\r
 106            od;\r
 107       od;\r
 108     end init_mat;\r
 109 \r
 110 (*--------------------------------------------------------------------------*)\r
 111 (*                                 GRAPHISMES                               *)\r
 112 (*--------------------------------------------------------------------------*)\r
 113 \r
 114 (*-------- DESSIN DE LA MATRICE, D'UN ELEMENT DE LA MATRICE, ... -----------*)\r
 115 \r
 116     (* Dessin d'un carr\82 de face *)\r
 117     unit carre_face:procedure(x,y,c,ep,coul,vide:integer);\r
 118     begin\r
 119       if vide = 1 then\r
 120         (* carre de face vide *)\r
 121          call patern(x,y,x+c,y+c,15,0);\r
 122       else\r
 123         (* carre de face plein *)\r
 124         (* partie cadre noir *)\r
 125         call patern(x+1,y+1,x+c-1,y+c-1,0,0);\r
 126         (* partie pleine *)\r
 127         call patern(x+2,y+2,x+c-2,y+c-2,coul,1);\r
 128       fi;\r
 129     end carre_face;\r
 130 \r
 131     (* Dessin d'un carr\82 haut *)\r
 132     unit carre_haut:procedure(x,y,c,ep,coul,vide:integer);\r
 133     var i:integer;\r
 134     begin\r
 135       if vide = 1 then\r
 136          (* carre haut vide *)\r
 137          call color(15);\r
 138          call move(x,y);\r
 139          call draw(x+ep,y-ep);\r
 140          call draw(x+ep+c,y-ep);\r
 141          call draw(x+c,y);\r
 142       else\r
 143         (* carre haut plein *)\r
 144         (* partie cadre noir *)\r
 145         call color(0);\r
 146         call move(x+2,y-1);\r
 147         call draw(x+ep,y-ep+1);\r
 148         call draw(x+c+ep-2,y-ep+1);\r
 149         call draw(x+c,y-1);\r
 150         call draw(x+2,y-1);\r
 151         (* partie pleine *)\r
 152         call color(coul);\r
 153         for i:=2 to 22\r
 154          do\r
 155             call move(x+2+i,y-2);\r
 156             call draw(x+ep,y-ep+2);\r
 157             call draw(x+ep+c-2-i,y-ep+2);\r
 158             call draw(x+c,y-2);\r
 159             call draw(x+2+i,y-2);\r
 160          od;\r
 161        fi;\r
 162     end carre_haut;\r
 163 \r
 164     (* Dessin d'un carr\82 droit *)\r
 165     unit carre_droit:procedure(x,y,c,ep,coul,vide:integer);\r
 166     var i:integer;\r
 167     begin\r
 168       if vide = 1 then\r
 169          (* carre droit vide *)\r
 170          call color(15);\r
 171          call move(x+c,y+c);\r
 172          call draw(x+c+ep,y+c-ep);\r
 173          call draw(x+c+ep,y-ep);\r
 174       else\r
 175         (* carre droit plein *)\r
 176         (* partie cadre noir *)\r
 177         call color(0);\r
 178         call move(x+c+1,y+c-2);\r
 179         call draw(x+c+ep-1,y+c-ep);\r
 180         call draw(x+c+ep-1,y-ep+2);\r
 181         call draw(x+c+1,y);\r
 182         call draw(x+c+1,y+c-2);\r
 183         (* partie pleine *)\r
 184         call color(coul);\r
 185         for i:=2 to 22\r
 186          do\r
 187             call move(x+c+2,y+c-2-i);\r
 188             call draw(x+c+ep-2,y+c-ep);\r
 189             call draw(x+c+ep-2,y-ep+2+i);\r
 190             call draw(x+c+2,y);\r
 191             call draw(x+c+2,y+c-2-i);\r
 192          od;\r
 193       fi;\r
 194     end carre_droit;\r
 195 \r
 196     (* Un cube est le dessin d'un \82l\82ment d'une matrice en 3 dimensions   *)\r
 197     (* Un cube (3d) est compos\82 :                                         *)\r
 198     (* - d'un carr\82 de face                                               *)\r
 199     (* - d'un carr\82 haut                                                  *)\r
 200     (* - d'uncarr\82 droit                                                  *)\r
 201     (* x et y coordonn\82es du sommet en haut \85 gauche appartenant au carr\82 *)\r
 202     (* de face                                                            *)\r
 203     (* c : longueur du cot\82 du cube                                       *)\r
 204     (* coul : couleur                                                     *)\r
 205     (* ep : epaisseur du cube                                             *)\r
 206     unit cube:procedure(x,y,c,ep,coul,vide:integer);\r
 207     var i:integer;\r
 208     begin\r
 209       call carre_face(x,y,c,ep,coul,vide);\r
 210       call carre_haut(x,y,c,ep,coul,vide);\r
 211       call carre_droit(x,y,c,ep,coul,vide);\r
 212     end cube;\r
 213 \r
 214     (* Un plan est constitu\82 de 9 cubes            *)\r
 215     (* x et y coordonn\82es du cube du fond \85 gauche *)\r
 216     unit plan:procedure(x,y,c,ep,coul:integer);\r
 217     begin\r
 218       (* cubes du fond *)\r
 219       call cube(x,y,c,ep,coul,1);\r
 220       call cube(x+c,y,c,ep,coul,1);\r
 221       call cube(x+2*c,y,c,ep,coul,1);\r
 222 \r
 223       (* cubes du milieu *)\r
 224       call cube(x-ep,y+ep,c,ep,coul,1);\r
 225       call cube(x-ep+c,y+ep,c,ep,coul,1);\r
 226       call cube(x-ep+2*c,y+ep,c,ep,coul,1);\r
 227 \r
 228       (* cubes du debut *)\r
 229       call cube(x-2*ep,y+2*ep,c,ep,coul,1);\r
 230       call cube(x-2*ep+c,y+2*ep,c,ep,coul,1);\r
 231       call cube(x-2*ep+2*c,y+2*ep,c,ep,coul,1);\r
 232     end plan;\r
 233 \r
 234     (* Une matrice en 3 dimensions est constitu\82e de 3 plans *)\r
 235     (* x et y coordonn\82es du plan en haut                    *)\r
 236     unit des_mat_3d:procedure(x,y,c,ep,coul:integer);\r
 237     begin\r
 238       (* plan en haut *)\r
 239       call plan(x,y,c,ep,coul);\r
 240       (* plan en bas *)\r
 241       call plan(x,y+4*ep+30,c,ep,coul);\r
 242       (* plan du milieu *)\r
 243       call plan(x,y+8*ep+60,c,ep,coul);\r
 244     end des_mat_3d;\r
 245 \r
 246     (* Affiche la matrice *)\r
 247     unit affic:procedure(c,ep:integer);\r
 248     var i,j,k:integer;\r
 249     begin\r
 250       for i:=1 to mat.l\r
 251       do\r
 252           for j:=1 to mat.c\r
 253            do\r
 254               for k:=1 to mat.e\r
 255                do\r
 256                   call affic_elem(i,j,k,c,ep);\r
 257                od;\r
 258            od;\r
 259       od;\r
 260     end affic;\r
 261 \r
 262     (* Affiche un \82l\82ment de la matrice *)\r
 263     unit affic_elem:procedure(i,j,k,c,ep:integer);\r
 264     var coul:integer;\r
 265     begin\r
 266           (* cubes dont le carre haut est visible *)\r
 267           if (mat.tab(i,j,k).x=292 or\r
 268           mat.tab(i,j,k).x=317 or\r
 269           mat.tab(i,j,k).x=272 or\r
 270           mat.tab(i,j,k).x=297) then\r
 271                   if (mat.tab(i,j,k).y=100 or\r
 272                   mat.tab(i,j,k).y=120 or\r
 273                   mat.tab(i,j,k).y=210 or\r
 274                   mat.tab(i,j,k).y=230 or\r
 275                   mat.tab(i,j,k).y=320 or\r
 276                   mat.tab(i,j,k).y=340) then\r
 277                      if mat.tab(i,j,k).val = 0 then\r
 278                         coul:=0;\r
 279                      else\r
 280                      if mat.tab(i,j,k).val = 1 then\r
 281                         coul:=12;\r
 282                      else\r
 283                        if mat.tab(i,j,k).val = 2 then\r
 284                           coul:=10;\r
 285                        else\r
 286                          if mat.tab(i,j,k).val = 3 or\r
 287                             mat.tab(i,j,k).val = 4 then\r
 288                             coul:=9;\r
 289                          else\r
 290                            if mat.tab(i,j,k).val = 9 then\r
 291                               coul:=15;\r
 292                            fi;\r
 293                          fi;\r
 294                        fi;\r
 295                      fi;\r
 296                      fi;\r
 297                         call carre_haut(mat.tab(i,j,k).x,\r
 298                         mat.tab(i,j,k).y,c,ep,coul,0);\r
 299                   fi;\r
 300           else\r
 301           (* cubes dont le carre haut et le carre droit sont *)\r
 302           (* visibles                                        *)\r
 303           if (mat.tab(i,j,k).x=342 or\r
 304           mat.tab(i,j,k).x=322) then\r
 305                   if (mat.tab(i,j,k).y=100 or\r
 306                   mat.tab(i,j,k).y=120 or\r
 307                   mat.tab(i,j,k).y=210 or\r
 308                   mat.tab(i,j,k).y=230 or\r
 309                   mat.tab(i,j,k).y=320 or\r
 310                   mat.tab(i,j,k).y=340) then\r
 311                      if mat.tab(i,j,k).val = 0 then\r
 312                         coul:=0;\r
 313                      else\r
 314                      if mat.tab(i,j,k).val = 1 then\r
 315                         coul:=12;\r
 316                      else\r
 317                        if mat.tab(i,j,k).val = 2 then\r
 318                           coul:=10;\r
 319                        else\r
 320                          if mat.tab(i,j,k).val = 3 or\r
 321                             mat.tab(i,j,k).val = 4 then\r
 322                             coul:=9;\r
 323                          else\r
 324                            if mat.tab(i,j,k).val = 9 then\r
 325                               coul:=15;\r
 326                            fi;\r
 327                          fi;\r
 328                        fi;\r
 329                      fi;\r
 330                      fi;\r
 331                         call carre_haut(mat.tab(i,j,k).x,\r
 332                         mat.tab(i,j,k).y,c,ep,coul,0);\r
 333                         call carre_droit(mat.tab(i,j,k).x,\r
 334                         mat.tab(i,j,k).y,c,ep,coul,0);\r
 335                   fi;\r
 336           else\r
 337           (* cubes dont le carre haut et le carre face sont *)\r
 338           (* visibles                                       *)\r
 339           if (mat.tab(i,j,k).x=252 or\r
 340           mat.tab(i,j,k).x=277) then\r
 341                   if (mat.tab(i,j,k).y=140 or\r
 342                   mat.tab(i,j,k).y=250 or\r
 343                   mat.tab(i,j,k).y=360) then\r
 344                      if mat.tab(i,j,k).val = 0 then\r
 345                         coul:=0;\r
 346                      else\r
 347                      if mat.tab(i,j,k).val = 1 then\r
 348                         coul:=12;\r
 349                      else\r
 350                        if mat.tab(i,j,k).val = 2 then\r
 351                           coul:=10;\r
 352                        else\r
 353                          if mat.tab(i,j,k).val = 3 or\r
 354                             mat.tab(i,j,k).val = 4 then\r
 355                             coul:=9;\r
 356                          else\r
 357                            if mat.tab(i,j,k).val = 9 then\r
 358                               coul:=15;\r
 359                            fi;\r
 360                          fi;\r
 361                        fi;\r
 362                      fi;\r
 363                      fi;\r
 364                         call carre_face(mat.tab(i,j,k).x,\r
 365                         mat.tab(i,j,k).y,c,ep,coul,0);\r
 366                         call carre_haut(mat.tab(i,j,k).x,\r
 367                         mat.tab(i,j,k).y,c,ep,coul,0);\r
 368                   fi;\r
 369           else\r
 370           (* cubes dont le carre haut,face et droit sont *)\r
 371           (* visibles                                    *)\r
 372           if (mat.tab(i,j,k).x=302) then\r
 373                   if (mat.tab(i,j,k).y=140 or\r
 374                   mat.tab(i,j,k).y=250 or\r
 375                   mat.tab(i,j,k).y=360) then\r
 376                      if mat.tab(i,j,k).val = 0 then\r
 377                        coul:=0;\r
 378                      else\r
 379                      if mat.tab(i,j,k).val = 1 then\r
 380                        coul:=12;\r
 381                      else\r
 382                        if mat.tab(i,j,k).val = 2 then\r
 383                           coul:=10;\r
 384                        else\r
 385                          if mat.tab(i,j,k).val = 3 or\r
 386                             mat.tab(i,j,k).val = 4 then\r
 387                             coul:=9;\r
 388                          else\r
 389                            if mat.tab(i,j,k).val = 9 then\r
 390                               coul:=15;\r
 391                            fi;\r
 392                          fi;\r
 393                        fi;\r
 394                      fi;\r
 395                      fi;\r
 396                         call cube(mat.tab(i,j,k).x,\r
 397                         mat.tab(i,j,k).y,c,ep,coul,0);\r
 398                   fi;\r
 399           fi;\r
 400           fi;\r
 401           fi;\r
 402           fi;\r
 403     end affic_elem;\r
 404 \r
 405     (*  recherche_elem donne i,j,k en fonction de x et y *)\r
 406     (* Ceci permet d'acc\82der aux indices d'un \82l\82ment    *)\r
 407     (* de la matrice en fonction de la position de la    *)\r
 408     (* case (ou du cube) \85 l'\82cran.                      *)\r
 409     unit recherche_elem:procedure(x,y:integer;output i,j,k:integer);\r
 410     var trouve:boolean;\r
 411     begin\r
 412       trouve:=false;\r
 413       i:=1;\r
 414       while (i<=mat.l and not trouve)\r
 415       do\r
 416           j:=1;\r
 417           while (j<=mat.c and not trouve)\r
 418            do\r
 419               k:=1;\r
 420               while (k<=mat.e and not trouve)\r
 421                do\r
 422                   if (mat.tab(i,j,k).x =x and mat.tab(i,j,k).y =y) then\r
 423                      trouve:=true;\r
 424                   fi;\r
 425                   k:=k+1;\r
 426                od;\r
 427                j:=j+1;\r
 428            od;\r
 429            i:=i+1;\r
 430       od;\r
 431       i:=i-1;j:=j-1;k:=k-1;\r
 432     end recherche_elem;\r
 433 \r
 434     (* indique si le point (x1,y1) est en_dessous du segment de droite *)\r
 435     (* passant par (x2,y2) et (x3,y3)                                  *)\r
 436     (* Ceci permet de savoir si le pointeur de la souris est sur un    *)\r
 437     (* carre haut ou un carre droit du cube. En effet, ces carr\82s ont  *)\r
 438     (* des c\93t\82s inclin\82s.                                             *)\r
 439     unit en_dessous:function(x1,y1,x2,y2,x3,y3:real):boolean;\r
 440     var y_calcul:real;\r
 441     begin\r
 442       y_calcul:=(( ((y2-y3)/(x2-x3)) )*(x1-x3))+y3;\r
 443       if y1 > y_calcul then\r
 444          result:=true;\r
 445       else\r
 446         result:=false;\r
 447       fi;\r
 448     end en_dessous;\r
 449 \r
 450     (* Cette proc\82dure colorie un cube *)\r
 451     unit coloriage:procedure(i,j,k,val:integer);\r
 452     begin\r
 453       if val = 3 or val = 4 then\r
 454          if mat.tab(i,j,k).marque=0 then\r
 455             (* Le joueur 1 colorie un cube *)\r
 456             if val = 3 then mat.tab(i,j,k).val:=1 fi;\r
 457             (* Le joueur 2 colorie un cube *)\r
 458             if val = 4 then mat.tab(i,j,k).val:=4 fi;\r
 459             (* la saisie est prise en compte *)\r
 460             mat.tab(i,j,k).marque:=1;\r
 461             joue:=true;\r
 462          fi;\r
 463       else\r
 464         if mat.tab(i,j,k).marque=0 then\r
 465            (* Coloriage ou effacage du coloriage d'un cube *)\r
 466            (* cette saisie n'est pas prise en compte       *)\r
 467 \r
 468            (* le joueur2 colorie le cube *)\r
 469            if val = 2 then val:=val+2 fi;\r
 470 \r
 471            mat.tab(i,j,k).val:=val;\r
 472         fi;\r
 473       fi;\r
 474     end coloriage;\r
 475 \r
 476     (* Effectue la modification d'un \82l\82ment de la matrice.  *)\r
 477     (* A partir des coordonn\82es du pointeur de la souris     *)\r
 478     (* qui d\82signe un cube \85 l'\82cran, on acc\8ade \85 un         *)\r
 479     (* \82l\82ment de la matrice, on colorie le cube en fonction *)\r
 480     (* du joueur et on affiche le cube \85 l'\82cran.            *)\r
 481     unit modification:procedure(xmouse,ymouse,ep,c,val,cpt:integer);\r
 482     var i,j,k:integer;\r
 483     begin\r
 484          (* Point dans cube en haut \85 gauche *)\r
 485          if (xmouse>=292 and xmouse<=292+ep+c and\r
 486             ymouse<=100+cpt and ymouse>=100-ep+cpt and\r
 487             en_dessous(xmouse,ymouse,292,100+cpt,292+ep,100-ep+cpt) and\r
 488             not(en_dessous(xmouse,ymouse,292+c,100+cpt,292+ep+c,100-ep+cpt))) then\r
 489 \r
 490             call recherche_elem(292,100+cpt,i,j,k);\r
 491             call coloriage(i,j,k,val);\r
 492             call affic_elem(i,j,k,c,ep);\r
 493          else\r
 494          (* Point dans cube en haut au milieu *)\r
 495          if (xmouse>=317 and xmouse<=317+ep+c and\r
 496             ymouse<=100+cpt and ymouse>=100-ep+cpt and\r
 497             en_dessous(xmouse,ymouse,317,100+cpt,317+ep,100-ep+cpt) and\r
 498             not(en_dessous(xmouse,ymouse,317+c,100+cpt,317+ep+c,100-ep+cpt))) then\r
 499 \r
 500             call recherche_elem(317,100+cpt,i,j,k);\r
 501             call coloriage(i,j,k,val);\r
 502             call affic_elem(i,j,k,c,ep);\r
 503          else\r
 504          (* Point dans cube en haut \85 droite *)\r
 505          if ((xmouse>=342 and xmouse<=342+ep+c and\r
 506             ymouse<=100+cpt and ymouse>=100-ep+cpt and\r
 507             en_dessous(xmouse,ymouse,342,100+cpt,342+ep,100-ep+cpt) and\r
 508             not(en_dessous(xmouse,ymouse,342+c,100+cpt,342+ep+c,100-ep+cpt))) or\r
 509            (xmouse>=342+c and xmouse<=342+ep+c and\r
 510             ymouse<=100+c+cpt and ymouse>=100-ep+cpt and\r
 511             en_dessous(xmouse,ymouse,342+c,100+cpt,342+ep+c,100-ep+cpt) and\r
 512             not(en_dessous(xmouse,ymouse,342+c,100+c+cpt,342+ep+c,100-ep+c+cpt)))) then\r
 513 \r
 514             call recherche_elem(342,100+cpt,i,j,k);\r
 515             call coloriage(i,j,k,val);\r
 516             call affic_elem(i,j,k,c,ep);\r
 517          else\r
 518          (* Point dans cube au milieu \85 gauche *)\r
 519          if (xmouse>=272 and xmouse<=272+ep+c and\r
 520             ymouse<=120+cpt and ymouse>=120-ep+cpt and\r
 521             en_dessous(xmouse,ymouse,272,120+cpt,272+ep,120-ep+cpt) and\r
 522             not(en_dessous(xmouse,ymouse,272+c,120+cpt,272+ep+c,120-ep+cpt))) then\r
 523 \r
 524             call recherche_elem(272,120+cpt,i,j,k);\r
 525             call coloriage(i,j,k,val);\r
 526             call affic_elem(i,j,k,c,ep);\r
 527          else\r
 528 \r
 529          (* Point dans cube au milieu au milieu *)\r
 530          if (xmouse>=297 and xmouse<=297+ep+c and\r
 531             ymouse<=120+cpt and ymouse>=120-ep+cpt and\r
 532             en_dessous(xmouse,ymouse,297,120+cpt,297+ep,120-ep+cpt) and\r
 533             not(en_dessous(xmouse,ymouse,297+c,120+cpt,297+ep+c,120-ep+cpt))) then\r
 534 \r
 535             call recherche_elem(297,120+cpt,i,j,k);\r
 536             call coloriage(i,j,k,val);\r
 537             call affic_elem(i,j,k,c,ep);\r
 538          else\r
 539 \r
 540          (* Point dans cube au milieu \85 droite *)\r
 541          if ((xmouse>=322 and xmouse<=322+ep+c and\r
 542             ymouse<=120+cpt and ymouse>=120-ep+cpt and\r
 543             en_dessous(xmouse,ymouse,322,120+cpt,322+ep,120-ep+cpt) and\r
 544             not(en_dessous(xmouse,ymouse,322+c,120+cpt,322+ep+c,120-ep+cpt))) or\r
 545            (xmouse>=322+c and xmouse<=322+ep+c and\r
 546             ymouse<=120+c+cpt and ymouse>=120-ep+cpt and\r
 547             en_dessous(xmouse,ymouse,322+c,120+cpt,322+ep+c,120-ep+cpt) and\r
 548             not(en_dessous(xmouse,ymouse,322+c,120+c+cpt,322+ep+c,120-ep+c+cpt)))) then\r
 549 \r
 550             call recherche_elem(322,120+cpt,i,j,k);\r
 551             call coloriage(i,j,k,val);\r
 552             call affic_elem(i,j,k,c,ep);\r
 553          else\r
 554 \r
 555          (* Point dans cube en bas \85 gauche *)\r
 556          if ((xmouse>=252 and xmouse<=252+ep+c and\r
 557             ymouse<=140+cpt and ymouse>=140-ep+cpt and\r
 558             en_dessous(xmouse,ymouse,252,140+cpt,252+ep,140-ep+cpt) and\r
 559             not(en_dessous(xmouse,ymouse,252+c,140+cpt,252+ep+c,140-ep+cpt))) or\r
 560            (xmouse>=252 and xmouse<=252+c and\r
 561             ymouse<=140+c+cpt and ymouse>=140+cpt)) then\r
 562 \r
 563             call recherche_elem(252,140+cpt,i,j,k);\r
 564             call coloriage(i,j,k,val);\r
 565             call affic_elem(i,j,k,c,ep);\r
 566          else\r
 567 \r
 568          (* Point dans cube en bas au milieu *)\r
 569          if ((xmouse>=277 and xmouse<=277+ep+c and\r
 570             ymouse<=140+cpt and ymouse>=140-ep+cpt and\r
 571             en_dessous(xmouse,ymouse,277,140+cpt,277+ep,140-ep+cpt) and\r
 572             not(en_dessous(xmouse,ymouse,277+c,140+cpt,277+ep+c,140-ep+cpt))) or\r
 573            (xmouse>=277 and xmouse<=277+c and\r
 574             ymouse<=140+c+cpt and ymouse>=140+cpt)) then\r
 575 \r
 576             call recherche_elem(277,140+cpt,i,j,k);\r
 577             call coloriage(i,j,k,val);\r
 578             call affic_elem(i,j,k,c,ep);\r
 579          else\r
 580 \r
 581          (* Point dans cube en bas \85 droite *)\r
 582          if ((xmouse>=302 and xmouse<=302+ep+c and\r
 583             ymouse<=140+cpt and ymouse>=140-ep+cpt and\r
 584             en_dessous(xmouse,ymouse,302,140+cpt,302+ep,140-ep+cpt) and\r
 585             not(en_dessous(xmouse,ymouse,302+c,140+cpt,302+ep+c,140-ep+cpt))) or\r
 586 \r
 587            (xmouse>=302+c and xmouse<=302+ep+c and\r
 588             ymouse<=140+c+cpt and ymouse>=140-ep+cpt and\r
 589             en_dessous(xmouse,ymouse,302+c,140+cpt,302+ep+c,140-ep+cpt) and\r
 590             not(en_dessous(xmouse,ymouse,302+c,140+c+cpt,302+ep+c,140-ep+c+cpt))) or\r
 591 \r
 592            (xmouse>=302 and xmouse<=302+c and\r
 593             ymouse<=140+c+cpt and ymouse>=140+cpt)) then\r
 594 \r
 595             call recherche_elem(302,140+cpt,i,j,k);\r
 596             call coloriage(i,j,k,val);\r
 597             call affic_elem(i,j,k,c,ep);\r
 598          fi;\r
 599          fi;\r
 600          fi;\r
 601          fi;\r
 602          fi;\r
 603          fi;\r
 604          fi;\r
 605          fi;\r
 606          fi;\r
 607     end modification;\r
 608 \r
 609     (* Saisie (colorie) un \82l\82ment de la matrice *)\r
 610     unit saisie:procedure(xmouse,ymouse,bouton_mouse,ep,c,num_joueur:integer);\r
 611     var val:integer;\r
 612     begin\r
 613       if bouton_mouse = 1 or bouton_mouse = 2 or bouton_mouse = 3 then\r
 614          (* Le joueur1 colorie le cube mais cette saisie *)\r
 615          (* n'est pas prise en compte (il ne joue pas)   *)\r
 616          if bouton_mouse = 1 and num_joueur = 1 then val := 1 fi;\r
 617 \r
 618          (* Le joueur2 colorie le cube mais cette saisie *)\r
 619          (* n'est pas prise en compte (il ne joue pas)   *)\r
 620          if bouton_mouse = 1 and num_joueur = 2 then val := 2 fi;\r
 621 \r
 622          (* Le joueur efface le coloriage du cube *)\r
 623          if bouton_mouse = 2 then val := 0 fi;\r
 624 \r
 625          (* Le joueur1 colorie un cube et cette saisie *)\r
 626          (* est prise en compte (le joueur joue)       *)\r
 627          if bouton_mouse = 3 and num_joueur = 1 then val := 3 fi;\r
 628 \r
 629          (* Le joueur2 colorie un cube et cette saisie *)\r
 630          (* est prise en compte (le joueur joue)       *)\r
 631          if bouton_mouse = 3 and num_joueur = 2 then val := 4 fi;\r
 632 \r
 633          (* Pointeur de la souris dans le plan en haut *)\r
 634          if (ymouse>=100-ep and ymouse<=140+ep) then\r
 635             call modification(xmouse,ymouse,ep,c,val,0);\r
 636          else\r
 637            (* Pointeur de la souris dans le plan au milieu *)\r
 638            if (ymouse>=210-ep and ymouse<=250+ep) then\r
 639                call modification(xmouse,ymouse,ep,c,val,110);\r
 640            else\r
 641              (* Pointeur de la souris dans le plan en bas *)\r
 642              if (ymouse>=320-ep and ymouse<=360+ep) then\r
 643                 call modification(xmouse,ymouse,ep,c,val,220);\r
 644              fi;\r
 645            fi;\r
 646          fi;\r
 647       fi;\r
 648     end saisie;\r
 649 \r
 650     (* Affiche les 3 cubes align\82s par un joueur en les faisant *)\r
 651     (* clignoter                                                *)\r
 652     unit affic_3_alignes:procedure(i1,j1,k1,i2,j2,k2,i3,j3,k3:integer);\r
 653     var val,l,k:integer;\r
 654     var image1,image2:arrayof integer;\r
 655     begin\r
 656       (* on sauvegarde la valeur des cubes *)\r
 657       val:=mat.tab(i1,j1,k1).val;\r
 658       array image1 dim(1:100);\r
 659       array image2 dim(1:100);\r
 660       (* image1 contient l'\82cran avec les 3 cubes de la couleur du joueur *)\r
 661       call move(0,0);\r
 662       image1:=getmap(640,480);\r
 663 \r
 664       (* On met 9 dans la valeur des cubes pour les faire afficher *)\r
 665       (* en blanc                                                  *)\r
 666       mat.tab(i1,j1,k1).val:=9;\r
 667       call affic_elem(i1,j1,k1,25,20);\r
 668       mat.tab(i2,j2,k2).val:=9;\r
 669       call affic_elem(i2,j2,k2,25,20);\r
 670       mat.tab(i3,j3,k3).val:=9;\r
 671       call affic_elem(i3,j3,k3,25,20);\r
 672 \r
 673       (* image2 contient l'\82cran avec les 3 cubes de couleur blanc *)\r
 674       call move(0,0);\r
 675       image2:=getmap(640,480);\r
 676 \r
 677       (* On remet les valeurs pr\82c\82dentes des cubes *)\r
 678       mat.tab(i1,j1,k1).val:=val;\r
 679       mat.tab(i2,j2,k2).val:=val;\r
 680       mat.tab(i3,j3,k3).val:=val;\r
 681 \r
 682       (* On fait afficher en alternance image1 et image2 *)\r
 683       for l:=1 to 7\r
 684       do\r
 685         call move(0,0);\r
 686         call putmap(image1);\r
 687         for k:=1 to 100 do k:=k+1 od;\r
 688         call move(0,0);\r
 689         call putmap(image2);\r
 690         for k:=1 to 100 do k:=k+1 od;\r
 691       od;\r
 692       (* On restitue l'\82cran tel qu'il \82tait avant le clignotement des 3 *)\r
 693       (* cubes                                                           *)\r
 694       call move(0,0);\r
 695       call putmap(image1);\r
 696     end affic_3_alignes;\r
 697 \r
 698 (*------------------- DESSIN DE BOUTON ET MESSAGE D'ERREUR -----------------*)\r
 699 \r
 700     (* Affichage d'un bouton *)\r
 701     unit bouton:procedure(x1,y1,x2,y2,x3,y3 : integer;chaine : string;\r
 702                     couleur_fond,couleur1,couleur2,couleur3 : integer);\r
 703     begin\r
 704       call patern(x1,y1,x2,y2,couleur_fond,1);\r
 705       call color(couleur1);\r
 706       call move(x1,y1); call draw(x2,y1);\r
 707       call move(x1,y1); call draw(x1,y2);\r
 708       call move(x1+1,y1+1); call draw(x2-1,y1+1);\r
 709       call move(x1+1,y1+2); call draw(x2-2,y1+2);\r
 710       call move(x1+1,y1+1); call draw(x1+1,y2-1);\r
 711       call move(x1+2,y1+2); call draw(x1+2,y2-2);\r
 712       call color(couleur2);\r
 713       call move(x1,y2); call draw(x2,y2);\r
 714       call move(x1+1,y2-1); call draw(x2-1,y2-1);\r
 715       call move(x1+2,y2-2); call draw(x2-2,y2-2);\r
 716       call move(x2,y2); call draw(x2,y1);\r
 717       call move(x2-1,y2-1); call draw(x2-1,y1+1);\r
 718       call move(x2-2,y2-2); call draw(x2-2,y1+2);\r
 719       call outstring(x3,y3,chaine,couleur3,couleur_fond);\r
 720     end bouton;\r
 721 \r
 722     (* Cette proc\82dure affiche un message d'erreur *)\r
 723     unit message_erreur:procedure(x1,y1,x2,y2,x3,y3:integer;chaine1:string;\r
 724     x7:integer;chaine2:string;x4,y4,x5,y5,x6,y6:integer);\r
 725     var i : integer;\r
 726     var tab:arrayof integer;\r
 727     begin\r
 728       array tab dim(1:100);\r
 729       call move(x1,y1);\r
 730       tab:=getmap(x2,y2);\r
 731       call bouton(x1,y1,x2,y2,x3,y3,chaine1,12,15,6,14);\r
 732       call outstring(x7,y3+30,chaine2,14,0);\r
 733       call patern(x4-4,y4-4,x5+4,y5+4,0,1);\r
 734       call bouton(x4,y4,x5,y5,x6,y6,"OK",9,11,1,15);\r
 735       do\r
 736          d:=getpress(v,p,h,l,r,c);\r
 737          if c = 1 and (v>=x4 and v<=x5) and (p>=y4 and p<=y5) then\r
 738             exit;\r
 739          fi;\r
 740       od;\r
 741       call bouton(x4,y4,x5,y5,x6,y6,"OK",1,9,11,7);\r
 742       for i:=1 to 5000 do i := i + 1 od;\r
 743       call bouton(x4,y4,x5,y5,x6,y6,"OK",9,11,1,15);\r
 744       for i:=1 to 5500 do i := i + 1 od;\r
 745       call move(x1,y1);\r
 746       call putmap(tab);\r
 747     end message_erreur;\r
 748 \r
 749     (* Affiche le cadre d'un bouton *)\r
 750     unit cadre_bouton:procedure(x1,y1,x2,y2 : integer);\r
 751     begin\r
 752       call patern(x1-4,y1-4,x2+4,y2+4,0,1);\r
 753     end cadre_bouton;\r
 754 \r
 755 (*-- AFFICHAGE DE LA MATRICE PAR LES TOUCHES (haut, bas, droite, gauche) ---*)\r
 756 \r
 757     (* Copie un \82l\82ment de la matrice dans un \82l\82ment d'une autre matrice *)\r
 758     unit copy_elem:procedure(inout B:mat_3d;lb,cb,j:integer;\r
 759     A:mat_3d;la,ca,i:integer);\r
 760     begin\r
 761           B.tab(lb,cb,j).val := A.tab(la,ca,i).val;\r
 762           B.tab(lb,cb,j).marque := A.tab(la,ca,i).marque;\r
 763     end copy_elem;\r
 764 \r
 765     (* Affiche le contenu de la matrice vers le haut *)\r
 766     unit haut:procedure;\r
 767     var i,j:integer;\r
 768     var aux:mat_3d;\r
 769     begin\r
 770       aux := new mat_3d(3,3,3);\r
 771       call init_mat(aux);\r
 772       for j:=1 to 3\r
 773        do\r
 774          for i:=1 to 3\r
 775           do\r
 776              call copy_elem(aux,1,j,i,mat,j,3,i);\r
 777           od;\r
 778          for i:=1 to 3\r
 779           do\r
 780              call copy_elem(aux,2,j,i,mat,j,2,i);\r
 781           od;\r
 782           for i:=1 to 3\r
 783            do\r
 784               call copy_elem(aux,3,j,i,mat,j,1,i);\r
 785            od;\r
 786       od;\r
 787       mat := none;\r
 788       mat := aux.copy_mat3d;\r
 789       call affic(25,20);\r
 790     end haut;\r
 791 \r
 792     (* Affiche le contenu de la matrice vers le bas *)    \r
 793     unit bas:procedure;\r
 794     var i,j:integer;\r
 795     var aux:mat_3d;\r
 796     begin\r
 797       aux := new mat_3d(3,3,3);\r
 798       call init_mat(aux);\r
 799       for j:=1 to 3\r
 800        do\r
 801           for i:=1 to 3\r
 802            do\r
 803               call copy_elem(aux,j,3,i,mat,1,j,i);\r
 804            od;\r
 805           for i:=1 to 3\r
 806            do\r
 807               call copy_elem(aux,j,2,i,mat,2,j,i);\r
 808            od;\r
 809           for i:=1 to 3\r
 810            do\r
 811               call copy_elem(aux,j,1,i,mat,3,j,i);\r
 812            od;\r
 813        od;\r
 814       mat := none;\r
 815       mat := aux.copy_mat3d;\r
 816       call affic(25,20);\r
 817     end bas;\r
 818 \r
 819     (* Affiche le contenu de la matrice vers la droite *)    \r
 820     unit droit:procedure;\r
 821     var i,j:integer;\r
 822     var aux:mat_3d;\r
 823     begin\r
 824       aux := new mat_3d(3,3,3);\r
 825       call init_mat(aux);\r
 826       for j:=1 to 3\r
 827        do\r
 828           for i:=1 to 3\r
 829            do\r
 830               call copy_elem(aux,j,3,i,mat,j,i,1);\r
 831            od;\r
 832           for i:=1 to 3\r
 833            do\r
 834               call copy_elem(aux,j,2,i,mat,j,i,2);\r
 835            od;\r
 836           for i:=1 to 3\r
 837            do\r
 838               call copy_elem(aux,j,1,i,mat,j,i,3);\r
 839            od;\r
 840        od;\r
 841       mat := none;\r
 842       mat := aux.copy_mat3d;\r
 843       call affic(25,20);\r
 844     end droit;\r
 845 \r
 846     (* Affiche le contenu de la matrice vers la gauche *)    \r
 847     unit gauche:procedure;\r
 848     var i,j:integer;\r
 849     var aux:mat_3d;\r
 850     begin\r
 851       aux := new mat_3d(3,3,3);\r
 852       call init_mat(aux);\r
 853       for j:=1 to 3\r
 854        do\r
 855           for i:=1 to 3\r
 856            do\r
 857               call copy_elem(aux,j,i,1,mat,j,3,i);\r
 858            od;\r
 859           for i:=1 to 3\r
 860            do\r
 861               call copy_elem(aux,j,i,2,mat,j,2,i);\r
 862            od;\r
 863           for i:=1 to 3\r
 864            do\r
 865               call copy_elem(aux,j,i,3,mat,j,1,i);\r
 866            od;\r
 867        od;\r
 868       mat := none;\r
 869       mat := aux.copy_mat3d;\r
 870       call affic(25,20);\r
 871     end gauche;\r
 872 \r
 873 (*-------------------------------- AIDE ------------------------------------*)\r
 874 \r
 875     (* Cette proc\82dure affiche l'aide du jeu *)\r
 876     unit aide:procedure;\r
 877     var i : integer;\r
 878     var tab:arrayof integer;\r
 879     begin\r
 880       array tab dim(1:100);\r
 881       call move(0,0);\r
 882       tab:=getmap(640,480);\r
 883       call bouton(10,10,630,470,0,0,"",12,15,6,14);\r
 884       call cadre_bouton(270,410,370,440);\r
 885       call bouton(270,410,370,440,310,417,"OK",9,11,1,15);\r
 886 \r
 887       call outstring(30,20,"REGLES DU JEU :",14,12);\r
 888       call outstring(50,35, "-Il s'agit d'aligner 3 cases de la",15,12);\r
 889       call outstring(330,35,"m\88me couleur que ce soit en ligne,",15,12);\r
 890       call outstring(30,50,  "colonne ou diagonale.",15,12);\r
 891       call outstring(50,65, "-Chaque joueur colorie une case \85  ",15,12);\r
 892       call outstring(320,65,"tour de r\93le. ",15,12);\r
 893       call outstring(50,80, "-Si les 27 cases ont \82t\82 colori\82es",15,12);\r
 894       call outstring(330,80,"et qu'il n'y a pas 3 cases de la",15,12);\r
 895       call outstring(30,95,"m\88me couleur align\82es alors la ",15,12);\r
 896       call outstring(280,95,"partie est nulle.",15,12);\r
 897 \r
 898       call outstring(30,125,"MENU ET SOUS-MENUS :",14,12);\r
 899       call outstring(50,140,"-Pour s\82lectionner une option,",15,12);\r
 900       call outstring(300,140,"cliquez dessus avec le bouton gauche",15,12);\r
 901       call outstring(30,155,"de la souris.",15,12);\r
 902       call outstring(50,170,"-Pour sortir d'un sous-menu,",15,12);\r
 903       call outstring(280,170,"appuyez sur le bouton droit de la souris.",15,12);\r
 904       call outstring(50,185,"-Pour jouer, cliquez sur 'JEU'",15,12);\r
 905       call outstring(300,185,"puis cliquez sur 'Nouvelle partie'.",15,12);\r
 906       call outstring(50,200,"-Pour sauvegarder votre partie,",15,12);\r
 907       call outstring(310,200,"cliquez sur 'JEU' puis cliquez sur",15,12);\r
 908       call outstring(30,215,"'Enregistrer la partie'.",15,12);\r
 909       call outstring(50,230,"-Pour continuer une partie enregistr\82e,",15,12);\r
 910       call outstring(370,230,"cliquez sur 'JEU' puis cliquez",15,12);\r
 911       call outstring(30,245,"sur 'Charger une partie'.",15,12);\r
 912 \r
 913       call outstring(30,275,"COLORIER UNE CASE :",14,12);\r
 914       call outstring(50,290,"-Pour colorier une case sans",15,12);\r
 915       call outstring(290,290,"que cette saisie soit prise en compte,",15,12);\r
 916       call outstring(30,305,"cliquez sur la case avec le bouton gauche",15,12);\r
 917       call outstring(370,305,"de la souris.",15,12);\r
 918       call outstring(50,320,"-Pour effacer le coloriage d'une",15,12);\r
 919       call outstring(320,320,"case dont la saisie n'a pas \82t\82 prise",15,12);\r
 920       call outstring(30,335,"en compte, cliquez sur la case avec le",15,12);\r
 921       call outstring(340,335,"bouton droit de la souris.",15,12);\r
 922       call outstring(50,350,"-Pour colorier une case et que cette",15,12);\r
 923       call outstring(350,350,"saisie soit en prise en compte,",15,12);\r
 924       call outstring(30,365,"cliquez sur la case avec les boutons droit et",15,12);\r
 925       call outstring(400,365,"gauche de la souris.",15,12);\r
 926       do\r
 927          d:=getpress(v,p,h,l,r,c);\r
 928          if c = 1 and (v>=270 and v<=370) and (p>=410 and p<=440) then\r
 929             exit;\r
 930          fi;\r
 931       od;\r
 932       call bouton(270,410,370,440,310,417,"OK",1,9,11,7);\r
 933       for i:=1 to 5000 do i := i + 1 od;\r
 934       call bouton(270,410,370,440,310,417,"OK",9,11,1,15);\r
 935       for i:=1 to 5500 do i := i + 1 od;\r
 936       call move(0,0);\r
 937       call putmap(tab);\r
 938     end aide;\r
 939 \r
 940 (*--------------------------- ANIMATION GRAPHIQUE --------------------------*)\r
 941 (*--------------- Debut de l'animation du generique --------------------*)\r
 942 \r
 943 (*----------------------------------------------------------------------*)\r
 944 (*                                                                      *)\r
 945 (* Cette procedure calcul les coefficients de transformation            *)\r
 946 (*                                                                      *)\r
 947 (*----------------------------------------------------------------------*)\r
 948 unit sin_cos:procedure(alpha,beta,gamma:real;output a,b,c,d,e,f,g,h,i:real);\r
 949 begin\r
 950         a:=cos(gamma)*cos(beta);\r
 951         b:=sin(gamma)*cos(beta);\r
 952         c:=-sin(beta);\r
 953         d:=-sin(gamma)*cos(alpha)+cos(gamma)*sin(beta)*sin(alpha);\r
 954         e:=cos(gamma)*cos(alpha)+sin(gamma)*sin(beta)*sin(alpha);\r
 955         f:=cos(beta)*sin(alpha);\r
 956         g:=sin(gamma)*sin(alpha)+cos(gamma)*sin(beta)*cos(alpha);\r
 957         h:=-cos(gamma)*sin(alpha)+sin(gamma)*sin(beta)*cos(alpha);\r
 958         i:=cos(beta)*cos(alpha);\r
 959 end sin_cos;\r
 960 \r
 961 (*----------------------------------------------------------------------*)\r
 962 (*                                                                      *)\r
 963 (* Cette procedure calcul la transformation d'un point 3d en point 2d   *)\r
 964 (*                                                                      *)\r
 965 (*----------------------------------------------------------------------*)\r
 966 unit trois_d_vers_2d:procedure(a,b,c,d,e,f,g,h,i,xe,ye,ze,xdep,\r
 967 ydep,zdep:real;output xp,yp:real);\r
 968 var q,pt_fuite:real;\r
 969 begin\r
 970         pt_fuite:=-1000;\r
 971         q:=1-(c*xe+f*ye+i*ze+zdep)/pt_fuite;\r
 972         xp:=(a*xe+d*ye+g*ze+xdep)/q;\r
 973         yp:=(b*xe+e*ye+h*ze+ydep)/q;\r
 974 end trois_d_vers_2d;\r
 975 \r
 976 (*----------------------------------------------------------------------*)\r
 977 (*                                                                      *)\r
 978 (* Cette procedure initialise les tableaux decrivant les objets         *)\r
 979 (*                                                                      *)\r
 980 (*----------------------------------------------------------------------*)\r
 981 unit init_obj:procedure(inout xe,ye,ze,tab_ligne:arrayof real);\r
 982 begin\r
 983 \r
 984 (* tableaux des points *)\r
 985 (* M *)\r
 986         xe(1):=-70;   ye(1):=-25;       ze(1):=0;\r
 987         xe(2):=-70;   ye(2):=0;         ze(2):=0;\r
 988         xe(3):=-65;   ye(3):=-25;       ze(3):=0;\r
 989         xe(4):=-65;   ye(4):=-20;       ze(4):=0;\r
 990         xe(5):=-65;   ye(5):=0;         ze(5):=0;\r
 991         xe(6):=-60;   ye(6):=-20;       ze(6):=0;\r
 992         xe(7):=-60;   ye(7):=-15;       ze(7):=0;\r
 993         xe(8):=-55;   ye(8):=-25;       ze(8):=0;\r
 994         xe(9):=-55;   ye(9):=-20;       ze(9):=0;\r
 995         xe(10):=-55;  ye(10):=0;        ze(10):=0;\r
 996         xe(11):=-50;  ye(11):=-25;      ze(11):=0;\r
 997         xe(12):=-50;  ye(12):=0;        ze(12):=0;\r
 998 \r
 999 (* O *)\r
1000         xe(13):=-45;  ye(13):=-25;      ze(13):=0;\r
1001         xe(14):=-45;  ye(14):=0;        ze(14):=0;\r
1002         xe(15):=-40;  ye(15):=-20;      ze(15):=0;\r
1003         xe(16):=-40;  ye(16):=-5;       ze(16):=0;\r
1004         xe(17):=-35;  ye(17):=-20;      ze(17):=0;\r
1005         xe(18):=-35;  ye(18):=-5;       ze(18):=0;\r
1006         xe(19):=-30;  ye(19):=-25;      ze(19):=0;\r
1007         xe(20):=-30;  ye(20):=0;        ze(20):=0;\r
1008 \r
1009 (* R *)\r
1010         xe(21):=-25;  ye(21):=-25;      ze(21):=0;\r
1011         xe(22):=-25;  ye(22):=0;        ze(22):=0;\r
1012         xe(23):=-20;  ye(23):=-20;      ze(23):=0;\r
1013         xe(24):=-20;  ye(24):=-15;      ze(24):=0;\r
1014         xe(25):=-20;  ye(25):=-10;      ze(25):=0;\r
1015         xe(26):=-20;  ye(26):=0;        ze(26):=0;\r
1016         xe(27):=-15;  ye(27):=-20;      ze(27):=0;\r
1017         xe(28):=-15;  ye(28):=-15;      ze(28):=0;\r
1018         xe(29):=-15;  ye(29):=-10;      ze(29):=0;\r
1019         xe(30):=-15;  ye(30):=-5;       ze(30):=0;\r
1020         xe(31):=-15;  ye(31):=0;        ze(31):=0;\r
1021         xe(32):=-10;  ye(32):=-25;      ze(32):=0;\r
1022         xe(33):=-10;  ye(33):=-15;      ze(33):=0;\r
1023         xe(34):=-10;  ye(34):=-5;       ze(34):=0;\r
1024         xe(35):=-10;  ye(35):=0;        ze(35):=0;\r
1025 \r
1026 (* P *)\r
1027         xe(36):=-5;   ye(36):=-25;      ze(36):=0;\r
1028         xe(37):=10;   ye(37):=-25;      ze(37):=0;\r
1029         xe(38):=10;   ye(38):=-10;      ze(38):=0;\r
1030         xe(39):=0;    ye(39):=-10;      ze(39):=0;\r
1031         xe(40):=0;    ye(40):=0;        ze(40):=0;\r
1032         xe(41):=-5;   ye(41):=0;        ze(41):=0;\r
1033         xe(42):=0;    ye(42):=-20;      ze(42):=0;\r
1034         xe(43):=5;    ye(43):=-20;      ze(43):=0;\r
1035         xe(44):=5;    ye(44):=-15;      ze(44):=0;\r
1036         xe(45):=0;    ye(45):=-15;      ze(45):=0;\r
1037 \r
1038 (* I *)\r
1039         xe(46):=15;   ye(46):=-25;      ze(46):=0;\r
1040         xe(47):=15;   ye(47):=0;        ze(47):=0;\r
1041         xe(48):=20;   ye(48):=-25;      ze(48):=0;\r
1042         xe(49):=20;   ye(49):=0;        ze(49):=0;\r
1043 \r
1044 (* O *)\r
1045         xe(50):=25;   ye(50):=-25;     ze(50):=0;\r
1046         xe(51):=25;   ye(51):=0;        ze(51):=0;\r
1047         xe(52):=30;   ye(52):=-20;      ze(52):=0;\r
1048         xe(53):=30;   ye(53):=-5;       ze(53):=0;\r
1049         xe(54):=35;   ye(54):=-20;      ze(54):=0;\r
1050         xe(55):=35;   ye(55):=-5;       ze(55):=0;\r
1051         xe(56):=40;   ye(56):=-25;      ze(56):=0;\r
1052         xe(57):=40;   ye(57):=0;        ze(57):=0;\r
1053 \r
1054 (* N *)\r
1055         xe(58):=45;   ye(58):=-25;      ze(58):=0;\r
1056         xe(59):=45;   ye(59):=0;        ze(59):=0;\r
1057         xe(60):=50;   ye(60):=-25;      ze(60):=0;\r
1058         xe(61):=50;   ye(61):=-15;      ze(61):=0;\r
1059         xe(62):=50;   ye(62):=0;        ze(62):=0;\r
1060         xe(63):=60;   ye(63):=-25;      ze(63):=0;\r
1061         xe(64):=60;   ye(64):=-10;      ze(64):=0;\r
1062         xe(65):=60;   ye(65):=0;        ze(65):=0;\r
1063         xe(66):=65;   ye(66):=-25;      ze(66):=0;\r
1064         xe(67):=65;   ye(67):=0;        ze(67):=0;\r
1065 \r
1066 (* 3 *)\r
1067         xe(68):=-15;  ye(68):=5;        ze(68):=0;\r
1068         xe(69):=-15;  ye(69):=10;       ze(69):=0;\r
1069         xe(70):=-15;  ye(70):=25;       ze(70):=0;\r
1070         xe(71):=-15;  ye(71):=30;       ze(71):=0;\r
1071         xe(72):=-10;  ye(72):=15;       ze(72):=0;\r
1072         xe(73):=-10;  ye(73):=20;       ze(73):=0;\r
1073         xe(74):=-5;   ye(74):=10;       ze(74):=0;\r
1074         xe(75):=-5;   ye(75):=15;       ze(75):=0;\r
1075         xe(76):=-5;   ye(76):=20;       ze(76):=0;\r
1076         xe(77):=-5;   ye(77):=25;       ze(77):=0;\r
1077         xe(78):=0;    ye(78):=5;        ze(78):=0;\r
1078         xe(79):=0;    ye(79):=30;       ze(79):=0;\r
1079 \r
1080 (* D *)\r
1081         xe(80):=5;    ye(80):=5;        ze(80):=0;\r
1082         xe(81):=5;    ye(81):=30;       ze(81):=0;\r
1083         xe(82):=10;   ye(82):=10;       ze(82):=0;\r
1084         xe(83):=10;   ye(83):=25;       ze(83):=0;\r
1085         xe(84):=15;   ye(84):=10;       ze(84):=0;\r
1086         xe(85):=15;   ye(85):=25;       ze(85):=0;\r
1087         xe(86):=20;   ye(86):=5;        ze(86):=0;\r
1088         xe(87):=20;   ye(87):=15;       ze(87):=0;\r
1089         xe(88):=20;   ye(88):=20;       ze(88):=0;\r
1090         xe(89):=20;   ye(89):=30;       ze(89):=0;\r
1091         xe(90):=25;   ye(90):=10;       ze(90):=0;\r
1092         xe(91):=25;   ye(91):=25;       ze(91):=0;\r
1093 \r
1094 (* tableau des lignes *)\r
1095 (* M *)\r
1096         tab_ligne(1):=1;        tab_ligne(2):=2;\r
1097         tab_ligne(3):=2;        tab_ligne(4):=5;\r
1098         tab_ligne(5):=5;        tab_ligne(6):=4;\r
1099         tab_ligne(7):=4;        tab_ligne(8):=7;\r
1100         tab_ligne(9):=7;        tab_ligne(10):=9;\r
1101         tab_ligne(11):=9;       tab_ligne(12):=10;\r
1102         tab_ligne(13):=10;      tab_ligne(14):=12;\r
1103         tab_ligne(15):=12;      tab_ligne(16):=11;\r
1104         tab_ligne(17):=11;      tab_ligne(18):=8;\r
1105         tab_ligne(19):=8;       tab_ligne(20):=6;\r
1106         tab_ligne(21):=6;       tab_ligne(22):=3;\r
1107         tab_ligne(23):=3;       tab_ligne(24):=1;\r
1108 \r
1109 (* O *)\r
1110         tab_ligne(25):=13;      tab_ligne(26):=14;\r
1111         tab_ligne(27):=14;      tab_ligne(28):=20;\r
1112         tab_ligne(29):=20;      tab_ligne(30):=19;\r
1113         tab_ligne(31):=19;      tab_ligne(32):=13;\r
1114         tab_ligne(33):=15;      tab_ligne(34):=16;\r
1115         tab_ligne(35):=16;      tab_ligne(36):=18;\r
1116         tab_ligne(37):=18;      tab_ligne(38):=17;\r
1117         tab_ligne(39):=17;      tab_ligne(40):=15;\r
1118 \r
1119 (* R *)\r
1120         tab_ligne(41):=21;       tab_ligne(42):=22;\r
1121         tab_ligne(43):=22;       tab_ligne(44):=26;\r
1122         tab_ligne(45):=26;       tab_ligne(46):=25;\r
1123         tab_ligne(47):=25;       tab_ligne(48):=30;\r
1124         tab_ligne(49):=30;       tab_ligne(50):=31;\r
1125         tab_ligne(51):=31;       tab_ligne(52):=35;\r
1126         tab_ligne(53):=35;       tab_ligne(54):=34;\r
1127         tab_ligne(55):=34;       tab_ligne(56):=29;\r
1128         tab_ligne(57):=29;       tab_ligne(58):=33;\r
1129         tab_ligne(59):=33;       tab_ligne(60):=32;\r
1130         tab_ligne(61):=32;       tab_ligne(62):=21;\r
1131         tab_ligne(63):=23;       tab_ligne(64):=24;\r
1132         tab_ligne(65):=24;       tab_ligne(66):=28;\r
1133         tab_ligne(67):=28;       tab_ligne(68):=27;\r
1134         tab_ligne(69):=27;       tab_ligne(70):=23;\r
1135 \r
1136 (* P *)\r
1137         tab_ligne(71):=36;       tab_ligne(72):=41;\r
1138         tab_ligne(73):=41;       tab_ligne(74):=40;\r
1139         tab_ligne(75):=40;       tab_ligne(76):=39;\r
1140         tab_ligne(77):=39;       tab_ligne(78):=38;\r
1141         tab_ligne(79):=38;       tab_ligne(80):=37;\r
1142         tab_ligne(81):=37;       tab_ligne(82):=36;\r
1143         tab_ligne(83):=42;       tab_ligne(84):=43;\r
1144         tab_ligne(85):=43;       tab_ligne(86):=44;\r
1145         tab_ligne(87):=44;       tab_ligne(88):=45;\r
1146         tab_ligne(89):=45;       tab_ligne(90):=42;\r
1147 \r
1148 (* I *)\r
1149         tab_ligne(91):=46;       tab_ligne(92):=47;\r
1150         tab_ligne(93):=47;       tab_ligne(94):=49;\r
1151         tab_ligne(95):=49;       tab_ligne(96):=48;\r
1152         tab_ligne(97):=48;       tab_ligne(98):=46;\r
1153 \r
1154 (* O *)\r
1155         tab_ligne(99):=50;        tab_ligne(100):=51;\r
1156         tab_ligne(101):=51;       tab_ligne(102):=57;\r
1157         tab_ligne(103):=57;       tab_ligne(104):=56;\r
1158         tab_ligne(105):=56;       tab_ligne(106):=50;\r
1159         tab_ligne(107):=52;       tab_ligne(108):=53;\r
1160         tab_ligne(109):=53;       tab_ligne(110):=55;\r
1161         tab_ligne(111):=55;       tab_ligne(112):=54;\r
1162         tab_ligne(113):=54;       tab_ligne(114):=52;\r
1163 \r
1164 (* N *)\r
1165         tab_ligne(115):=58;       tab_ligne(116):=59;\r
1166         tab_ligne(117):=59;       tab_ligne(118):=62;\r
1167         tab_ligne(119):=62;       tab_ligne(120):=61;\r
1168         tab_ligne(121):=61;       tab_ligne(122):=65;\r
1169         tab_ligne(123):=65;       tab_ligne(124):=67;\r
1170         tab_ligne(125):=67;       tab_ligne(126):=66;\r
1171         tab_ligne(127):=66;       tab_ligne(128):=63;\r
1172         tab_ligne(129):=63;       tab_ligne(130):=64;\r
1173         tab_ligne(131):=64;       tab_ligne(132):=60;\r
1174         tab_ligne(133):=60;       tab_ligne(134):=58;\r
1175 \r
1176 (* 3 *)\r
1177         tab_ligne(135):=68;       tab_ligne(136):=69;\r
1178         tab_ligne(137):=69;       tab_ligne(138):=74;\r
1179         tab_ligne(139):=74;       tab_ligne(140):=75;\r
1180         tab_ligne(141):=75;       tab_ligne(142):=72;\r
1181         tab_ligne(143):=72;       tab_ligne(144):=73;\r
1182         tab_ligne(145):=73;       tab_ligne(146):=76;\r
1183         tab_ligne(147):=76;       tab_ligne(148):=77;\r
1184         tab_ligne(149):=77;       tab_ligne(150):=70;\r
1185         tab_ligne(151):=70;       tab_ligne(152):=71;\r
1186         tab_ligne(153):=71;       tab_ligne(154):=79;\r
1187         tab_ligne(155):=79;       tab_ligne(156):=78;\r
1188         tab_ligne(157):=78;       tab_ligne(158):=68;\r
1189 \r
1190 (* D *)\r
1191         tab_ligne(159):=80;       tab_ligne(160):=81;\r
1192         tab_ligne(161):=81;       tab_ligne(162):=89;\r
1193         tab_ligne(163):=89;       tab_ligne(164):=91;\r
1194         tab_ligne(165):=91;       tab_ligne(166):=90;\r
1195         tab_ligne(167):=90;       tab_ligne(168):=86;\r
1196         tab_ligne(169):=86;       tab_ligne(170):=80;\r
1197         tab_ligne(171):=82;       tab_ligne(172):=83;\r
1198         tab_ligne(173):=83;       tab_ligne(174):=85;\r
1199         tab_ligne(175):=85;       tab_ligne(176):=88;\r
1200         tab_ligne(177):=88;       tab_ligne(178):=87;\r
1201         tab_ligne(179):=87;       tab_ligne(180):=84;\r
1202         tab_ligne(181):=84;       tab_ligne(182):=82;\r
1203 \r
1204 end init_obj;\r
1205 \r
1206 (*----------------------------------------------------------------------*)\r
1207 (*                                                                      *)\r
1208 (* Cette procedure calcul l'animation de l'objet dans l'espace          *)\r
1209 (*                                                                      *)\r
1210 (*----------------------------------------------------------------------*)\r
1211 unit ligne:procedure(x1,y1,x2,y2,c:integer);\r
1212 begin\r
1213         call color(c);\r
1214         call move(x1,y1);\r
1215         call draw(x2,y2);\r
1216 end ligne;\r
1217 \r
1218 (*----------------------------------------------------------------------*)\r
1219 (*                                                                      *)\r
1220 (* Cette procedure affiche l'objet a l'ecran                            *)\r
1221 (*                                                                      *)\r
1222 (*----------------------------------------------------------------------*)\r
1223 unit affiche_obj:procedure(x,y,tab_ligne:arrayof real;nb_ligne:integer);\r
1224 var i,j:integer;\r
1225 var x1,y1,x2,y2:real;\r
1226 begin\r
1227         i:=1;\r
1228         while i<nb_ligne\r
1229         do\r
1230                 j:=tab_ligne(i);\r
1231                 x1:=x(j);       y1:=y(j);\r
1232                 i:=i+1;\r
1233                 j:=tab_ligne(i);\r
1234                 x2:=x(j);       y2:=y(j);\r
1235                 i:=i+1;\r
1236                 x1:=x1+320;     y1:=y1+200;\r
1237                 x2:=x2+320;     y2:=y2+200;\r
1238                 call ligne(x1,y1,x2,y2,10);\r
1239         od;\r
1240 end affiche_obj;\r
1241 \r
1242 (*----------------------------------------------------------------------*)\r
1243 (*                                                                      *)\r
1244 (* Cette procedure calcul l'animation de l'objet                        *)\r
1245 (*                                                                      *)\r
1246 (*----------------------------------------------------------------------*)\r
1247 unit animation:procedure;\r
1248 var alpha,beta,gamma,xdep,ydep,zdep:real;\r
1249 var a,b,c,d,e,f,g,h,i:real;\r
1250 var xe,ye,ze,x,y,tab_ligne:arrayof real;\r
1251 var j,nb_pt,nb_ligne,touche:integer;\r
1252 var image:arrayof integer;\r
1253 begin\r
1254         nb_pt:=91;\r
1255         nb_ligne:=182;\r
1256         array xe dim (1:nb_pt);\r
1257         array ye dim (1:nb_pt);\r
1258         array ze dim (1:nb_pt);\r
1259         array x dim (1:nb_pt);\r
1260         array y dim (1:nb_pt);\r
1261         array tab_ligne dim(1:nb_ligne);\r
1262         array image dim (1:100);\r
1263 \r
1264         call init_obj(xe,ye,ze,tab_ligne);\r
1265         call bouton(0,0,640,480,0,0,"",12,15,6,14);\r
1266         call bouton(3,3,637,477,0,0,"",12,15,6,14);\r
1267         call move(0,0);\r
1268         image:=getmap(640,480);\r
1269         zdep:=1000;\r
1270         while zdep>-500\r
1271         do\r
1272                 zdep:=zdep-100;\r
1273                 call sin_cos(alpha,beta,gamma,a,b,c,d,e,f,g,h,i);\r
1274                 for j:=1 to nb_pt\r
1275                 do\r
1276                         call trois_d_vers_2d(a,b,c,d,e,f,g,h,i,xe(j),ye(j),\r
1277                         ze(j),xdep,ydep,zdep,x(j),y(j));\r
1278                 od;\r
1279                 call move(0,0);\r
1280                 call putmap(image);\r
1281                 call affiche_obj(x,y,tab_ligne,nb_ligne);\r
1282         od;\r
1283         beta:=0;\r
1284         while beta<6.28\r
1285         do\r
1286                 beta:=beta+(30*3.1415927/180);(* on tourne de 30ø *)\r
1287                 call sin_cos(alpha,beta,gamma,a,b,c,d,e,f,g,h,i);\r
1288                 for j:=1 to nb_pt\r
1289                 do\r
1290                         call trois_d_vers_2d(a,b,c,d,e,f,g,h,i,xe(j),ye(j),\r
1291                         ze(j),xdep,ydep,zdep,x(j),y(j));\r
1292                 od;\r
1293                 call move(0,0);\r
1294                 call putmap(image);\r
1295                 call affiche_obj(x,y,tab_ligne,nb_ligne);\r
1296         od;\r
1297         call outstring(20,20,"FABIEN JOBIN",14,12);\r
1298         call outstring(500,20,"FREDERIC GAUTIER",14,12);\r
1299         call outstring(230,440,"LICENCE INFORMATIQUE 1995",14,12);\r
1300         touche:=inchar;\r
1301 end animation;\r
1302 (*------------------ fin de l'animation du generique -------------------*)\r
1303 \r
1304 (*--------------------------------------------------------------------------*)\r
1305 (*                  EXPLORATION DES 49 COMBINAISONS POSSIBLES               *)\r
1306 (*--------------------------------------------------------------------------*)\r
1307 \r
1308     (* Cherche une ligne ayant nb cubes align\82s du m\88me joueur *)\r
1309     (* et les indices i,j,k d'un cube libre                    *)\r
1310     unit rech_ligne:procedure(i,val,nb:integer;output trouve:boolean;\r
1311     output j,k:integer);\r
1312     var som,num:integer;\r
1313     var jlibre,klibre:integer;\r
1314     begin\r
1315       som:=0;\r
1316       trouve:=false; \r
1317       j:=1;\r
1318       while j<= 3 and not trouve\r
1319       do\r
1320             som:=0;\r
1321             num:=0;\r
1322             k:=1;\r
1323             while k<= 3 and not trouve\r
1324             do\r
1325                 som := som + mat.tab(i,j,k).val;\r
1326                 if mat.tab(i,j,k).marque = 0 then\r
1327                    jlibre:=j;\r
1328                    klibre:=k;\r
1329                 else\r
1330                   if mat.tab(i,j,k).val = val then\r
1331                      num:=num+1;\r
1332                   fi;\r
1333                 fi;\r
1334                 k:=k+1;\r
1335             od;\r
1336             if som = nb*val and num = nb then\r
1337                trouve:=true;\r
1338             fi;\r
1339             j:=j+1;\r
1340       od;\r
1341       if trouve then\r
1342          (* Si on cherche 3 cubes align\82s on les affiche en clignotant *)\r
1343          if nb = 3 then\r
1344             call affic_3_alignes(i,j-1,1,i,j-1,2,i,j-1,3);\r
1345          fi;\r
1346          j:=jlibre;\r
1347          k:=klibre;\r
1348       fi;\r
1349     end rech_ligne;\r
1350 \r
1351     (* Cherche une colonne ayant nb cubes align\82s du m\88me joueur et *)\r
1352     (* et renvoie les coordonn\82es i,j,k d'un cube libre             *)\r
1353     unit rech_col:procedure(i,val,nb:integer;output trouve:boolean;\r
1354     output j,k:integer);\r
1355     var som,num:integer;\r
1356     var jlibre,klibre:integer;\r
1357     begin\r
1358       som:=0;\r
1359       trouve:=false;\r
1360       k:=1;\r
1361       while k<= 3 and not trouve\r
1362       do\r
1363          som:=0; num:=0;\r
1364          j:=1;\r
1365          while j<= 3 and not trouve\r
1366          do\r
1367              som := som + mat.tab(i,j,k).val;\r
1368              if mat.tab(i,j,k).marque = 0 then\r
1369                 jlibre:=j;\r
1370                 klibre:=k;\r
1371                 else\r
1372                   if mat.tab(i,j,k).val = val then\r
1373                      num:=num+1;\r
1374                   fi;\r
1375              fi;\r
1376              j:=j+1;\r
1377          od;\r
1378         if som = nb*val and num = nb then\r
1379            trouve:=true;\r
1380         fi;\r
1381          k:=k+1;\r
1382       od;\r
1383       if trouve then\r
1384          (* Si on cherche 3 cubes align\82s on les affiche en clignotant *)         \r
1385          if nb = 3 then\r
1386             call affic_3_alignes(i,1,k-1,i,2,k-1,i,3,k-1);\r
1387          fi;\r
1388          j:=jlibre;\r
1389          k:=klibre;\r
1390       fi;\r
1391     end rech_col;\r
1392 \r
1393     (* Cherche une diagonale ayant nb cubes align\82s du m\88me joueur *)\r
1394     (* et renvoie les coordonn\82es i,j,k d'un cube libre            *)\r
1395     unit rech_diag:procedure(i,val,nb:integer;output trouve:boolean;\r
1396     output j,k:integer);\r
1397     var som,num:integer;\r
1398     var jlibre,klibre:integer;\r
1399     begin\r
1400       (* Diagonale haut gauche vers bas droit *)\r
1401       som:=0;num:=0;\r
1402       trouve:=false;\r
1403       k:=1;\r
1404       while k<= 3 and  not trouve\r
1405       do\r
1406              som := som + mat.tab(i,k,k).val;\r
1407              if mat.tab(i,k,k).marque = 0 then\r
1408                 klibre:=k;\r
1409                 else\r
1410                   if mat.tab(i,k,k).val = val then\r
1411                      num:=num+1;\r
1412                   fi;\r
1413              fi;\r
1414          k:=k+1;\r
1415       od;\r
1416       if som = nb*val and num = nb then\r
1417          if nb = 3 then\r
1418             call affic_3_alignes(i,1,1,i,2,2,i,3,3);\r
1419          fi;\r
1420          trouve:=true;\r
1421          j:=klibre;\r
1422          k:=klibre;\r
1423       else\r
1424        (* Diagonale haut droit vers bas gauche *)\r
1425         som := 0;num:=0;\r
1426         som := mat.tab(i,1,3).val + mat.tab(i,2,2).val + mat.tab(i,3,1).val;\r
1427         if mat.tab(i,1,3).marque = 0 then\r
1428            j:=1;k:=3;\r
1429         else\r
1430           if mat.tab(i,1,3).val = val then\r
1431              num := num + 1;\r
1432           fi;\r
1433         fi;\r
1434         if mat.tab(i,2,2).marque = 0 then\r
1435            j:=2;k:=2;\r
1436         else\r
1437           if mat.tab(i,2,2).val = val then\r
1438              num := num + 1;\r
1439           fi;\r
1440         fi;\r
1441         if mat.tab(i,3,1).marque = 0 then\r
1442            j:=3;k:=1;\r
1443         else\r
1444           if mat.tab(i,3,1).val = val then\r
1445              num := num + 1;\r
1446           fi;\r
1447         fi;\r
1448          if som = nb*val and num =nb then\r
1449             (* Si on cherche 3 cubes align\82s on les affiche en clignotant *)         \r
1450             if nb = 3 then\r
1451                call affic_3_alignes(i,3,1,i,2,2,i,1,3);\r
1452             fi;\r
1453             trouve:=true;\r
1454          fi;\r
1455       fi;\r
1456     end rech_diag;\r
1457 \r
1458     (* Cherche une colonne 3d ayant nb cubes align\82s du m\88me joueur *)\r
1459     (* et renvoie les coordonn\82es i,j,k d'un cube libre.            *)\r
1460     (* Par colonne 3d, il faut entendre qu'il s'agit d'une colonne  *)\r
1461     (* qui passe par les 3 plans.                                   *)\r
1462     unit rech_col_3d:procedure(val,nb,j,k:integer;output i:integer;\r
1463     output trouve:boolean);\r
1464     var som,num:integer;\r
1465     begin\r
1466       som := mat.tab(1,j,k).val+mat.tab(2,j,k).val+mat.tab(3,j,k).val;\r
1467       num:=0;\r
1468         if mat.tab(1,j,k).marque = 0 then\r
1469            i:=1;\r
1470         else\r
1471           if mat.tab(1,j,k).val = val then\r
1472              num := num + 1;\r
1473           fi;\r
1474         fi;\r
1475         if mat.tab(2,j,k).marque = 0 then\r
1476            i:=2;\r
1477         else\r
1478           if mat.tab(2,j,k).val = val then\r
1479              num := num + 1;\r
1480           fi;\r
1481         fi;\r
1482         if mat.tab(3,j,k).marque = 0 then\r
1483            i:=3;\r
1484         else\r
1485           if mat.tab(3,j,k).val = val then\r
1486              num := num + 1;\r
1487           fi;\r
1488         fi;\r
1489          if som = nb*val and num =nb then\r
1490             (* Si on cherche 3 cubes align\82s on les affiche en clignotant *)         \r
1491             if nb = 3 then\r
1492                call affic_3_alignes(1,j,k,2,j,k,3,j,k);\r
1493             fi;\r
1494             trouve:=true;\r
1495          fi;\r
1496 \r
1497     end rech_col_3d;\r
1498 \r
1499     (* Cherche une diagonale 3d ayant nb cubes align\82s du m\88me joueur  *)\r
1500     (* et renvoie les coordonn\82es i,j,k d'un cube libre.               *)\r
1501     (* Par diagonale 3d, il faut entendre qu'il s'agit d'une diagonale *)\r
1502     (* qui passe par les 3 plans.                                      *)\r
1503     unit rech_diag_3d:procedure(i1,j1,k1,i2,j2,k2,i3,j3,k3,val,nb:integer;\r
1504     output i,j,k:integer;output trouve:boolean);\r
1505     var som,num:integer;\r
1506     begin\r
1507       som := mat.tab(i1,j1,k1).val+mat.tab(i2,j2,k2).val+mat.tab(i3,j3,k3).val;\r
1508       num:=0;\r
1509       if mat.tab(i1,j1,k1).marque = 0 then\r
1510          i:=i1;j:=j1;k:=k1;\r
1511       else\r
1512         if mat.tab(i1,j1,k1).val = val then\r
1513            num:=num+1;\r
1514         fi;\r
1515       fi;\r
1516      if mat.tab(i2,j2,k2).marque = 0 then\r
1517         i:=i2;j:=j2;k:=k2;\r
1518       else\r
1519         if mat.tab(i2,j2,k2).val = val then\r
1520            num:=num+1;\r
1521         fi;\r
1522       fi;\r
1523      if mat.tab(i3,j3,k3).marque = 0 then\r
1524           i:=i3;j:=j3;k:=k3;\r
1525       else\r
1526         if mat.tab(i3,j3,k3).val = val then\r
1527            num:=num+1;\r
1528         fi;\r
1529       fi;\r
1530       if som = nb*val and num =nb then\r
1531            (* Si on cherche 3 cubes align\82s on les affiche en clignotant *)         \r
1532             if nb = 3 then\r
1533                call affic_3_alignes(i1,j1,k1,i2,j2,k2,i3,j3,k3);\r
1534             fi;\r
1535          trouve:=true;\r
1536       fi;\r
1537     end rech_diag_3d;\r
1538 \r
1539     (* Cette proc\82dure cherche dans les 49 combinaisons possibles *)\r
1540     (* si il y a nb cubes align\82s du joueur qui marque les cubes  *)\r
1541     (* par val. Si cette combinaison de cubes a \82t\82 trouv\82e, les  *)\r
1542     (* indices d'un cube libre appartenant \85 cette combinaison    *)\r
1543     (* sont renvoy\82s.                                             *)\r
1544     unit trouve_aligne:procedure(val,nb:integer;output i,j,k:integer;\r
1545     output trouve:boolean);\r
1546     begin\r
1547       trouve:=false;\r
1548       i:=1;\r
1549       (* i caract\82rise un plan *)\r
1550       while i<=3 and not trouve\r
1551       do\r
1552            call rech_ligne(i,val,nb,trouve,j,k);\r
1553            if not trouve then\r
1554               call rech_col(i,val,nb,trouve,j,k);\r
1555               if not trouve then\r
1556                  call rech_diag(i,val,nb,trouve,j,k);\r
1557               fi;\r
1558            fi;\r
1559            i:=i+1;\r
1560       od;\r
1561       if not trouve then\r
1562          (* Parties communes (colonnes et diagonales) aux 3 plans *)\r
1563          (* Recherche dans les colonnes *)\r
1564          j:=1;\r
1565          while j<=3 and not trouve\r
1566          do\r
1567             k:=1;\r
1568              while k<=3 and not trouve\r
1569              do\r
1570                 call rech_col_3d(val,nb,j,k,i,trouve);\r
1571                 k:=k+1;\r
1572              od;\r
1573              j:=j+1;\r
1574          od;\r
1575          if trouve then\r
1576             k:=k-1;j:=j-1;\r
1577          else\r
1578           (* Recherche dans les diagonales *)\r
1579        call rech_diag_3d(1,2,1,2,2,2,3,2,3,val,nb,i,j,k,trouve);\r
1580     if not trouve then\r
1581        call rech_diag_3d(1,1,2,2,2,2,3,3,2,val,nb,i,j,k,trouve);\r
1582     fi;\r
1583     if not trouve then\r
1584        call rech_diag_3d(1,2,3,2,2,2,3,2,1,val,nb,i,j,k,trouve);\r
1585     fi;\r
1586     if not trouve then\r
1587        call rech_diag_3d(1,3,2,2,2,2,3,1,2,val,nb,i,j,k,trouve);\r
1588     fi;\r
1589     if not trouve then\r
1590        call rech_diag_3d(1,1,1,2,1,2,3,1,3,val,nb,i,j,k,trouve);\r
1591     fi;\r
1592     if not trouve then\r
1593        call rech_diag_3d(1,1,1,2,2,1,3,3,1,val,nb,i,j,k,trouve);\r
1594     fi;\r
1595     if not trouve then\r
1596        call rech_diag_3d(1,1,1,2,2,2,3,3,3,val,nb,i,j,k,trouve);\r
1597     fi;\r
1598     if not trouve then\r
1599        call rech_diag_3d(1,1,3,2,1,2,3,1,1,val,nb,i,j,k,trouve);\r
1600     fi;\r
1601     if not trouve then\r
1602        call rech_diag_3d(1,1,3,2,2,3,3,3,3,val,nb,i,j,k,trouve);\r
1603     fi;\r
1604     if not trouve then\r
1605        call rech_diag_3d(1,1,3,2,2,2,3,3,1,val,nb,i,j,k,trouve);\r
1606     fi;\r
1607     if not trouve then\r
1608        call rech_diag_3d(1,3,3,2,3,2,3,3,1,val,nb,i,j,k,trouve);\r
1609     fi;\r
1610     if not trouve then\r
1611        call rech_diag_3d(1,3,3,2,2,3,3,1,3,val,nb,i,j,k,trouve);\r
1612     fi;\r
1613     if not trouve then\r
1614        call rech_diag_3d(1,3,3,2,2,2,3,1,1,val,nb,i,j,k,trouve);\r
1615     fi;\r
1616     if not trouve then\r
1617        call rech_diag_3d(1,3,1,2,3,2,3,3,3,val,nb,i,j,k,trouve);\r
1618     fi;\r
1619     if not trouve then\r
1620        call rech_diag_3d(1,3,1,2,2,1,3,1,1,val,nb,i,j,k,trouve);\r
1621     fi;\r
1622     if not trouve then\r
1623        call rech_diag_3d(1,3,1,2,2,2,3,1,3,val,nb,i,j,k,trouve);\r
1624     fi;\r
1625          fi;\r
1626       else\r
1627        i:=i-1;\r
1628       fi;\r
1629     end trouve_aligne;\r
1630 \r
1631 (*--------------------------------------------------------------------------*)\r
1632 (*                           STRATEGIES ET UTILISATEUR                      *)\r
1633 (*--------------------------------------------------------------------------*)\r
1634 \r
1635 (*--------------------------------- STRATEGIE1 -----------------------------*)\r
1636 \r
1637     (* La strat\82gie1 joue :                *)\r
1638     (* Le cube est marqu\82 par 2 et affich\82 *)\r
1639     unit jouer:procedure(i,j,k:integer);\r
1640     begin\r
1641       mat.tab(i,j,k).val:=2;\r
1642       mat.tab(i,j,k).marque:=1;\r
1643       call affic_elem(i,j,k,25,20);\r
1644     end jouer;\r
1645 \r
1646     (* Strat\82gie1 *)\r
1647     unit strategie1:class;\r
1648          unit virtual titre:procedure;\r
1649          begin\r
1650          end titre;\r
1651          unit virtual trouve_3_pions:procedure;\r
1652          begin\r
1653          end trouve_3_pions;\r
1654          unit virtual trouve_2_pions:procedure;\r
1655          begin\r
1656          end trouve_2_pions;\r
1657          unit virtual adversaire_joue:procedure;\r
1658          begin\r
1659          end adversaire_joue;\r
1660          unit virtual gagne:procedure;\r
1661          begin\r
1662          end gagne;\r
1663          unit virtual perdu:procedure;\r
1664          begin\r
1665          end perdu;\r
1666     var i,j,k:integer;\r
1667     var trouve:boolean;\r
1668     begin\r
1669     return;\r
1670     do\r
1671         call titre;\r
1672         inner;\r
1673         call outstring(430,120,"Coups jou\82s : ",14,3);\r
1674         call track(550,120,nb_coups,3,3);\r
1675         call track(550,120,nb_coups,3,14);\r
1676         (* La strat\82gie1 joue au centre *)\r
1677         if mat.tab(2,2,2).marque=0 then\r
1678            call jouer(2,2,2);\r
1679            nb_coups:=nb_coups+1;\r
1680            call adversaire_joue;\r
1681         else\r
1682           call trouve_3_pions;\r
1683            if trouve then\r
1684               (* Si l'utilisateur a 3 pions align\82s il a gagn\82 *)\r
1685               call gagne;\r
1686               attach(main);\r
1687            else\r
1688              call trouve_aligne(2,2,i,j,k,trouve);\r
1689              if trouve then\r
1690                 (* Si la strat\82gie1 a 2 pions align\82s, elle rajoute   *)\r
1691                 (* le troisi\8ame et elle gagne donc l'utilisateur perd *)\r
1692                 call jouer(i,j,k);\r
1693                 call track(550,120,nb_coups,3,3);\r
1694                 nb_coups:=nb_coups+1;\r
1695                 call track(550,120,nb_coups,3,14);\r
1696                 call trouve_aligne(2,3,i,j,k,trouve);\r
1697                 call perdu;\r
1698                 attach(main);\r
1699              else\r
1700                (* Sinon la strat\82gie 1 bloque l'utilisateur si il a 2 *)\r
1701                (* pions align\82s                                       *)\r
1702                call trouve_2_pions;\r
1703                 if trouve then\r
1704                    call jouer(i,j,k);\r
1705                 else\r
1706                   (* On cherche un pion de la strat\82gie1 et *)\r
1707                   (* on aligne un pion de fa\87on \85 avoir  2  *)\r
1708                   (* pions align\82s pour la strat\82gie1       *)\r
1709                   call trouve_aligne(2,1,i,j,k,trouve);\r
1710                   call jouer(i,j,k);\r
1711                 fi;\r
1712              fi;\r
1713            fi;\r
1714            nb_coups:=nb_coups+1;\r
1715            call adversaire_joue;\r
1716         fi;\r
1717     od;\r
1718     end strategie1;\r
1719 \r
1720     (* Strat\82gie1 contre joueur *)\r
1721     unit strategie1_user1:strategie1 coroutine;\r
1722          unit virtual titre:procedure;\r
1723          begin\r
1724            call outstring(430,90,"L'utilisateur joue...",3,3);\r
1725            call outstring(430,90,"La strat\82gie1 joue...",10,3);\r
1726          end titre;\r
1727          unit virtual trouve_3_pions:procedure;\r
1728          begin\r
1729            call trouve_aligne(1,3,i,j,k,trouve);\r
1730          end trouve_3_pions;\r
1731          unit virtual trouve_2_pions:procedure;\r
1732          begin\r
1733            call trouve_aligne(1,2,i,j,k,trouve);\r
1734          end trouve_2_pions;\r
1735          unit virtual adversaire_joue:procedure;\r
1736          begin\r
1737            attach(user1);\r
1738          end adversaire_joue;\r
1739          unit virtual gagne:procedure;\r
1740          begin\r
1741            call message_erreur(105,200,535,280,255,209,\r
1742            "Vous avez gagn\82",125,"",\r
1743             270,240,370,270,310,247);\r
1744          end gagne;\r
1745          unit virtual perdu:procedure;\r
1746          begin\r
1747            call message_erreur(105,200,535,280,255,209,\r
1748            "Vous avez perdu",125,"",\r
1749             270,240,370,270,310,247);\r
1750          end perdu;\r
1751     begin\r
1752     end strategie1_user1;\r
1753 \r
1754     (* Strat\82gie1 contre strat\82gie2 *)\r
1755     unit strategie1_strat2:strategie1 coroutine;\r
1756          unit virtual titre:procedure;\r
1757          begin\r
1758            call outstring(430,90,"La strat\82gie2 joue...",3,3);\r
1759            call outstring(430,90,"La strat\82gie1 joue...",10,3);\r
1760          end titre;\r
1761          unit virtual trouve_3_pions:procedure;\r
1762          begin\r
1763            call trouve_aligne(3,3,i,j,k,trouve);\r
1764          end trouve_3_pions;\r
1765          unit virtual trouve_2_pions:procedure;\r
1766          begin\r
1767            call trouve_aligne(3,2,i,j,k,trouve);\r
1768          end trouve_2_pions;\r
1769          unit virtual adversaire_joue:procedure;\r
1770          begin\r
1771            attach(S22);\r
1772          end adversaire_joue;\r
1773          unit virtual gagne:procedure;\r
1774          begin\r
1775            call message_erreur(105,200,535,280,225,209,\r
1776            "La strat\82gie2 a gagn\82",125,"",\r
1777             270,240,370,270,310,247);\r
1778          end gagne;\r
1779          unit virtual perdu:procedure;\r
1780          begin\r
1781            call message_erreur(105,200,535,280,225,209,\r
1782            "La strat\82gie1 a gagn\82",125,"",\r
1783             270,240,370,270,310,247);\r
1784          end perdu;\r
1785     var cpt:integer;\r
1786     begin\r
1787       for cpt:=1 to 30000 do cpt:=cpt+1 od;\r
1788       if nb_coups=27 then\r
1789          call message_erreur(105,200,535,280,155,209,\r
1790          "Egalit\82 entre la strat\82gie1 et la strat\82gie2",125,"",\r
1791           270,240,370,270,310,247);\r
1792           attach(main);\r
1793       fi;\r
1794     end strategie1_strat2;\r
1795 \r
1796 (*-------------------------------- STRATEGIE2 ------------------------------*)\r
1797 \r
1798     (* La strat\82gie2 joue :                *)\r
1799     (* Le cube est marqu\82 par 3 et affich\82 *)\r
1800     unit jouer2:procedure(i,j,k:integer);\r
1801     begin\r
1802       mat.tab(i,j,k).val:=3;\r
1803       mat.tab(i,j,k).marque:=1;\r
1804       call affic_elem(i,j,k,25,20);\r
1805     end jouer2;\r
1806 \r
1807     (* Strat\82gie2 *)\r
1808     unit strategie2:class;\r
1809          unit virtual titre:procedure;\r
1810          begin\r
1811          end titre;\r
1812          unit virtual trouve_3_pions:procedure;\r
1813          begin\r
1814          end trouve_3_pions;\r
1815          unit virtual trouve_2_pions:procedure;\r
1816          begin\r
1817          end trouve_2_pions;\r
1818          unit virtual trouve_1_pion:procedure;\r
1819          begin\r
1820          end trouve_1_pion;\r
1821          unit virtual adversaire_joue:procedure;\r
1822          begin\r
1823          end adversaire_joue;\r
1824          unit virtual gagne:procedure;\r
1825          begin\r
1826          end gagne;\r
1827          unit virtual perdu:procedure;\r
1828          begin\r
1829          end perdu;\r
1830     var i,j,k:integer;\r
1831     var trouve:boolean;\r
1832     begin\r
1833       joue1:=false;\r
1834       joue2:=false;\r
1835     return;\r
1836     do\r
1837        call titre;\r
1838        call outstring(430,120,"Coups jou\82s : ",14,3);\r
1839        call track(550,120,nb_coups,3,3);\r
1840        call track(550,120,nb_coups,3,14);\r
1841        inner;\r
1842        if mat.tab(1,1,1).marque=0 then\r
1843           call jouer2(1,1,1);\r
1844           nb_coups:=nb_coups+1;\r
1845           call adversaire_joue;\r
1846        else\r
1847          if nb_coups = 2 then\r
1848             if mat.tab(1,1,3).marque=0 then\r
1849                call jouer2(1,1,3);\r
1850                joue1:=true;\r
1851                nb_coups:=nb_coups+1;\r
1852                call adversaire_joue;\r
1853            else\r
1854              if mat.tab(1,3,1).marque=0 then\r
1855                 call jouer2(1,3,1);\r
1856                 joue2:=true;\r
1857                 nb_coups:=nb_coups+1;\r
1858                 call adversaire_joue;\r
1859              fi;\r
1860            fi;\r
1861          else\r
1862            call trouve_3_pions;\r
1863            if trouve then\r
1864               (* Si l'utilisateur a 3 pions align\82s il a gagn\82 *)\r
1865                call gagne;\r
1866                attach(main);\r
1867            else\r
1868              call trouve_aligne(3,2,i,j,k,trouve);\r
1869              if trouve then\r
1870                 (* Si la strat\82gie2 a 2 pions align\82s, elle rajoute   *)\r
1871                 (* le troisi\8ame et elle gagne donc l'utilisateur perd *)\r
1872                 call jouer2(i,j,k);\r
1873                 call track(550,120,nb_coups,3,3);\r
1874                 nb_coups:=nb_coups+1;\r
1875                 call track(550,120,nb_coups,3,14);\r
1876                 call trouve_aligne(3,3,i,j,k,trouve);\r
1877                 call perdu;\r
1878                 attach(main);\r
1879              else\r
1880                call trouve_2_pions;\r
1881                (* Sinon la strat\82gie2 bloque l'utilisateur si il a 2  *)\r
1882                (* pions align\82s                                       *)\r
1883                if trouve then\r
1884                   call jouer2(i,j,k);\r
1885                   nb_coups:=nb_coups+1;\r
1886                   call adversaire_joue;\r
1887                else\r
1888                  if joue1 and mat.tab(2,1,2).marque = 0 then\r
1889                     call jouer2(2,1,2);\r
1890                     nb_coups:=nb_coups+1;\r
1891                     joue1:=false;\r
1892                     call adversaire_joue;\r
1893                  else\r
1894                    if joue2 and mat.tab(2,2,1).marque = 0 then\r
1895                       call jouer2(2,2,1);\r
1896                       nb_coups:=nb_coups+1;\r
1897                       joue2:=false;\r
1898                       call adversaire_joue;\r
1899                    else\r
1900                      (* La strat\82gie2 aligne un pion avec un pion *)\r
1901                      (* de l'adversaire                           *)\r
1902                      call trouve_1_pion;\r
1903                      call jouer2(i,j,k);\r
1904                      nb_coups:=nb_coups+1;\r
1905                      call adversaire_joue;\r
1906                    fi;\r
1907                  fi;\r
1908                fi;\r
1909              fi;\r
1910            fi;\r
1911           fi;\r
1912         fi;\r
1913     od;\r
1914     end strategie2;\r
1915 \r
1916     (* Strat\82gie2 contre joueur *)\r
1917     unit strategie2_user2:strategie2 coroutine;\r
1918          unit virtual titre:procedure;\r
1919          begin\r
1920            call outstring(430,90,"L'utilisateur joue...",3,3);\r
1921            call outstring(430,90,"La strat\82gie2 joue...",9,3);\r
1922          end titre;\r
1923          unit virtual trouve_3_pions:procedure;\r
1924          begin\r
1925            call trouve_aligne(1,3,i,j,k,trouve);\r
1926          end trouve_3_pions;\r
1927          unit virtual trouve_2_pions:procedure;\r
1928          begin\r
1929            call trouve_aligne(1,2,i,j,k,trouve);\r
1930          end trouve_2_pions;\r
1931          unit virtual trouve_1_pion:procedure;\r
1932          begin\r
1933            call trouve_aligne(1,1,i,j,k,trouve);\r
1934          end trouve_1_pion;\r
1935          unit virtual adversaire_joue:procedure;\r
1936          begin\r
1937            attach(user2);\r
1938          end adversaire_joue;\r
1939          unit virtual gagne:procedure;\r
1940          begin\r
1941            call message_erreur(105,200,535,280,255,209,\r
1942            "Vous avez gagn\82",125,"",\r
1943             270,240,370,270,310,247);\r
1944          end gagne;\r
1945          unit virtual perdu:procedure;\r
1946          begin\r
1947            call message_erreur(105,200,535,280,255,209,\r
1948            "Vous avez perdu",125,"",\r
1949             270,240,370,270,310,247);\r
1950          end perdu;\r
1951     begin\r
1952     end strategie2_user2;\r
1953 \r
1954     (* Strat\82gie2 contre strat\82gie1 *)\r
1955     unit strategie2_strat1:strategie2 coroutine;\r
1956          unit virtual titre:procedure;\r
1957          begin\r
1958            call outstring(430,90,"La strat\82gie1 joue...",3,3);\r
1959            call outstring(430,90,"La strat\82gie2 joue...",9,3);\r
1960          end titre;\r
1961          unit virtual trouve_3_pions:procedure;\r
1962          begin\r
1963            call trouve_aligne(2,3,i,j,k,trouve);\r
1964          end trouve_3_pions;\r
1965          unit virtual trouve_2_pions:procedure;\r
1966          begin\r
1967            call trouve_aligne(2,2,i,j,k,trouve);\r
1968          end trouve_2_pions;\r
1969          unit virtual trouve_1_pion:procedure;\r
1970          begin\r
1971            call trouve_aligne(2,1,i,j,k,trouve);\r
1972          end trouve_1_pion;\r
1973          unit virtual adversaire_joue:procedure;\r
1974          begin\r
1975            attach(S12);\r
1976          end adversaire_joue;\r
1977          unit virtual gagne:procedure;\r
1978          begin\r
1979            call message_erreur(105,200,535,280,225,209,\r
1980            "La strat\82gie1 a gagn\82",125,"",\r
1981             270,240,370,270,310,247);\r
1982          end gagne;\r
1983          unit virtual perdu:procedure;\r
1984          begin\r
1985            call message_erreur(105,200,535,280,225,209,\r
1986            "La strat\82gie2 a gagn\82",125,"",\r
1987             270,240,370,270,310,247);\r
1988          end perdu;\r
1989     var cpt:integer;\r
1990     begin\r
1991       for cpt:=1 to 30000 do cpt:=cpt+1 od;\r
1992     end strategie2_strat1;\r
1993 \r
1994 (*-------------------------------- UTILISATEUR -----------------------------*)\r
1995 \r
1996     (* Utilisateur ou joueur *)\r
1997     unit utilisateur:class;\r
1998          unit virtual titre:procedure;\r
1999          end titre;\r
2000          unit virtual adversaire_joue:procedure;\r
2001          end adversaire_joue;\r
2002          unit virtual saisie_joueur:procedure;\r
2003          end saisie_joueur;\r
2004          unit virtual egalite:procedure;\r
2005          begin\r
2006          end egalite;\r
2007     var i:integer;\r
2008     begin\r
2009     return;\r
2010     do\r
2011         inner;\r
2012         call titre;\r
2013         call outstring(430,120,"Coups jou\82s : ",14,3);\r
2014         call track(550,120,nb_coups,3,3);\r
2015         call track(550,120,nb_coups,3,14);\r
2016         c:=0; joue:=false;\r
2017         (* On attend que le joueur colorie un cube et que cette saisie *)\r
2018         (* soit prise en compte. On attend donc que le joueur appuie   *)\r
2019         (* sur les boutons gauche et droite de la souris pour colorier *)\r
2020         (* un cube.                                                    *) \r
2021         while c <> 3 or not(joue)\r
2022         do\r
2023 \r
2024            d:=getpress(v,p,h,l,r,c);\r
2025            if c=1 then\r
2026               (* Touches d'affichage de la matrice *)\r
2027               call gestion_touches(v,p,c);\r
2028            fi;\r
2029            if c=1 or c=2 or c=3 then\r
2030               (* Le joueur colorie ou efface le coloriage d'un cube *)\r
2031               (* ou il joue : le coloriage est pris en compte       *)\r
2032               call saisie_joueur;\r
2033            fi;\r
2034            if c=1 then\r
2035               (* Acc\8as au menu principal *)\r
2036               call gestion_menu(v,p,c);\r
2037            fi;\r
2038         od;\r
2039         nb_coups:=nb_coups+1;\r
2040         if nb_coups=27 then\r
2041            call egalite;\r
2042            attach(main);\r
2043         else\r
2044          call adversaire_joue;\r
2045         fi;\r
2046     od;\r
2047     end utilisateur;\r
2048 \r
2049     (* Joueur contre la strat\82gie1 *)\r
2050     unit utilisateur1:utilisateur coroutine;\r
2051          unit virtual titre:procedure;\r
2052          begin\r
2053            call outstring(430,90,"La strat\82gie1 joue...",3,3);\r
2054            call outstring(430,90,"L'utilisateur joue...",12,3);\r
2055          end titre;\r
2056          unit virtual adversaire_joue:procedure;\r
2057          begin\r
2058            attach(S11);\r
2059          end adversaire_joue;\r
2060          unit virtual saisie_joueur:procedure;\r
2061          begin\r
2062            call saisie(v,p,c,20,25,1);\r
2063          end saisie_joueur;\r
2064          unit virtual egalite:procedure;\r
2065          begin\r
2066          call message_erreur(105,200,535,280,155,209,\r
2067          "Egalit\82 entre le joueur et la strat\82gie1",125,"",\r
2068           270,240,370,270,310,247);\r
2069          end egalite;\r
2070     begin\r
2071     end utilisateur1;\r
2072 \r
2073     (* Joueur contre la strat\82gie2 *)\r
2074     unit utilisateur2:utilisateur coroutine;\r
2075          unit virtual titre:procedure;\r
2076          begin\r
2077            call outstring(430,90,"La strat\82gie2 joue...",3,3);\r
2078            call outstring(430,90,"L'utilisateur joue...",12,3);\r
2079          end titre;\r
2080          unit virtual adversaire_joue:procedure;\r
2081          begin\r
2082            attach(S21);\r
2083          end adversaire_joue;\r
2084          unit virtual saisie_joueur:procedure;\r
2085          begin\r
2086            call saisie(v,p,c,20,25,1);\r
2087          end saisie_joueur;\r
2088     begin\r
2089       if nb_coups=27 then\r
2090          call message_erreur(105,200,535,280,155,209,\r
2091          "Egalit\82 entre le joueur et la strat\82gie2",125,"",\r
2092          270,240,370,270,310,247);\r
2093          attach(main);\r
2094       fi;\r
2095     end utilisateur2;\r
2096 \r
2097     (* Joueur1 contre Joueur2 *)\r
2098     unit utilisateur3:utilisateur coroutine;\r
2099          unit virtual titre:procedure;\r
2100          begin\r
2101            call outstring(430,90,"Le joueur2 joue...",3,3);\r
2102            call outstring(430,90,"Le joueur1 joue...",12,3);\r
2103          end titre;\r
2104          unit virtual adversaire_joue:procedure;\r
2105          begin\r
2106            attach(user4);\r
2107          end adversaire_joue;\r
2108          unit virtual saisie_joueur:procedure;\r
2109          begin\r
2110            call saisie(v,p,c,20,25,1);\r
2111          end saisie_joueur;\r
2112          unit virtual egalite:procedure;\r
2113          begin\r
2114            call message_erreur(105,200,535,280,155,209,\r
2115            "Egalit\82 entre le joueur1 et le joueur2",125,"",\r
2116             270,240,370,270,310,247);\r
2117          end egalite;\r
2118     var i,j,k:integer;\r
2119     var trouve:boolean;\r
2120     begin\r
2121       joueur:=1;\r
2122       call trouve_aligne(4,3,i,j,k,trouve);\r
2123       if trouve then\r
2124            call message_erreur(105,200,535,280,255,209,\r
2125            "Le joueur2 a gagn\82",125,"",\r
2126             270,240,370,270,310,247);\r
2127          attach(main);\r
2128       fi;\r
2129     end utilisateur3;\r
2130 \r
2131     (* Joueur2 contre Joueur1 *)\r
2132     unit utilisateur4:utilisateur coroutine;\r
2133          unit virtual titre:procedure;\r
2134          begin\r
2135            call outstring(430,90,"Le joueur1 joue...",3,3);\r
2136            call outstring(430,90,"Le joueur2 joue...",9,3);\r
2137          end titre;\r
2138          unit virtual adversaire_joue:procedure;\r
2139          begin\r
2140            attach(user3);\r
2141          end adversaire_joue;\r
2142          unit virtual saisie_joueur:procedure;\r
2143          begin\r
2144            call saisie(v,p,c,20,25,2);\r
2145          end saisie_joueur;\r
2146     var i,j,k:integer;\r
2147     var trouve:boolean;\r
2148     begin\r
2149       joueur:=2;\r
2150       call trouve_aligne(1,3,i,j,k,trouve);\r
2151       if trouve then\r
2152          call message_erreur(105,200,535,280,255,209,\r
2153          "Le joueur1 a gagn\82",125,"",\r
2154          270,240,370,270,310,247);\r
2155          attach(main);\r
2156       fi;\r
2157     end utilisateur4;\r
2158 \r
2159 (*--------------------------------------------------------------------------*)\r
2160 (*                                FICHIERS                                  *)\r
2161 (*--------------------------------------------------------------------------*)    \r
2162 \r
2163     (* Charger une matrice 3d \85 partir d'un fichier *)\r
2164     unit charger:procedure;\r
2165     var rep : arrayof char;\r
2166     var f : file;\r
2167     var i,j,k : integer;\r
2168     var trouve:boolean;\r
2169     begin\r
2170       call patern(400,30,630,150,3,1);\r
2171       call hidecursor;\r
2172       call init(0,0);\r
2173       call outstring(410,250,"Nom du fichier : ",15,3);\r
2174       rep:=hfont8(545,250,10,80,"Nom",3,15,15);\r
2175       open(f,integer,rep);\r
2176       call reset(f);\r
2177       get(f,mode);\r
2178       get(f,joueur);\r
2179       get(f,nb_coups);\r
2180       for i := 1 to 3\r
2181        do\r
2182           for j := 1 to 3\r
2183            do\r
2184               for k:= 1 to 3\r
2185                do\r
2186                   get(f,mat.tab(i,j,k).val);\r
2187                   get(f,mat.tab(i,j,k).marque);\r
2188                   get(f,mat.tab(i,j,k).x);\r
2189                   get(f,mat.tab(i,j,k).y);\r
2190                od;\r
2191            od;\r
2192        od;\r
2193       kill(f);\r
2194       call patern(400,220,630,260,3,1);\r
2195 \r
2196       call init(1,0);\r
2197       call showcursor;\r
2198       call setposition(275,445);\r
2199       for j:=1 to 5\r
2200        do\r
2201           call outstring(280,425,"Veuillez appuyer sur un des boutons",14,3);\r
2202           call outstring(280,445,"           de la souris",14,3);\r
2203           for i:=1 to 10000 do i:=i+1 od;\r
2204           call outstring(280,425,"Veuillez appuyer sur un des boutons",3,3);\r
2205           call outstring(280,445,"           de la souris",3,3);\r
2206           for i:=1 to 10000 do i:=i+1 od;\r
2207        od;\r
2208 \r
2209       (* Affichage de la matrice *)\r
2210       call affic(25,20);\r
2211       call outstring(410,275,"Chargement termin\82",15,3);\r
2212       for i:=1 to 10000 do i:=i+1 od;\r
2213       call outstring(410,275,"Chargement termin\82",3,3);\r
2214 \r
2215       call outstring(430,120,"Coups jou\82s : ",14,3);\r
2216       call track(550,120,nb_coups,3,14);\r
2217       case mode\r
2218         when 1:\r
2219              call outstring(400,60,"JOUEUR",12,3);\r
2220              call outstring(460,60,"CONTRE",0,3);\r
2221              call outstring(520,60,"STRATEGIE1",10,3);\r
2222 \r
2223              if nb_coups = 27 then\r
2224                 call message_erreur(105,200,535,280,155,209,\r
2225                 "La partie est termin\82e, et il y a \82galit\82",125,"",\r
2226                 270,240,370,270,310,247);\r
2227              else\r
2228                call trouve_aligne(1,3,i,j,k,trouve);\r
2229                if trouve then\r
2230                   call message_erreur(105,200,535,280,155,209,\r
2231                   "La partie est termin\82e, le joueur a gagn\82",125,"",\r
2232                   270,240,370,270,310,247);\r
2233                else\r
2234                  call trouve_aligne(2,3,i,j,k,trouve);\r
2235                  if trouve then\r
2236                     call message_erreur(105,200,535,280,155,209,\r
2237                     "La partie est termin\82e, la strat\82gie1 a gagn\82",125,"",\r
2238                     270,240,370,270,310,247);\r
2239                  else\r
2240                    S11:=new strategie1_user1;\r
2241                    user1:=new utilisateur1;\r
2242                    attach(user1);\r
2243                    kill(user1); kill(S11);\r
2244                  fi;\r
2245                fi;\r
2246              fi;\r
2247         when 2:\r
2248              call outstring(400,60,"JOUEUR",12,3);\r
2249              call outstring(460,60,"CONTRE",0,3);\r
2250              call outstring(520,60,"STRATEGIE2",9,3);\r
2251              if nb_coups = 27 then\r
2252                 call message_erreur(105,200,535,280,155,209,\r
2253                 "La partie est termin\82e, et il y a \82galit\82",125,"",\r
2254                 270,240,370,270,310,247);\r
2255              else\r
2256                call trouve_aligne(1,3,i,j,k,trouve);\r
2257                if trouve then\r
2258                   call message_erreur(105,200,535,280,155,209,\r
2259                   "La partie est termin\82e, le joueur a gagn\82",125,"",\r
2260                   270,240,370,270,310,247);\r
2261                else\r
2262                  call trouve_aligne(3,3,i,j,k,trouve);\r
2263                  if trouve then\r
2264                     call message_erreur(105,200,535,280,155,209,\r
2265                     "La partie est termin\82e, la strat\82gie2 a gagn\82",125,"",\r
2266                     270,240,370,270,310,247);\r
2267                  else\r
2268                    S21:=new strategie2_user2;\r
2269                    user2:=new utilisateur2;\r
2270                    attach(user2);\r
2271                    kill(user2); kill(S21);\r
2272                  fi;\r
2273                fi;\r
2274              fi;\r
2275         when 3:\r
2276              call outstring(400,60,"STRATEGIE1",10,3);\r
2277              call outstring(485,60,"CONTRE",0,3);\r
2278              call outstring(540,60,"STRATEGIE2",9,3);\r
2279              if nb_coups = 27 then\r
2280                 call message_erreur(105,200,535,280,155,209,\r
2281                 "La partie est termin\82e, et il y a \82galit\82",125,"",\r
2282                 270,240,370,270,310,247);\r
2283              else\r
2284                call trouve_aligne(2,3,i,j,k,trouve);\r
2285                if trouve then\r
2286                   call message_erreur(105,200,535,280,155,209,\r
2287                   "La partie est termin\82e, la strat\82gie1 a gagn\82",125,"",\r
2288                   270,240,370,270,310,247);\r
2289                else\r
2290                  call trouve_aligne(3,3,i,j,k,trouve);\r
2291                  if trouve then\r
2292                     call message_erreur(105,200,535,280,155,209,\r
2293                     "La partie est termin\82e, la strat\82gie2 a gagn\82",125,"",\r
2294                     270,240,370,270,310,247);\r
2295                  fi;\r
2296                fi;\r
2297              fi;\r
2298         when 4:\r
2299              call outstring(400,60,"JOUEUR1",12,3);\r
2300              call outstring(465,60,"CONTRE",0,3);\r
2301              call outstring(525,60,"JOUEUR2",9,3);\r
2302              if nb_coups = 27 then\r
2303                 call message_erreur(105,200,535,280,155,209,\r
2304                 "La partie est termin\82e, et il y a \82galit\82",125,"",\r
2305                 270,240,370,270,310,247);\r
2306              else\r
2307                call trouve_aligne(1,3,i,j,k,trouve);\r
2308                if trouve then\r
2309                   call message_erreur(105,200,535,280,155,209,\r
2310                   "La partie est termin\82e, le joueur1 a gagn\82",125,"",\r
2311                   270,240,370,270,310,247);\r
2312                else\r
2313                  call trouve_aligne(4,3,i,j,k,trouve);\r
2314                  if trouve then\r
2315                     call message_erreur(105,200,535,280,155,209,\r
2316                     "La partie est termin\82e, le joueur2 a gagn\82",125,"",\r
2317                     270,240,370,270,310,247);\r
2318                  else\r
2319                    user3:=new utilisateur3;\r
2320                    user4:=new utilisateur4;\r
2321                    if joueur=1 then\r
2322                       attach(user3);\r
2323                    else\r
2324                     if joueur=2 then\r
2325                        attach(user4);\r
2326                     fi;\r
2327                    fi;\r
2328                    kill(user3); kill(user4);\r
2329                  fi;\r
2330                fi;\r
2331              fi;\r
2332         esac;\r
2333     end charger;\r
2334 \r
2335     (* Enregistrement de la matrice 3d dans un fichier *)\r
2336     unit enregistrer:procedure;\r
2337     var f : file;\r
2338     var i,j,k : integer;\r
2339     var rep : arrayof char;\r
2340     begin\r
2341       call hidecursor;\r
2342       call init(0,0);\r
2343       call outstring(410,250,"Nom du fichier : ",15,3);\r
2344       rep:=hfont8(545,250,10,80,"Nom",3,15,15);\r
2345       open(f,integer,rep);\r
2346       call rewrite(f);\r
2347       put(f,mode);\r
2348       put(f,joueur);\r
2349       put(f,nb_coups);\r
2350       for i := 1 to 3\r
2351        do\r
2352           for j := 1 to 3\r
2353            do\r
2354               for k:= 1 to 3\r
2355                do\r
2356                   put(f,mat.tab(i,j,k).val);\r
2357                   put(f,mat.tab(i,j,k).marque);\r
2358                   put(f,mat.tab(i,j,k).x);\r
2359                   put(f,mat.tab(i,j,k).y);\r
2360                od;\r
2361            od;\r
2362        od;\r
2363       kill(f);\r
2364       call outstring(410,275,"Enregistrement termin\82",15,3);\r
2365       for i:=1 to 10000 do i:=i+1 od;\r
2366       call outstring(410,275,"Enregistrement termin\82",3,3);\r
2367       call patern(400,220,630,260,3,1);\r
2368 \r
2369       call init(1,0);\r
2370       call showcursor;\r
2371       call setposition(275,445);\r
2372       for j:=1 to 5\r
2373        do\r
2374           call outstring(280,425,"Veuillez appuyer sur un des boutons",14,3);\r
2375           call outstring(280,445,"           de la souris",14,3);\r
2376           for i:=1 to 10000 do i:=i+1 od;\r
2377           call outstring(280,425,"Veuillez appuyer sur un des boutons",3,3);\r
2378           call outstring(280,445,"           de la souris",3,3);\r
2379           for i:=1 to 10000 do i:=i+1 od;\r
2380        od;\r
2381     end enregistrer;\r
2382 \r
2383 (*--------------------------------------------------------------------------*)\r
2384 (*                         MENU PRINCIPAL ET SOUS-MENUS                     *)\r
2385 (*--------------------------------------------------------------------------*)    \r
2386 \r
2387     (* G\8are les touches (gauche,haut,droite,bas) de l'affichage *)\r
2388     (* du morpion 3d                                            *)\r
2389     unit gestion_touches:procedure(xmouse,ymouse,bouton_mouse:integer);\r
2390     var tab : arrayof integer;\r
2391     var i : integer;\r
2392     begin\r
2393       array tab dim (1:100);\r
2394       (* Bouton du haut *)\r
2395       if (xmouse >= 110 and xmouse <= 145 and ymouse >= 360 and\r
2396          ymouse <= 390 and bouton_mouse = 1) then\r
2397          call move(110,360);\r
2398          tab := getmap(145,390);\r
2399          for i:=1 to 1000 do i := i + 1 od;\r
2400          call bouton(110,360,145,390,120,370,"/\",7,8,15,4);\r
2401          for i:=1 to 1000 do i := i + 1 od;\r
2402          call move(110,360);\r
2403          call putmap(tab);\r
2404          call haut;\r
2405       else\r
2406         (* Bouton du bas *)\r
2407         if (xmouse >= 110 and xmouse <= 145 and ymouse >= 410 and\r
2408            ymouse <= 440 and bouton_mouse = 1) then\r
2409            call move(110,410);\r
2410            tab := getmap(145,440);\r
2411            for i:=1 to 1000 do i := i + 1 od;\r
2412            call bouton(110,410,145,440,120,420,"\/",7,8,15,4);\r
2413            for i:=1 to 1000 do i := i + 1 od;\r
2414            call move(110,410);\r
2415            call putmap(tab);\r
2416            call bas;\r
2417         else\r
2418           (* Bouton droit *)\r
2419           if (xmouse >= 170 and xmouse <= 205 and ymouse >= 410 and\r
2420              ymouse <= 440 and bouton_mouse = 1) then\r
2421              call move(170,410);\r
2422              tab := getmap(205,440);\r
2423              for i:=1 to 1000 do i := i + 1 od;\r
2424              call bouton(170,410,205,440,180,420,">>",7,8,15,4);\r
2425              for i:=1 to 1000 do i := i + 1 od;\r
2426              call move(170,410);\r
2427              call putmap(tab);\r
2428              call droit;\r
2429           else\r
2430             (* Bouton gauche *)\r
2431             if (xmouse >= 50 and xmouse <= 85 and ymouse >= 410 and\r
2432                ymouse <= 440 and bouton_mouse = 1) then\r
2433                call move(50,410);\r
2434                tab := getmap(85,440);\r
2435                for i:=1 to 1000 do i := i + 1 od;\r
2436                call bouton(50,410,85,440,60,420,"<<",7,8,15,4);\r
2437                for i:=1 to 1000 do i := i + 1 od;\r
2438                call move(50,410);\r
2439                call putmap(tab);\r
2440                call gauche;\r
2441             fi;\r
2442           fi;\r
2443         fi;\r
2444       fi;\r
2445     end gestion_touches;\r
2446 \r
2447     (* Cette proc\82dure effectue les diff\82rents jeux possibles selon le *)\r
2448     (* choix de l'utilisateur                                          *) \r
2449     unit gestion_mode_joueur:procedure(xmouse,ymouse,bouton_mouse:integer;\r
2450     tab2:arrayof integer);\r
2451     var tab : arrayof integer;\r
2452     var i:integer;\r
2453     begin\r
2454       if (xmouse>=195 and xmouse <= 445 and ymouse >= 140\r
2455          and ymouse <= 180 and bouton_mouse =1) then\r
2456          mode:=1;\r
2457          call move(195,140);\r
2458          tab := getmap(445,180);\r
2459          for i:=1 to 1000 do i:=i+1; od;\r
2460          call bouton(195,140,445,180,225,152,\r
2461          "Joueur contre strat\82gie1",7,8,15,4);\r
2462          for i:=1 to 5000 do i:=i+1; od;\r
2463          call move(195,140);\r
2464          call putmap(tab);\r
2465          call move(186,110);\r
2466          call putmap(tab2);\r
2467          S11:=new strategie1_user1;\r
2468          user1:=new utilisateur1;\r
2469          call outstring(400,60,"JOUEUR",12,3);\r
2470          call outstring(460,60,"CONTRE",0,3);\r
2471          call outstring(520,60,"STRATEGIE1",10,3);\r
2472          attach(user1);\r
2473          kill(user1); kill(S11);\r
2474          c:=2;\r
2475          efface:=true;\r
2476       else\r
2477         if (xmouse>=195 and xmouse <= 445 and ymouse >= 190\r
2478            and ymouse <= 230 and bouton_mouse=1) then\r
2479            mode:=2;\r
2480            call move(195,190);\r
2481            tab := getmap(445,230);\r
2482            for i:=1 to 1000 do i:=i+1; od;\r
2483            call bouton(195,190,445,230,225,202,\r
2484            "Joueur contre strat\82gie2",7,8,15,4);\r
2485            for i:=1 to 5000 do i:=i+1; od;\r
2486            call move(195,190);\r
2487            call putmap(tab);\r
2488            call move(186,110);\r
2489            call putmap(tab2);\r
2490            S21:=new strategie2_user2;\r
2491            user2:=new utilisateur2;\r
2492            call outstring(400,60,"JOUEUR",12,3);\r
2493            call outstring(460,60,"CONTRE",0,3);\r
2494            call outstring(520,60,"STRATEGIE2",9,3);\r
2495            attach(S21);\r
2496            kill(user2); kill(S21);\r
2497            c:=2;\r
2498            efface:=true;\r
2499         else\r
2500           if (xmouse>=195 and xmouse <= 445 and ymouse >= 240\r
2501              and ymouse <= 280 and bouton_mouse=1) then\r
2502              mode:=3;\r
2503              call move(195,240);\r
2504              tab := getmap(445,280);\r
2505              for i:=1 to 1000 do i:=i+1; od;\r
2506              call bouton(195,240,445,280,210,252,\r
2507              "Strat\82gie1 contre strat\82gie2",7,8,15,4);\r
2508              for i:=1 to 5000 do i:=i+1; od;\r
2509              call move(195,240);\r
2510              call putmap(tab);\r
2511              call move(186,110);\r
2512              call putmap(tab2);\r
2513              S12:=new strategie1_strat2;\r
2514              S22:=new strategie2_strat1;\r
2515              call outstring(400,60,"STRATEGIE1",10,3);\r
2516              call outstring(485,60,"CONTRE",0,3);\r
2517              call outstring(540,60,"STRATEGIE2",9,3);\r
2518              attach(S22);\r
2519              kill(S12); kill(S22);\r
2520              c:=2;\r
2521              efface:=true;\r
2522           else\r
2523             if (xmouse>=195 and xmouse <= 445 and ymouse >= 290\r
2524                and ymouse <= 330 and bouton_mouse=1) then\r
2525                mode:=4;\r
2526                call move(195,290);\r
2527                tab := getmap(445,330);\r
2528                for i:=1 to 1000 do i:=i+1; od;\r
2529                call bouton(195,290,445,330,230,302,\r
2530                "Joueur1 contre Joueur2",7,8,15,4);\r
2531                for i:=1 to 5000 do i:=i+1; od;\r
2532                call move(195,290);\r
2533                call putmap(tab);\r
2534                call move(186,110);\r
2535                call putmap(tab2);\r
2536                efface:=true;\r
2537                user3:=new utilisateur3;\r
2538                user4:=new utilisateur4;\r
2539                call outstring(400,60,"JOUEUR1",12,3);\r
2540                call outstring(465,60,"CONTRE",0,3);\r
2541                call outstring(525,60,"JOUEUR2",9,3);\r
2542                attach(user3);\r
2543                kill(user3); kill(user4);\r
2544                c:=2;\r
2545             fi;\r
2546           fi;\r
2547         fi;\r
2548       fi;\r
2549     end gestion_mode_joueur;\r
2550 \r
2551     (* Affiche le sous-menu mode joueur *)\r
2552     unit mode_joueur:procedure(xmouse,ymouse,bouton_mouse:integer);\r
2553     var tab : arrayof integer;\r
2554     begin\r
2555       call patern(400,30,630,150,3,1);\r
2556       call init_mat(mat);\r
2557       call affic(25,20);\r
2558       nb_coups:=0;\r
2559       mode:=0;joueur:=0;\r
2560       array tab dim (1:100);\r
2561       call move(186,110);\r
2562       tab := getmap(453,337);\r
2563 \r
2564       call bouton(186,110,453,337,210,117,\r
2565       "Choisissez votre mode de jeu",12,15,6,15);\r
2566 \r
2567       call cadre_bouton(195,140,445,180);\r
2568       call bouton(195,140,445,180,225,152,\r
2569       "Joueur contre strat\82gie1",7,15,8,14);\r
2570 \r
2571       call cadre_bouton(195,190,445,230);\r
2572       call bouton(195,190,445,230,225,202,\r
2573       "Joueur contre strat\82gie2",7,15,8,14);\r
2574 \r
2575       call cadre_bouton(195,240,445,280);\r
2576       call bouton(195,240,445,280,210,252,\r
2577       "Strat\82gie1 contre strat\82gie2",7,15,8,14);\r
2578 \r
2579       call cadre_bouton(195,290,445,330);\r
2580       call bouton(195,290,445,330,230,302,\r
2581       "Joueur1 contre Joueur2",7,15,8,14);\r
2582 \r
2583       efface:=false;\r
2584       do\r
2585          d:=getpress(v,p,h,l,r,c);\r
2586          call gestion_mode_joueur(v,p,c,tab);\r
2587          if c = 2 then exit fi;\r
2588       od;\r
2589       if not efface then\r
2590          call move(186,110);\r
2591          call putmap(tab);\r
2592       fi;\r
2593     end mode_joueur;\r
2594 \r
2595     (* G\8are le sous-menu comprenant :  *)\r
2596     (* - une nouvelle partie           *)\r
2597     (* - le chargement d'une partie    *)\r
2598     (* - l'enregistrement de la partie *)\r
2599     unit gestion_sous_menu:procedure(xmouse,ymouse,bouton_mouse:integer;\r
2600     tab:arrayof integer);\r
2601     var i:integer;\r
2602     begin\r
2603       if (xmouse>=30 and xmouse <= 202 and ymouse >= 32\r
2604          and ymouse <= 42 and bouton_mouse=1) then\r
2605          call outstring(30,30,"Nouvelle partie       ",12,8);\r
2606          for i:= 1 to 10000 do i:=i+1 od;\r
2607          call move(20,20);\r
2608          call putmap(tab);\r
2609          call outstring(20,3,"Jeu",14,7);\r
2610          call mode_joueur(xmouse,ymouse,bouton_mouse);\r
2611       else\r
2612         if (xmouse>=30 and xmouse <= 202 and ymouse >= 52\r
2613            and ymouse <= 62 and bouton_mouse=1) then\r
2614            call outstring(30,50,"Charger une partie    ",12,8);\r
2615            for i:= 1 to 10000 do i:=i+1 od;\r
2616            call outstring(30,50,"Charger une partie    ",14,7);\r
2617            call move(20,20);\r
2618            call putmap(tab);\r
2619            call outstring(20,3,"Jeu",14,7);\r
2620            call charger;\r
2621            c:=2;\r
2622         else\r
2623           if (xmouse>=30 and xmouse <= 202 and ymouse >= 72\r
2624              and ymouse <= 82 and bouton_mouse=1) then\r
2625              call outstring(30,70,"Enregistrer la partie ",12,8);\r
2626              for i:= 1 to 10000 do i:=i+1 od;\r
2627              call outstring(30,70,"Enregistrer la partie ",14,7);\r
2628              call move(20,20);\r
2629              call putmap(tab);\r
2630              call outstring(20,3,"Jeu",14,7);\r
2631              call enregistrer;\r
2632              c:=2;\r
2633           fi;\r
2634         fi;\r
2635       fi;\r
2636     end gestion_sous_menu;\r
2637 \r
2638     (* Affiche le sous-menu de l 'option "JEU" du menu principal *)\r
2639     unit sous_menu:procedure;\r
2640     var tab : arrayof integer;\r
2641     begin\r
2642       array tab dim (1:100);\r
2643       call move(20,20);\r
2644       tab := getmap(210,95);\r
2645       call bouton(20,20,210,95,0,0,"",7,15,8,14);\r
2646       call outstring(30,30,"Nouvelle partie       ",14,7);\r
2647       call outstring(30,50,"Charger une partie    ",14,7);\r
2648       call outstring(30,70,"Enregistrer la partie ",14,7);\r
2649       do\r
2650          d:=getpress(v,p,h,l,r,c);\r
2651          call gestion_sous_menu(v,p,c,tab);\r
2652          if c = 2 then exit fi;\r
2653       od;\r
2654       call move(20,20);\r
2655       call putmap(tab);\r
2656     end sous_menu;\r
2657 \r
2658     (* Cette proc\82dure g\8are le menu principal *)\r
2659     unit gestion_menu:procedure(xmouse,ymouse,bouton_mouse:integer);\r
2660     var i:integer;\r
2661     begin\r
2662       if (xmouse>=20 and xmouse <= 42 and ymouse >= 3\r
2663          and ymouse <= 15 and bouton_mouse=1) then\r
2664          call outstring(20,3,"Jeu",12,8);\r
2665          call sous_menu;\r
2666          call outstring(20,3,"Jeu",14,7);\r
2667       else\r
2668         if (xmouse>=90 and xmouse <= 122 and ymouse >= 3\r
2669            and ymouse <= 15 and bouton_mouse = 1) then\r
2670            call outstring(90,3,"Aide",12,8);\r
2671            call aide;\r
2672            call outstring(90,3,"Aide",14,7);\r
2673         else\r
2674           if (xmouse>=160 and xmouse <= 215 and ymouse >= 3\r
2675              and ymouse <= 15 and bouton_mouse=1) then\r
2676              call outstring(160,3,"Quitter",12,8);\r
2677              call groff;\r
2678              call endrun;\r
2679           fi;\r
2680         fi;\r
2681       fi;\r
2682     end gestion_menu;\r
2683 \r
2684     (* Menu principal *)\r
2685     unit menu:procedure;\r
2686     begin\r
2687       call bouton(0,0,640,20,0,0,"",7,15,8,14);\r
2688       call outstring(20,3,"Jeu",14,7);\r
2689       call outstring(90,3,"Aide",14,7);\r
2690       call outstring(160,3,"Quitter",14,7);\r
2691       do\r
2692          d:=getpress(v,p,h,l,r,c);\r
2693          if c=1 then\r
2694             call gestion_touches(v,p,c);\r
2695          fi;\r
2696          call gestion_menu(v,p,c);\r
2697       od;\r
2698     end menu;\r
2699 \r
2700 (*--------------------------------------------------------------------------*)\r
2701 (*                             PROGRAMME PRINCIPAL                          *)\r
2702 (*--------------------------------------------------------------------------*)\r
2703     var user1:utilisateur1; (* Joueur contre strat\82gie1 *)\r
2704     var user2:utilisateur2; (* Joueur contre strat\82gie2 *)\r
2705     var user3:utilisateur3; (* Joueur1 contre joueur2 *)\r
2706     var user4:utilisateur4; (* Joueur2 contre joueur1 *)\r
2707 \r
2708     var S11:strategie1_user1; (* Strat\82gie1 contre joueur *)\r
2709     var S12:strategie1_strat2; (* Strat\82gie1 contre strat\82gie2 *)\r
2710 \r
2711     var S21:strategie2_user2; (* Strat\82gie2 contre joueur *)\r
2712     var S22: strategie2_strat1; (* Strat\82gie2 contre strat\82gie1 *)\r
2713 \r
2714     var v,p,h,l,r,c:integer; (* Variables utilis\82es pour la souris :    *)\r
2715     var d:boolean;           (* v : position x du pointeur de la souris *)\r
2716                              (* p : position y du pointeur de la souris *)\r
2717                              (* c : bouton appuy\82 de la souris :        *)\r
2718                              (*     1 : bouton gauche appuy\82            *)\r
2719                              (*     2 : bouton droit appuy\82             *)\r
2720                              (*     3 : boutons droit et gauche appuy\82s *)\r
2721 \r
2722     var mat:mat_3d; (* Matrice 3d repr\82sentant le morpion 3d *)\r
2723 \r
2724     var nb_coups:integer; (* Nombre de coups jou\82s pour une partie *)\r
2725 \r
2726     var joue:boolean; (* indique si l'utilisateur a jou\82 *)\r
2727 \r
2728     var joue1:boolean; (* servent \85 la strat\82gie2 pour savoir si elle a *)\r
2729     var joue2:boolean; (* jou\82 son coup d'attaque                       *)\r
2730 \r
2731     var efface : boolean; (* indique que l'image que contenait tab2 a \82t\82 *)\r
2732                           (* restitu\82e                                    *)\r
2733 \r
2734     var mode:integer; (* indique le mode de jeu choisi par l'utilisateur *)\r
2735     var joueur:integer; (* indique pour le mode de jeu 4 (joueur1 contre *)\r
2736                         (* joueur2) si le joueur1 joue (joueur=1) ou le  *)\r
2737                         (* joueur2 (joueur=2). De cette fa\87on, lorqu'on  *)\r
2738                         (* reprend une partie sauvegard\82e sur fichier,   *)\r
2739                         (* on sait si c'est \85 partir du joueur1 ou du    *)\r
2740                         (* joueur2 que la partie a \82t\82 enregistr\82e.      *)\r
2741 \r
2742     begin\r
2743       (* Cr\82ation et initialisation de la matrice 3d *)\r
2744       mat := new mat_3d(3,3,3);\r
2745       call init_mat(mat);\r
2746 \r
2747       nb_coups:=0;\r
2748 \r
2749       call gron(0);\r
2750 \r
2751       call animation;\r
2752 \r
2753       (* Affichage du fond *)\r
2754       call bouton(0,22,640,480,100,100,"",3,11,8,10);\r
2755       call bouton(3,25,637,477,100,100,"",3,11,8,10);\r
2756 \r
2757       (* Affichage des boutons de visualisation du morpion 3d *)\r
2758       call cadre_bouton(110,360,145,390);\r
2759       call bouton(110,360,145,390,120,370,"/\",7,15,8,14);\r
2760 \r
2761       call cadre_bouton(50,410,85,440);\r
2762       call bouton(50,410,85,440,60,420,"<<",7,15,8,14);\r
2763 \r
2764       call cadre_bouton(110,410,145,440);\r
2765       call bouton(110,410,145,440,120,420,"\/",7,15,8,14);\r
2766 \r
2767       call cadre_bouton(170,410,205,440);\r
2768       call bouton(170,410,205,440,180,420,">>",7,15,8,14);\r
2769 \r
2770      (* affichage des bordures de la matrice morpion 3d *)\r
2771      call des_mat_3d(292,100,25,20,11);\r
2772 \r
2773      (* Affichage du contenu de la matrice morpion 3d *)\r
2774      call affic(25,20);\r
2775 \r
2776      (* initialisation de la souris *)\r
2777      call init(1,0);\r
2778      call showcursor;\r
2779      call getmovement(1,1);\r
2780 \r
2781      call menu;\r
2782 \r
2783      call groff;\r
2784   end\r
2785  end\r
2786 end.\r
2787 \r