examples/grazyna.xmp/pina.log

   1 \r
   2 Program chinois;\r
   3 const blanc=15,bleu=1,vert=2,vertpetrole=3,rouge=4,violet=5,marron=6,grisclair=7,\r
   4       grisfonce=8,bleuroi=9,vertclair=10,free=-1;\r
   5 \r
   6   \r
   7   UNIT coord2D:class(x,y:integer);\r
   8   end;\r
   9   \r
  10   UNIT coord3D:class(x,y,h:integer);\r
  11   end;\r
  12 \r
  13 \r
  14 UNIT gestion_caractere: IIUWGRAPH class;\r
  15 \r
  16   UNIT SAISIE:function(ti,e,x,y:integer):arrayof char;\r
  17    var i,n:integer,\r
  18     c: integer,\r
  19     t :arrayof char;\r
  20    begin\r
  21  \r
  22   array t dim(1:e);\r
  23   for i:=1 to e do\r
  24   t(i):=' ';\r
  25   od;\r
  26   \r
  27   do\r
  28   i:=1;\r
  29   c:=inkey;\r
  30   while c<>13 and c<>27 and i<=e do\r
  31    \r
  32    case ti\r
  33      when 1:\r
  34          if c>=48 and c<=57 then\r
  35            t(i):=chr(c);\r
  36            call move(x+i*9,y);\r
  37            call hascii(c);\r
  38            i:=i+1;\r
  39          fi;\r
  40      when 2:\r
  41            \r
  42          if  c>64 then\r
  43              t(i):=chr(c);\r
  44              call move(x+i*9,y);\r
  45              call hascii(c);\r
  46              i:=i+1;\r
  47          fi;\r
  48    esac;\r
  49    c:=inkey;\r
  50   od;\r
  51   if t(1)<>' ' then exit; fi;\r
  52   od;\r
  53   result:=t;\r
  54   end SAISIE;\r
  55 \r
  56   UNIT ConvEnt:function(t:arrayof char):integer;\r
  57   var n,i:integer;\r
  58   begin\r
  59   n:=0;\r
  60   for i:=1 to upper(t) do\r
  61    if t(i)<>' ' then\r
  62      n:=n*10+(ord(t(i))-48);\r
  63    fi;\r
  64   od;\r
  65    \r
  66    result:=n;\r
  67   end ConvEnt;\r
  68 \r
  69    UNIT displaystring:procedure(t:arrayof char,x,y,coul:integer);\r
  70   var i:integer;\r
  71   begin\r
  72    call color(coul);   \r
  73    for i:=1 to upper(t)\r
  74     do\r
  75        call move(x+i*9,y);\r
  76        call hascii(ord(t(i)));\r
  77     od; \r
  78   end;    \r
  79 END;\r
  80 \r
  81 \r
  82 UNIT element:class;\r
  83 var x,i,j,h:integer;\r
  84 END;\r
  85 \r
  86 \r
  87 UNIT ARBTAS : class;  (* structure utilis\82e par la coroutine ordinateur *)\r
  88 \r
  89    var tab : arrayof element,  (* tableau contenant les elements du tas *)\r
  90        nb  : integer,  (* entier le nombre d'elements du tas *)\r
  91        dimen: integer;\r
  92    (* fonction testant si le tas est vide ou non *)\r
  93    unit vide : function : boolean;  \r
  94    begin\r
  95       if (tab(1) = none)\r
  96          then result := true;\r
  97       fi;\r
  98    end vide;\r
  99 \r
 100    (* fonction retournant le minimum du tas *)\r
 101   unit mini : function : element;\r
 102    begin\r
 103       if not vide\r
 104          then result := tab(1);\r
 105       fi;\r
 106    end mini;\r
 107 \r
 108    (* fonction retournant la position d'un element dans le tas *)\r
 109    unit membre : function(elem:element) : integer;\r
 110       var i : integer;\r
 111    begin\r
 112       if not vide\r
 113          then for i:=1 to nb\r
 114               do\r
 115                 if tab(i).x = elem.x\r
 116                    then result := i;\r
 117                         exit;\r
 118                 fi;\r
 119               od;\r
 120       fi;\r
 121    end membre;\r
 122 \r
 123    (* procedure pour inserer un nouvel element dans le tas *)\r
 124    unit inserer : procedure(elem : element);\r
 125       var i : integer,\r
 126           aux : element,\r
 127           tabaux : arrayof element;\r
 128    begin\r
 129        if (nb >= dimen) (* on aggrandit le tableau trop petit *)\r
 130           then array tabaux dim (1:nb+1);\r
 131                for i:=1 to nb \r
 132                do\r
 133                  tabaux(i) := tab(i);\r
 134                od;\r
 135                tab := tabaux;\r
 136                dimen := dimen + 1; (* la dimension du tableau est *)\r
 137                                    (* incremente de 1             *) \r
 138        fi;\r
 139        nb := nb + 1;  (* le nombre d'elements est incremente de 1 *)\r
 140        tab(nb) := elem; (* l'element a inserer est place a la fin *)\r
 141        i := nb;\r
 142        aux := new element;\r
 143        do  (* on effectue des echanges tant que le fils est inferieur *)\r
 144            (* au pere *)  \r
 145          if (i <= 1 ) orif ( tab(i).x >= tab(i div 2).x )\r
 146             then exit;\r
 147          fi;\r
 148          aux := tab(i DIV 2);      (* echange pere-fils *)\r
 149          tab(i DIV 2) := tab(i);\r
 150          tab(i) := aux;\r
 151          i := i div 2;\r
 152        od;\r
 153    end inserer;\r
 154 \r
 155    (* procedure pour supprimer un element du tas *)\r
 156    unit supprimer : procedure(elem : element);\r
 157       var i,j : integer,\r
 158           aux : element;\r
 159    begin\r
 160       i := membre(elem);\r
 161       if ( i <> 0 )   (* on teste si l'element appartient au tas *)  \r
 162          then  kill(tab(i));\r
 163                tab(i) := tab(nb); (* le dernier element est place *)\r
 164                                  (* a l'endroit de l'element supprime *) \r
 165               nb := nb - 1;      (* on decremente le nombre d'elements *)\r
 166               aux := new element;\r
 167 \r
 168               while ( i <= (nb div 2) )\r
 169               do (* tant que tab(i) n'est pas une feuille *)\r
 170 \r
 171                 if (2*i = nb) orif (tab(2*i).x < tab(2*i + 1).x)\r
 172                    then j := 2*i;     (* on calcule l'indice du plus petit *)\r
 173                    else j := 2*i + 1; (* des 2 fils *)\r
 174                 fi;\r
 175 \r
 176                 if tab(i).x > tab(j).x\r
 177                    then aux := tab(i);   (* echange si la condition d'ordre *)\r
 178                         tab(i) := tab(j);(* n'est pas satisfaite *)\r
 179                         tab(j) := aux;\r
 180                         i := j;\r
 181                    else exit;\r
 182                 fi;\r
 183               od;\r
 184               tab(nb + 1) := none; (* le dernier element est supprime *)\r
 185       fi;\r
 186    end supprimer;\r
 187 \r
 188 begin\r
 189    array tab dim (1:10);\r
 190    nb := 0;\r
 191    dimen:=10;\r
 192 end ARBTAS;\r
 193 \r
 194 \r
 195 \r
 196 UNIT elem:class(i,j,k:integer);\r
 197 var prec:elem;\r
 198 end;\r
 199 \r
 200 \r
 201 UNIT pile:class;  (* structure utilis\82e par la coroutine controle*)\r
 202   var pointeur:elem;\r
 203 \r
 204   UNIT empiler:procedure(e:elem);\r
 205   begin\r
 206     e.prec:=pointeur;\r
 207     pointeur:=e;\r
 208   end;\r
 209 \r
 210   UNIT depiler:procedure;\r
 211     var tampon:elem;\r
 212     begin\r
 213       if not vide then\r
 214          tampon:=pointeur;\r
 215          pointeur:=pointeur.prec;\r
 216          kill(tampon);\r
 217       fi;\r
 218     end;\r
 219 \r
 220   UNIT sommet:function:elem;\r
 221   begin\r
 222    result:=pointeur;\r
 223   end;\r
 224 \r
 225   UNIT vide:function:boolean;\r
 226   begin\r
 227     result:=(pointeur=none);\r
 228   end;\r
 229 begin\r
 230 pointeur:=none;\r
 231 END;\r
 232 \r
 233 UNIT drawrect: IIUWGRAPH  procedure(x1,y1,x2,y2,couleur:integer);\r
 234 begin\r
 235   call color(couleur);\r
 236   call move(x1,y1);\r
 237   call draw(x2,y1);\r
 238   call draw(x2,y2);\r
 239   call draw(x1,y2);\r
 240   call draw(x1,y1);\r
 241 end;\r
 242 \r
 243 \r
 244 UNIT player: gestion_caractere class(couleur:integer,pl:plateau_jeu);\r
 245 END; \r
 246 \r
 247 \r
 248 \r
 249 UNIT ordi: player coroutine;\r
 250 \r
 251 var coinlibre,find:boolean,\r
 252      coin,c,quel,version:integer,\r
 253      place:coord3D,\r
 254      pos:integer,cointab:arrayof coord2D,\r
 255      posajouer:arrayof arrayof integer,\r
 256      mem:arbtas,\r
 257      adver,moi:arrayof info;\r
 258      \r
 259 \r
 260 \r
 261 UNIT info: class(n,sur:integer);\r
 262 var rangee:arrayof arrayof combinaison;\r
 263 begin\r
 264 \r
 265   block\r
 266    var i,j:integer;\r
 267   \r
 268   begin\r
 269     array rangee dim(1:n);\r
 270     for i:=1 to n do array rangee(i) dim (1:sur); od;\r
 271     for i:=1 to n do\r
 272       for j:=1 to sur do\r
 273          rangee(i,j):=new combinaison;\r
 274       od;\r
 275     od;\r
 276   end;\r
 277 \r
 278 end;\r
 279 \r
 280 \r
 281 UNIT find_place:function(quoi,l,x,h:integer;inout p:coord3D):boolean;\r
 282 const ligne=1,colonne=2,lignediag=3,coldiag=4,axe=5,dbdiag=7,bigdiag=6;\r
 283 var i:integer,\r
 284     trouve:boolean;\r
 285 begin\r
 286    trouve:=false;\r
 287    case quoi\r
 288      \r
 289      when dbdiag:\r
 290           \r
 291           case x\r
 292             when 1:\r
 293               case h\r
 294                 when 1:\r
 295                         for i:=1 TO 4 do\r
 296                            if pl.jeu(i,i,i)=free then\r
 297                               if i=posajouer(i,i) then trouve:=true; \r
 298                                   p.x:=i;p.y:=i;p.h:=i;\r
 299                               exit; fi;\r
 300                            fi;\r
 301                         od;\r
 302                 when 2:\r
 303                   for i:=1 TO 4 do\r
 304                     if pl.jeu(i,i,(4-i)+1)=free then\r
 305                       if posajouer(i,i)=(4-i)+1 then trouve:=true; \r
 306                          p.x:=i;p.y:=i;p.h:=(4-i)+1;\r
 307                          exit;\r
 308                       fi;\r
 309                     fi;\r
 310                    od;\r
 311                esac;   \r
 312             when 2:\r
 313                case h\r
 314                when 1:\r
 315                 for i:=1 TO 4 do\r
 316                  if pl.jeu(i,(4-i)+1,i)=free then\r
 317                    if i=posajouer(i,(4-i)+1) then trouve:=true; \r
 318                      p.x:=i;p.y:=(4-i)+1;p.h:=i;\r
 319                   exit;\r
 320                  fi;\r
 321                  fi;\r
 322                 od;\r
 323                when 2:\r
 324                 for i:=1 TO 4 do\r
 325                  if pl.jeu(i,(4-i)+1,(4-i)+1)=free then\r
 326                    if posajouer(i,(4-i)+1)=(4-i)+1 then trouve:=true; \r
 327                      p.x:=i;p.y:=(4-i)+1;p.h:=(4-i)+1;\r
 328                   exit;\r
 329                  fi;\r
 330                  fi;\r
 331                 od;\r
 332                 esac;\r
 333            esac;\r
 334 \r
 335      when bigdiag:\r
 336           \r
 337           case l\r
 338             when 1:\r
 339               for i:=1 TO 4 do\r
 340                if pl.jeu(i,i,h)=free then\r
 341                  if h=posajouer(i,i) then trouve:=true; \r
 342                    p.x:=i;p.y:=i;p.h:=h;\r
 343                  fi;\r
 344                exit;\r
 345                fi;\r
 346               od;\r
 347             when 2:\r
 348               for i:=1 TO 4 do\r
 349                if pl.jeu(i,(4-i)+1,h)=free then\r
 350                  if h=posajouer(i,(4-i)+1) then trouve:=true; \r
 351                    p.x:=i;p.y:=(4-i)+1;p.h:=h;\r
 352                fi;\r
 353                exit;\r
 354                fi;\r
 355               od;\r
 356            esac;\r
 357      when ligne:          (* recherche d'une place dans la ligne sp\82cifi\82e *)\r
 358           for i:=1 to 4 do\r
 359             if pl.jeu(x,i,h)=free then \r
 360               if h=posajouer(x,i) then trouve:=true; fi;\r
 361             exit;\r
 362             fi;\r
 363           od;\r
 364           if trouve then\r
 365           p.x:=x;\r
 366           p.y:=i;\r
 367           p.h:=posajouer(x,i);\r
 368 \r
 369           fi;\r
 370      when colonne:  (* recherche d'une place dans la colonne sp\82cifi\82e *)\r
 371           for i:=1 to 4 do\r
 372             if pl.jeu(i,x,h)=free then \r
 373                if posajouer(i,x)=h then trouve:=true; \r
 374                      p.x:=i;p.y:=x;p.h:=posajouer(i,x);\r
 375                fi;\r
 376                exit;\r
 377             fi;\r
 378           od;\r
 379 \r
 380           \r
 381 \r
 382      when lignediag:(* recherche d'une place dans la diagonnal ligne sp\82cifi\82e *)\r
 383           case l\r
 384              when 1:  for i:=1 to 4 do\r
 385                if pl.jeu(x,i,i)=free then \r
 386                  if posajouer(x,i)=i then trouve:=true;\r
 387                       p.x:=x;p.y:=i;p.h:=i;\r
 388                  fi;\r
 389                exit;\r
 390                fi;\r
 391                od;\r
 392           \r
 393 \r
 394              when 2: for i:=1 to 4 do\r
 395                     if pl.jeu(x,i,(4-i)+1)=free then \r
 396                       if posajouer(x,i)=(4-i)+1 then trouve:=true;\r
 397                            p.x:=x;p.y:=i;p.h:=(4-i)+1;\r
 398                       fi;\r
 399                       exit;                    \r
 400                     fi;\r
 401                     od;\r
 402           \r
 403 \r
 404              esac;\r
 405      when axe: (* recherche d'une place dans l'axe sp\82cifi\82e *)\r
 406             if posajouer(x,h)<>5 then\r
 407               p.x:=x;\r
 408               p.y:=h;\r
 409               p.h:=posajouer(x,h);\r
 410               trouve:=true;\r
 411             fi;\r
 412      when coldiag:(* recherche d'une place dans la diagonnal colonne sp\82cifi\82e *)\r
 413           case l\r
 414              when 1:  for i:=1 to 4 do\r
 415                         if pl.jeu(i,x,i)=free then \r
 416                           if posajouer(i,x)=i then trouve:=true;\r
 417                                p.x:=i;p.y:=x;p.h:=i;\r
 418                           fi;\r
 419                           exit;\r
 420                         fi;\r
 421                       od;\r
 422           \r
 423 \r
 424              when 2: for i:=1 to 4 do\r
 425                         if pl.jeu(i,x,(4-i)+1)=free then \r
 426                            if posajouer(i,x)=(4-i)+1 then trouve:=true;\r
 427                                p.x:=i;p.y:=x;p.h:=(4-i)+1;\r
 428                            fi;\r
 429                            exit;\r
 430                         fi;\r
 431                      od;\r
 432              esac;\r
 433 \r
 434      esac;\r
 435      result:=trouve;\r
 436    \r
 437 end;\r
 438 \r
 439 UNIT isintwodiag:function(x,y,h:integer;inout a,b:integer):boolean;\r
 440 var trouve:boolean;\r
 441 begin\r
 442   trouve:=false;\r
 443       if (h=x) and (x=y)  then trouve:=true;\r
 444             a:=1;b:=1;\r
 445       else \r
 446            if (x=y) and (h=(4-x)+1) then trouve:=true;\r
 447              a:=1;b:=2;\r
 448            else\r
 449               if (x=(4-y)+1) and (h=x) then trouve:=true; \r
 450                 a:=2;b:=1;\r
 451               else\r
 452                if  (x=(4-y)+1) and (h=y) then trouve:=true; \r
 453                 a:=2;b:=2;\r
 454                fi;\r
 455               fi;\r
 456            fi;\r
 457       fi;\r
 458    result:=trouve;\r
 459 end;\r
 460 \r
 461 UNIT isinbigdiag:function(x,y:integer;inout quel:integer):boolean;\r
 462 const droite=1,gauche=2;\r
 463 var i:integer,\r
 464     trouve:boolean;\r
 465 begin\r
 466       quel:=0;\r
 467       trouve:=false;\r
 468       if  (x=y) then trouve:=true; \r
 469       quel:=1;\r
 470       else\r
 471         if  (x=(4-y)+1) then trouve:=true; \r
 472            quel:=2 \r
 473         fi;\r
 474       fi;                       \r
 475       \r
 476       result:=trouve;\r
 477 end;\r
 478 \r
 479 \r
 480 UNIT isindiag:function(l,h:integer;inout dg:integer):boolean;\r
 481 var trouve:boolean;\r
 482 begin\r
 483       trouve:=false;\r
 484       if  h=l then trouve:=true; \r
 485            dg:=1;\r
 486       else\r
 487        if  h=(4-l)+1 then trouve:=true; \r
 488            dg:=2;\r
 489        fi;\r
 490        fi;\r
 491       result:=trouve;\r
 492 end;\r
 493 \r
 494 \r
 495 unit troisboules:function(tab:arrayof info;inout p:coord3D):boolean;\r
 496 var i,j:integer,\r
 497     trouve:boolean;\r
 498 begin\r
 499    trouve:=false;\r
 500   if p<>none then \r
 501        \r
 502 \r
 503    if tab(1).rangee(p.x,p.h).nbre_boule=3 then\r
 504                trouve:=find_place(1,0,p.x,p.h,p);\r
 505                \r
 506    else if tab(2).rangee(p.y,p.h).nbre_boule=3 then\r
 507                trouve:=find_place(2,0,p.y,p.h,p);\r
 508                \r
 509         else \r
 510         if tab(5).rangee(p.x,p.y).nbre_boule=3 then\r
 511              trouve:=find_place(5,0,p.x,p.y,p);\r
 512              \r
 513         else \r
 514              if isinbigdiag(p.x,p.y,i) then\r
 515                if tab(6).rangee(p.h,i).nbre_boule=3 then\r
 516                   trouve:=find_place(6,i,p.x,p.h,p);\r
 517                fi;\r
 518              fi;\r
 519              if isintwodiag(p.x,p.y,p.h,i,j) then\r
 520                   if tab(7).rangee(i,j).nbre_boule=3 then  \r
 521                     trouve:=find_place(7,0,i,j,p);\r
 522                   fi;\r
 523              fi;\r
 524              for i:=1 to 2 do\r
 525                 if tab(3).rangee(p.x,i).nbre_boule=3 then\r
 526                      trouve:=find_place(3,i,p.y,p.h,p);\r
 527                      exit; fi; \r
 528                 if tab(4).rangee(p.y,i).nbre_boule=3 then     \r
 529                      trouve:=find_place(4,i,p.x,p.h,p);\r
 530                      exit; fi;\r
 531              od;       \r
 532         fi;\r
 533         fi;\r
 534    fi;\r
 535    fi;          \r
 536    result:=trouve;\r
 537 end;\r
 538 \r
 539 UNIT addcombinaison:procedure(tab:arrayof info,x,y,h:integer);\r
 540 begin\r
 541 \r
 542      call tab(1).rangee(x,h).plus; \r
 543      call tab(2).rangee(y,h).plus; \r
 544      call tab(5).rangee(x,y).plus;\r
 545      if isindiag(y,h,quel) then\r
 546                     call tab(3).rangee(x,quel).plus;\r
 547      fi;     \r
 548      if isindiag(x,h,quel) then\r
 549                     call tab(4).rangee(y,quel).plus;\r
 550      fi;    \r
 551      if isinbigdiag(x,y,quel) then\r
 552                    call tab(6).rangee(h,quel).plus;\r
 553      fi;\r
 554      if isintwodiag(x,y,h,quel,version) then\r
 555             call tab(7).rangee(quel,version).plus;\r
 556      fi;\r
 557 \r
 558 end;\r
 559 UNIT delcombinaison:procedure(tab:arrayof info,x,y,h:integer);\r
 560 var quel,version:integer;\r
 561 begin\r
 562 \r
 563                        (* si une boule a deja ete mise *)\r
 564      call tab(1).rangee(x,h).elimine;\r
 565      call tab(2).rangee(y,h).elimine;\r
 566      \r
 567      if isindiag(y,h,version) then    (* diagonnale ligne*)\r
 568           call tab(3).rangee(x,version).elimine; fi;\r
 569      if isindiag(x,h,version) then  (* diagonnale colonne*)\r
 570          call tab(4).rangee(y,version).elimine; fi;\r
 571      call tab(5).rangee(x,y).elimine;\r
 572      if isinbigdiag(x,y,quel) then\r
 573           call tab(6).rangee(h,quel).elimine; fi;\r
 574      if isintwodiag(x,y,h,quel,version) then\r
 575          call tab(7).rangee(quel,version).elimine; fi;\r
 576 end;\r
 577 \r
 578 UNIT selectcoup: procedure(inout p:coord3D);\r
 579 var coup:element,\r
 580     trouve,bien:boolean;\r
 581     \r
 582 begin\r
 583      trouve:=false;\r
 584      while (not mem.vide) and (not trouve) do\r
 585         coup:=mem.mini;\r
 586         \r
 587         posajouer(coup.i,coup.j):=posajouer(coup.i,coup.j)+1;\r
 588           p.x:=coup.i;\r
 589           p.y:=coup.j;\r
 590           p.h:=coup.h+1;\r
 591        if p.h<>5 then \r
 592            if not troisboules(adver,p) then \r
 593              p.h:=coup.h;\r
 594              p.x:=coup.i;\r
 595              p.y:=coup.j;\r
 596              trouve:=true;\r
 597              posajouer(coup.i,coup.j):=posajouer(coup.i,coup.j)-1;\r
 598            else \r
 599              posajouer(coup.i,coup.j):=posajouer(coup.i,coup.j)-1;\r
 600              call mem.supprimer(coup);\r
 601            fi;\r
 602        else trouve:=true;\r
 603             p.h:=coup.h;\r
 604             posajouer(coup.i,coup.j):=posajouer(coup.i,coup.j)-1;\r
 605        fi;\r
 606      od;\r
 607      while not mem.vide do\r
 608         call mem.supprimer(mem.mini);\r
 609      od;\r
 610 end;\r
 611 \r
 612 \r
 613 UNIT stratego:procedure;\r
 614 var coup:coord3D,\r
 615     e:element,\r
 616     poid,n,version,quel,x,i,j:integer;\r
 617 begin\r
 618 \r
 619    for i:=1 to 4 do\r
 620       for j:=1 to  4 do\r
 621         if posajouer(i,j)<5 then\r
 622          coup:=new coord3D(i,j,posajouer(i,j));\r
 623 \r
 624          poid:=0;\r
 625          n:=0;\r
 626          \r
 627              \r
 628          if moi(1).rangee(coup.x,coup.h).possible then \r
 629           case  moi(1).rangee(coup.x,coup.h).nbre_boule\r
 630             when 3:poid:=poid+100;\r
 631             otherwise\r
 632             poid:=poid+moi(1).rangee(coup.x,coup.h).nbre_boule;\r
 633           esac;  \r
 634             n:=n+1;\r
 635          fi;\r
 636          if moi(2).rangee(coup.y,coup.h).possible then\r
 637            case moi(2).rangee(coup.y,coup.h).nbre_boule   \r
 638              when 3:poid:=poid+100;\r
 639              otherwise\r
 640               poid:=moi(2).rangee(coup.y,coup.h).nbre_boule+poid;\r
 641            esac;\r
 642               n:=n+1;\r
 643          fi;\r
 644          \r
 645          if isindiag(coup.y,coup.h,quel) then\r
 646           if moi(3).rangee(coup.x,quel).possible then\r
 647             case moi(3).rangee(coup.x,quel).nbre_boule\r
 648              when 3:poid:=poid+100;\r
 649              otherwise\r
 650              poid:=poid+moi(3).rangee(coup.x,quel).nbre_boule;\r
 651             esac;\r
 652              n:=n+1;        \r
 653           fi;   \r
 654          fi;\r
 655           if isindiag(coup.x,coup.h,quel) then\r
 656           if moi(4).rangee(coup.y,quel).possible then     \r
 657             case moi(4).rangee(coup.y,quel).nbre_boule \r
 658              when 3: poid:=poid+100;\r
 659              otherwise\r
 660              poid:=poid+moi(4).rangee(coup.y,quel).nbre_boule;               \r
 661              esac;\r
 662              n:=n+1;\r
 663           fi;\r
 664           fi;\r
 665                 \r
 666           if moi(5).rangee(coup.x,coup.y).possible then\r
 667            case moi(5).rangee(coup.x,coup.y).nbre_boule\r
 668             when 3:poid:=poid+100;\r
 669             otherwise\r
 670             poid:=poid+moi(5).rangee(coup.x,coup.y).nbre_boule;\r
 671            esac;\r
 672             n:=n+1;\r
 673           fi;\r
 674           if isinbigdiag(coup.x,coup.y,quel) then\r
 675                 if moi(6).rangee(coup.h,quel).possible then\r
 676                 case moi(6).rangee(coup.h,quel).nbre_boule\r
 677                 when 3: poid:=poid+100;\r
 678                  otherwise\r
 679              poid:=poid+moi(6).rangee(coup.h,quel).nbre_boule;\r
 680              esac;\r
 681              n:=n+1;\r
 682           fi;\r
 683           fi;\r
 684           if isintwodiag(coup.x,coup.y,coup.h,quel,version) then\r
 685                   if moi(7).rangee(quel,version).possible then\r
 686                case moi(7).rangee(quel,version).nbre_boule\r
 687                when 3:poid:=poid+100;\r
 688                otherwise\r
 689              poid:=poid+moi(7).rangee(quel,version).nbre_boule;\r
 690              esac;\r
 691              n:=n+1;\r
 692           fi;\r
 693           fi;\r
 694 \r
 695          if adver(1).rangee(coup.x,coup.h).possible and \r
 696             adver(2).rangee(coup.y,coup.h).possible then         \r
 697               if adver(1).rangee(coup.x,coup.h).nbre_boule=2 and\r
 698                  adver(2).rangee(coup.y,coup.h).nbre_boule=2 then\r
 699                  poid:=poid+20;\r
 700               fi;\r
 701          fi;\r
 702          if adver(1).rangee(coup.x,coup.h).possible and \r
 703                 isindiag(coup.x,coup.h,quel) then\r
 704 \r
 705              if  adver(4).rangee(coup.y,quel).possible then         \r
 706               if adver(1).rangee(coup.x,coup.h).nbre_boule=2 and\r
 707                  adver(4).rangee(coup.y,quel).nbre_boule=2 then\r
 708                  poid:=poid+20;\r
 709               fi;\r
 710              fi;\r
 711          fi;\r
 712          \r
 713          x:=coup.x;\r
 714          for c:=1 to 2 do\r
 715          if adver(c).rangee(x,coup.h).possible and \r
 716             adver(5).rangee(coup.x,coup.y).possible then         \r
 717               if adver(c).rangee(x,coup.h).nbre_boule=2 and\r
 718                  adver(5).rangee(coup.x,coup.y).nbre_boule=2 then\r
 719                  poid:=poid+20;\r
 720               fi;\r
 721          fi;\r
 722          if adver(c).rangee(x,coup.h).possible and \r
 723                 isinbigdiag(coup.x,coup.y,quel) then\r
 724 \r
 725              if  adver(6).rangee(coup.h,quel).possible then         \r
 726               if adver(c).rangee(x,coup.h).nbre_boule=2 and\r
 727                  adver(6).rangee(coup.h,quel).nbre_boule=2 then\r
 728                  poid:=poid+20;\r
 729               fi;\r
 730              fi;\r
 731          fi;\r
 732          if adver(c).rangee(x,coup.h).possible and \r
 733                 isintwodiag(coup.x,coup.y,coup.h,quel,version) then\r
 734 \r
 735              if  adver(7).rangee(quel,version).possible then         \r
 736               if adver(c).rangee(x,coup.h).nbre_boule=2 and\r
 737                  adver(7).rangee(quel,version).nbre_boule=2 then\r
 738                  poid:=poid+20;\r
 739               fi;\r
 740              fi;\r
 741          fi;\r
 742          x:=coup.y;\r
 743          od;\r
 744 \r
 745          if adver(1).rangee(coup.x,coup.h).possible then \r
 746             case adver(1).rangee(coup.x,coup.h).nbre_boule\r
 747             when 3:poid:=poid+80;\r
 748             otherwise\r
 749             poid:=poid+1;\r
 750             esac;\r
 751             n:=n+1;\r
 752          fi;\r
 753          if adver(2).rangee(coup.y,coup.h).possible then\r
 754               case adver(2).rangee(coup.y,coup.h).nbre_boule\r
 755               when 3:poid:=poid+80;\r
 756               otherwise \r
 757               poid:=1+poid;\r
 758               esac;\r
 759               n:=n+1;\r
 760          fi;\r
 761          \r
 762           if isindiag(coup.y,coup.h,quel) then\r
 763           if adver(3).rangee(coup.x,quel).possible then\r
 764           case adver(3).rangee(coup.x,quel).nbre_boule\r
 765           when 3:poid:=poid+80;\r
 766           otherwise\r
 767           poid:=poid+1;\r
 768           esac;\r
 769              n:=n+1;        \r
 770           fi;   \r
 771           fi;\r
 772           if isindiag(coup.x,coup.h,quel) then\r
 773           if adver(4).rangee(coup.y,quel).possible then     \r
 774           case adver(4).rangee(coup.y,quel).nbre_boule\r
 775           when 3:poid:=poid+80;\r
 776           otherwise\r
 777              poid:=poid+1;               \r
 778           esac;\r
 779              n:=n+1;\r
 780           fi;\r
 781           fi;\r
 782                 \r
 783           if adver(5).rangee(coup.x,coup.y).possible then\r
 784           case adver(5).rangee(coup.x,coup.y).nbre_boule\r
 785           when 3:poid:=poid+80;\r
 786           otherwise\r
 787             poid:=poid+1;\r
 788          esac;\r
 789             n:=n+1;\r
 790           fi;\r
 791           if isinbigdiag(coup.x,coup.y,quel) then\r
 792                 if adver(6).rangee(coup.h,quel).possible then\r
 793              case adver(6).rangee(coup.h,quel).nbre_boule\r
 794              when 3:poid:=poid+80;\r
 795              otherwise\r
 796              poid:=poid+1;\r
 797              esac;\r
 798              n:=n+1;\r
 799           fi;\r
 800           fi;\r
 801           if isintwodiag(coup.x,coup.y,coup.h,quel,version) then\r
 802                   if adver(7).rangee(quel,version).possible then\r
 803               case adver(7).rangee(quel,version).nbre_boule\r
 804               when 3:poid:=poid+80;\r
 805               otherwise\r
 806              poid:=poid+1;\r
 807              esac;\r
 808              n:=n+1;\r
 809           fi;\r
 810           fi;\r
 811           if coinlibre and poid<20 then\r
 812           do\r
 813            pos:=round(random*3)+1;\r
 814            coup.x:=cointab(pos).x;\r
 815            coup.y:=cointab(pos).y;\r
 816            coup.h:=1;\r
 817 \r
 818            if pl.jeu(coup.x,coup.y,coup.h)=free then \r
 819                   coin:=coin-1;poid:=poid+20;\r
 820                   if coin=0 then coinlibre:=false; fi;\r
 821                   exit; fi;\r
 822            \r
 823           od;\r
 824           fi;\r
 825           poid:=(-poid);\r
 826           e:=new element;\r
 827           e.x:=poid; e.i:=coup.x;e.j:=coup.y;e.h:=coup.h;\r
 828           call mem.inserer(e);\r
 829           \r
 830         fi;\r
 831       od;\r
 832     od;\r
 833 end;\r
 834 \r
 835 unit combinaison:class;\r
 836   var nb:integer,\r
 837       possible:boolean;\r
 838   \r
 839   unit incremente:function:integer;\r
 840     begin \r
 841       nb:=nb+1;\r
 842       result:=nb;\r
 843     end;\r
 844   \r
 845   unit plus:procedure;\r
 846     begin \r
 847       nb:=nb+1;\r
 848     end;\r
 849   \r
 850   unit nbre_boule:function:integer;\r
 851     begin\r
 852       result:=nb;\r
 853     end;\r
 854 \r
 855   unit elimine:procedure;\r
 856     begin\r
 857      possible:=false;\r
 858     end;\r
 859 \r
 860 begin\r
 861  nb:=0;\r
 862  possible:=true;\r
 863 END;\r
 864 \r
 865 begin\r
 866     mem:=new arbtas;\r
 867     array cointab dim(1:4);\r
 868     cointab(1):=new coord2D(1,1);\r
 869     cointab(2):=new coord2D(4,4);\r
 870     cointab(3):=new coord2D(1,4);\r
 871     cointab(4):=new coord2D(4,1);\r
 872     coinlibre:=true;\r
 873     coin:=4;\r
 874     block\r
 875      var i,j:integer;\r
 876     begin\r
 877     array adver dim (1:7);\r
 878     array moi dim (1:7);\r
 879     \r
 880     array posajouer dim(1:4);\r
 881     for i:=1 to 4 do\r
 882    \r
 883     array posajouer(i) dim(1:4);\r
 884    \r
 885      if (i<3) then\r
 886        adver(i):=new info(4,4);\r
 887        moi(i):=new info(4,4);\r
 888      else\r
 889        adver(i):=new info(4,2);\r
 890        moi(i):=new info(4,2);\r
 891      fi;\r
 892      \r
 893     od;          \r
 894     adver(5):=new info(4,4);\r
 895     moi(5):=new info(4,4);\r
 896     adver(6):=new info(4,2);\r
 897     moi(6):=new info(4,2);\r
 898     adver(7):=new info(2,2);\r
 899     moi(7):=new info(2,2);\r
 900 \r
 901 \r
 902     for i:=1 to 4 do\r
 903       for j:=1 to 4 do\r
 904         posajouer(i,j):=1;\r
 905       od;\r
 906     od;\r
 907     end;\r
 908 \r
 909     return;\r
 910     place:=new coord3D(1,1,1);\r
 911   DO  \r
 912        find:=false;\r
 913        call pl.arrow.ligne(pl.line,0);\r
 914        call pl.arrow.colonne(pl.col,0);\r
 915      \r
 916      (*****************************************)\r
 917      (* elimination de quelques combinaisons  *)\r
 918      (*****************************************)     \r
 919    if pl.haut<>0 then   \r
 920      call addcombinaison(adver,pl.line,pl.col,pl.haut); \r
 921      call delcombinaison(moi,pl.line,pl.col,pl.haut);\r
 922      posajouer(pl.line,pl.col):=posajouer(pl.line,pl.col)+1;\r
 923 \r
 924 \r
 925      (*********************************)\r
 926      (*** est ce que j'ai gagne ? !!!!*)\r
 927      (*********************************)\r
 928      \r
 929      find:=troisboules(moi,place);\r
 930                     \r
 931      (*********************************)\r
 932      (*  contre des 3 boules align\82es *)\r
 933      (*********************************)     \r
 934          if (pl.haut=1 and \r
 935                ((pl.line=4 or pl.line=1) and (pl.col=1 or pl.col=4))) then\r
 936              coin:=coin-1;  fi;\r
 937          if coin=0 then coinlibre:=false; fi;\r
 938      \r
 939      if not find then\r
 940      \r
 941      if (adver(1).rangee(pl.line,pl.haut).nbre_boule=3) and \r
 942         (adver(1).rangee(pl.line,pl.haut).possible) then \r
 943                                 find:=find_place(1,0,pl.line,pl.haut,place);\r
 944                                 \r
 945      fi; \r
 946      if (adver(2).rangee(pl.col,pl.haut).nbre_boule=3) and \r
 947             (adver(2).rangee(pl.col,pl.haut).possible) then \r
 948                                 find:=find_place(2,0,pl.col,pl.haut,place);\r
 949                                 \r
 950      fi;\r
 951      if (adver(5).rangee(pl.line,pl.col).nbre_boule=3) and \r
 952             (adver(5).rangee(pl.line,pl.col).possible) then \r
 953                                 find:=find_place(5,0,pl.line,pl.col,place);\r
 954                                 \r
 955      fi;\r
 956      \r
 957      if isindiag(pl.col,pl.haut,quel) then\r
 958             \r
 959              if (adver(3).rangee(pl.line,quel).nbre_boule=3) and\r
 960                  (adver(3).rangee(pl.line,quel).possible) then \r
 961                                 find:=find_place(3,quel,pl.line,pl.haut,place);\r
 962                                 fi;\r
 963      fi;     \r
 964      if isindiag(pl.line,pl.haut,quel) then\r
 965          \r
 966              if (adver(4).rangee(pl.col,quel).nbre_boule=3) and\r
 967                   (adver(4).rangee(pl.col,quel).possible) then\r
 968                                 find:=find_place(4,quel,pl.col,pl.haut,place);\r
 969                                 fi;\r
 970                                \r
 971      fi;    \r
 972      if isinbigdiag(pl.line,pl.col,quel) then\r
 973              if (adver(6).rangee(pl.haut,quel).nbre_boule=3) and\r
 974                  (adver(6).rangee(pl.haut,quel).possible) then                 \r
 975                      find:=find_place(6,quel,pl.line,pl.haut,place);\r
 976              fi;\r
 977      fi;\r
 978      if isintwodiag(pl.line,pl.col,pl.haut,quel,version) then\r
 979              if (adver(7).rangee(quel,version).nbre_boule=3) and\r
 980                  (adver(7).rangee(quel,version).possible) then\r
 981                     find:=find_place(7,0,quel,version,place);\r
 982              fi;\r
 983      fi;\r
 984      fi;\r
 985 \r
 986   fi;\r
 987      (******************************************)\r
 988      (* jouer les coins du niveau 1 en premier *)\r
 989      (******************************************)\r
 990       \r
 991       \r
 992       IF not find then \r
 993          \r
 994      \r
 995                               (*********************)\r
 996                               (* quel coup jouer ? *)\r
 997                               (*********************)\r
 998            call stratego; (* evaluation de toutes les combinaisons*)\r
 999            call selectcoup(place); (* choisi un coup a jouer *)\r
1000        \r
1001       FI;\r
1002      \r
1003      (*****************************************)\r
1004      (*  on incremente le nombre de boules... *)\r
1005      (*****************************************)\r
1006      call addcombinaison(moi,place.x,place.y,place.h);\r
1007      call delcombinaison(adver,place.x,place.y,place.h);\r
1008      posajouer(place.x,place.y):=posajouer(place.x,place.y)+1;\r
1009 \r
1010       \r
1011       \r
1012       if pl.enfiler(place.x,place.y,couleur) then \r
1013          call pl.arrow.ligne(place.x,blanc);\r
1014          call pl.arrow.colonne(place.y,blanc);\r
1015       fi;\r
1016       \r
1017       \r
1018       detach;\r
1019     od;\r
1020 end;\r
1021 \r
1022 UNIT humain:player COROUTINE;\r
1023   var i,j:integer;\r
1024   begin\r
1025    i,j:=1;\r
1026    return;\r
1027    do\r
1028    \r
1029    do\r
1030    \r
1031    call pl.arrow.selectaxe(i,j);\r
1032    if pl.enfiler(i,j,couleur) then exit; fi;\r
1033    od;\r
1034    detach;\r
1035    od;\r
1036    \r
1037  end;\r
1038        \r
1039 UNIT joueurs:class;\r
1040 var couleur:integer,\r
1041     joueur:player,\r
1042     nom:arrayof char;\r
1043 begin\r
1044 array nom dim(1:8);\r
1045 end;\r
1046 \r
1047 \r
1048 UNIT controle:iiuwgraph coroutine(equipe:arrayof joueurs,pl:Plateau_Jeu);\r
1049 var tour:integer,\r
1050      aux: arrayof arrayof arrayof integer,\r
1051      difference: pile,\r
1052      pion:elem;\r
1053 \r
1054 \r
1055  UNIT AquiLeTour:procedure;\r
1056   begin\r
1057     tour:=tour+1;\r
1058     if tour=3 then tour:=1; fi;\r
1059   end;\r
1060 \r
1061  UNIT copie_jeu:procedure;\r
1062  var k:integer;\r
1063  begin\r
1064     for k:=1 to 4          \r
1065      do\r
1066        aux(pl.line,pl.col,k):=pl.jeu(pl.line,pl.col,k);\r
1067      od;\r
1068  end;\r
1069  \r
1070  UNIT coup:function:boolean;\r
1071  var i,j,k,n,c:integer;\r
1072     \r
1073  begin\r
1074    call pl.arrow.ligne(pl.line,0);\r
1075    call pl.arrow.colonne(pl.col,0);\r
1076 \r
1077    n:=0;\r
1078    for i:=1 to 4\r
1079     do\r
1080      for j:=1 to 4\r
1081      do\r
1082        for k:=1 to 4\r
1083         do\r
1084          if (pl.jeu(i,j,k)<>aux(i,j,k)) then\r
1085 \r
1086              n:=n+1;            \r
1087              pion:=new elem(i,j,k);\r
1088              call difference.empiler(pion);\r
1089          fi;    \r
1090         od; \r
1091      od;   \r
1092    od;  \r
1093                  \r
1094    if n>1 or n=0 then result:=false;\r
1095    else  \r
1096 \r
1097          pion:=difference.sommet;\r
1098          if pl.jeu(pion.i,pion.j,pion.k)=equipe(tour).couleur then \r
1099               result:=true;\r
1100               pl.line:=pion.i;pl.col:=pion.j;pl.haut:=pion.k;\r
1101               call pl.arrow.ligne(pl.line,blanc);\r
1102               call pl.arrow.colonne(pl.col,blanc);\r
1103 \r
1104          else result:=false;\r
1105          fi;\r
1106         \r
1107    fi;\r
1108  end;\r
1109 \r
1110 unit alignee_ligne:function(couleur:integer):integer;\r
1111 var a,n:integer;\r
1112 begin\r
1113   n:=0;\r
1114   for a:=1 to 4\r
1115    do\r
1116 \r
1117      if pl.jeu(a,pion.j,pion.k)=couleur then n:=n+1; fi;\r
1118    od;\r
1119   result:=n;\r
1120 end;\r
1121 \r
1122 unit colhaut:function(couleur:integer):integer;\r
1123 var a,n:integer;\r
1124 begin\r
1125   n:=0;\r
1126   for a:=1 to 4\r
1127    do\r
1128 \r
1129      if pl.jeu(pion.i,pion.j,a)=couleur then n:=n+1; fi;\r
1130    od;\r
1131   result:=n;\r
1132 end;\r
1133 \r
1134 \r
1135 unit alignee_colonne:function(couleur:integer):integer;\r
1136 var j,n:integer;\r
1137 begin\r
1138   n:=0;\r
1139   for j:=1 to 4\r
1140    do\r
1141      if pl.jeu(pion.i,j,pion.k)=couleur then n:=n+1; fi;\r
1142    od;\r
1143   result:=n;\r
1144 end;\r
1145 \r
1146 unit diag_colonne:function(dir,couleur:integer):integer;\r
1147 var k,i,n:integer;\r
1148 begin\r
1149 \r
1150   n:=0;i:=1;\r
1151   if dir=-1 then k:=4;\r
1152   else k:=1;\r
1153   fi;\r
1154   for i:=1 to 4\r
1155    do\r
1156      if pl.jeu(i,pion.j,k)=couleur then n:=n+1; fi;\r
1157      k:=k+(1*dir);\r
1158    od;\r
1159   result:=n;\r
1160 end;\r
1161 \r
1162 unit diagonnale: function(quel,couleur:integer):integer;\r
1163 var n,j,i:integer;\r
1164 \r
1165 begin\r
1166   n:=0;\r
1167   if quel=11 then \r
1168      j:=1;\r
1169      for i:=1 to 4\r
1170       do\r
1171         if pl.jeu(i,j,pion.k)=couleur then n:=n+1; fi;\r
1172         j:=j+1;\r
1173       od;\r
1174   else \r
1175       j:=1;\r
1176       for i:=4 downto 1\r
1177         do\r
1178           if pl.jeu(i,j,pion.k)=couleur then n:=n+1; fi;\r
1179           j:=j+1;\r
1180         od;\r
1181   fi;\r
1182   result :=n;\r
1183 \r
1184 end;\r
1185   \r
1186 unit doublediagonnale: function(quel,dir,couleur:integer):integer;\r
1187 var n,i,j,k:integer;\r
1188 \r
1189 begin\r
1190   \r
1191   n:=0;i:=1;\r
1192   if dir=-1 then k:=4;\r
1193   else k:=1;\r
1194   fi;\r
1195   \r
1196   if quel=11 then \r
1197          j:=1;\r
1198      for i:=1 to 4\r
1199       do\r
1200         if pl.jeu(i,j,k)=couleur then n:=n+1; fi;\r
1201         j:=j+1;k:=k+(1*dir);\r
1202       od;\r
1203   else \r
1204       j:=1;\r
1205       for i:=4 downto 1\r
1206         do\r
1207           if pl.jeu(i,j,k)=couleur then n:=n+1; fi;\r
1208           j:=j+1; k:=k+(1*dir);\r
1209         od;\r
1210   fi;\r
1211   result :=n;\r
1212 \r
1213 end;\r
1214   \r
1215    \r
1216 unit diag_ligne:function(dir,couleur:integer):integer;\r
1217 var k,j,n:integer;\r
1218 begin\r
1219 \r
1220   n:=0;j:=1;\r
1221   if dir=-1 then k:=4;\r
1222   else k:=1;\r
1223   fi;\r
1224   for j:=1 to 4\r
1225    do\r
1226      if pl.jeu(pion.i,j,k)=couleur then n:=n+1; fi;\r
1227      k:=k+(1*dir);\r
1228    od;\r
1229   result:=n;\r
1230 end;\r
1231             \r
1232 \r
1233 UNIT gagne:function:boolean;\r
1234 const droite=-1,gauche=1;\r
1235 var rangee:boolean;\r
1236    \r
1237 \r
1238  begin\r
1239    pion:=difference.sommet;      \r
1240    rangee:=false;\r
1241    if alignee_ligne(equipe(tour).couleur)=4 then rangee:=true; fi;\r
1242    if alignee_colonne(equipe(tour).couleur)=4 then rangee:=true;  fi;\r
1243    if diag_colonne(droite,equipe(tour).couleur)=4 then rangee:= true;fi;\r
1244    if diag_colonne(gauche,equipe(tour).couleur)=4 then rangee:=true; fi;\r
1245    if diag_ligne(droite,equipe(tour).couleur)=4 then rangee:= true; fi;\r
1246    if diag_ligne(gauche,equipe(tour).couleur)=4 then rangee:= true; fi;\r
1247    \r
1248    if colhaut(equipe(tour).couleur)=4 then rangee:=true; fi;\r
1249 \r
1250    if diagonnale(11,equipe(tour).couleur)=4 then rangee:=true; fi;\r
1251    if doublediagonnale(11,droite,equipe(tour).couleur)=4 then rangee:=true;fi;\r
1252    if doublediagonnale(11,gauche,equipe(tour).couleur)=4 then rangee:=true; fi;\r
1253    if diagonnale(41,equipe(tour).couleur)=4 then rangee:=true; fi;\r
1254    if doublediagonnale(41,droite,equipe(tour).couleur)=4 then rangee:=true; fi;\r
1255    if doublediagonnale(41,gauche,equipe(tour).couleur)=4 then rangee:=true; fi;\r
1256 \r
1257    result:=rangee;\r
1258     call difference.depiler;  (* pile est maintenant vide *)\r
1259  end;\r
1260 \r
1261 \r
1262 \r
1263 \r
1264 UNIT restore:procedure;\r
1265    begin\r
1266      while (not (difference.vide)) do\r
1267        pion:=difference.sommet;\r
1268        pl.jeu(pion.i,pion.j,pion.k):=aux(pion.i,pion.j,pion.k);\r
1269        call pl.boulle(pion.i,pion.j,pion.k,aux(pion.i,pion.j,pion.k));\r
1270        call difference.depiler;\r
1271      od;\r
1272    end;\r
1273      \r
1274 UNIT nom_joueur: gestion_caractere procedure(nom:arrayof char,couleur:integer);\r
1275    var i,j:integer;\r
1276    begin\r
1277      call dialog1;\r
1278      call color(couleur);\r
1279      for i:=1 to 20\r
1280       do \r
1281        call move(430,240+i);\r
1282        call draw(450,240+i);\r
1283       od; \r
1284      call displaystring(nom,460,245,blanc);\r
1285    end;  \r
1286 \r
1287 begin\r
1288     block\r
1289       var i,j,k:integer;\r
1290     begin  \r
1291       array aux dim(1:4);\r
1292 \r
1293       for i:=1 to 4\r
1294        do\r
1295         array aux(i) dim(1:4);\r
1296         for j:=1 to 4\r
1297          do\r
1298           array aux(i,j) dim (1:4);\r
1299          od;\r
1300        od;\r
1301     \r
1302       \r
1303       \r
1304       for i:=1 to 4\r
1305        do\r
1306        for j:=1 to 4\r
1307         do\r
1308         for k:=1 to 4\r
1309         do\r
1310           aux(i,j,k):=-1;\r
1311         od;\r
1312        od;\r
1313       od;\r
1314       \r
1315     end;\r
1316 \r
1317     difference:=new pile;\r
1318     call pl.initialisation;\r
1319     tour:=0;\r
1320     return;\r
1321     \r
1322     do\r
1323       call AquiLeTour;\r
1324      do\r
1325         call nom_joueur(equipe(tour).nom,equipe(tour).couleur);\r
1326         if equipe(tour).joueur is humain then    \r
1327            call move(450,300);\r
1328            call outstring("A VOTRE TOUR !"); fi;\r
1329         attach(equipe(tour).joueur);\r
1330         call color(0);\r
1331         call move(450,300);\r
1332         call outstring("              ");\r
1333         if coup then exit; \r
1334         else call restore; fi;\r
1335      od;\r
1336       if gagne then attach(main);\r
1337       else   call copie_jeu; fi;\r
1338     od;  \r
1339 END;    \r
1340 \r
1341 UNIT pause: IIUWGRAPH procedure(t:string,x,y,couleur:integer);\r
1342 var c:integer;\r
1343 begin\r
1344   call move(x,y);\r
1345   call color(couleur);\r
1346   call outstring(t);\r
1347   c:=inkey;\r
1348   do\r
1349    if c<>0 then exit; fi;\r
1350    c:=inkey;\r
1351   od;\r
1352 end;\r
1353 \r
1354 \r
1355 UNIT Plateau_Jeu: IIUWGRAPH class;\r
1356 \r
1357  VAR grille:arrayof arrayof coord2D,\r
1358      line,col,haut:integer,\r
1359      jeu: arrayof arrayof arrayof integer;\r
1360 \r
1361  UNIT cadre: procedure;\r
1362   begin \r
1363    \r
1364     call move(179,321);\r
1365     call draw(392,250);\r
1366     call draw(282,140);\r
1367     call draw(69,211);\r
1368     call draw(179,321);\r
1369 \r
1370   end;\r
1371 \r
1372 \r
1373   UNIT ombre: procedure(cx,cy,cxx,cyy,fill_color:integer);\r
1374    var x,y,xx,yy,i:integer;\r
1375    begin\r
1376     call move(cx,cy);\r
1377     call draw(cxx,cyy);\r
1378     xx:=cxx;\r
1379     yy:=cyy;\r
1380     x:=cx;\r
1381     y:=cy;\r
1382     for i:=1 to 109\r
1383      do \r
1384       x:=x+1;\r
1385       y:=y+1;\r
1386       xx:=xx+1;\r
1387       yy:=yy+1;\r
1388       call move(x,y);\r
1389       call draw(xx,yy);\r
1390      od;\r
1391    end;\r
1392    \r
1393  UNIT enlever:procedure(a,b:integer);\r
1394  var niveau:integer,\r
1395      occupe:boolean;\r
1396  begin\r
1397   niveau:=4;\r
1398   occupe:=false;\r
1399   while not occupe do\r
1400     occupe:=(jeu(a,b,niveau)<>free);\r
1401     if not occupe then\r
1402        niveau:=niveau-1;\r
1403     fi;\r
1404   od;\r
1405   jeu(a,b,niveau):=free;\r
1406  end;\r
1407  \r
1408  UNIT enfiler:function(a,b,couleur:integer):boolean;\r
1409  var niveau,c:integer,\r
1410      libre:boolean;\r
1411  begin\r
1412    niveau:=5;\r
1413    libre:=true;\r
1414    while libre do\r
1415      niveau:=niveau-1;\r
1416      if niveau<>0 then \r
1417      libre:= (jeu(a,b,niveau)=-1);\r
1418      else libre:=false;\r
1419      fi;\r
1420    od;\r
1421    \r
1422    niveau:=niveau+1;\r
1423    if niveau=5 then result:=false;\r
1424    else\r
1425    jeu(a,b,niveau):=couleur;\r
1426    call boulle(grille(b,a).x,grille(b,a).y,niveau,couleur);\r
1427    result:=true;\r
1428    fi;\r
1429  end;\r
1430 \r
1431 \r
1432    UNIT boulle:procedure(x,y,h,couleur:integer);\r
1433    \r
1434    begin\r
1435      call color(couleur);\r
1436      call move(x,y-(26*(h-1)));\r
1437      call draw(x,y-(26*(h-1))-26);\r
1438      call move(x+1,y-(26*(h-1))-1);\r
1439      call draw(x+1,y-(26*(h-1))-26);\r
1440      call move(x-1,y-(26*(h-1))-1);\r
1441      call draw(x-1,y-(26*(h-1))-26);\r
1442      call move(x+1,y-(26*(h-1))+1);\r
1443      call draw(x+1,y-(26*(h-1))-26);\r
1444    end;\r
1445      \r
1446    \r
1447    UNIT axe: procedure(x,y:integer);\r
1448    begin\r
1449      call move(x+1,y-1);\r
1450      call draw(x+1,y-108);\r
1451      call move(x,y);\r
1452      call draw(x,y-108);\r
1453      call move(x-1,y-1);\r
1454      call draw(x-1,y-108);\r
1455      call move(x+1,y+1);\r
1456      call draw(x+1,y-108);\r
1457    end;   \r
1458    \r
1459    UNIT plan: procedure(x,y,i:integer);\r
1460    var xx,yy:integer;\r
1461    begin\r
1462      xx:=x;\r
1463      yy:=y;\r
1464      call axe(xx,yy);\r
1465      grille(i,1):=new coord2D(xx,yy);\r
1466      xx:=xx-42;\r
1467      yy:=yy-42;\r
1468      call axe(xx,yy);\r
1469      grille(i,2):=new coord2D(xx,yy);\r
1470 \r
1471      call move(xx,yy);\r
1472      call draw(136,278);\r
1473  \r
1474      xx:=xx-26;\r
1475      yy:=yy-26;\r
1476      call axe(xx,yy);\r
1477      grille(i,3):=new coord2D(xx,yy);\r
1478      call move(xx,yy);\r
1479      call draw(110,252);\r
1480 \r
1481      xx:=xx-41;\r
1482      yy:=yy-41;\r
1483      call axe(xx,yy);\r
1484      grille(i,4):=new coord2D(xx,yy);\r
1485      call move(xx,yy);\r
1486      call draw(x,y);\r
1487 \r
1488   end;\r
1489 \r
1490   \r
1491   unit rangee: procedure;\r
1492 \r
1493   begin\r
1494    call plan(round(213*0.38)+178,round(-71*0.38)+320,2);\r
1495    call plan(round(213*0.65)+178,round(-71*0.65)+320,3);\r
1496    call plan(213+178,-71+320,4);\r
1497   end;\r
1498   \r
1499    \r
1500    UNIT initialisation:procedure;\r
1501     var i,j,k:integer;\r
1502     begin\r
1503       for i:=1 to 4\r
1504        do\r
1505        for j:=1 to 4\r
1506         do\r
1507         for k:=1 to 4\r
1508         do\r
1509           jeu(i,j,k):=-1;\r
1510         od;\r
1511        od;\r
1512       od;\r
1513       for i:=1 to 4\r
1514        do\r
1515         for j:=1 to 4\r
1516          do\r
1517           call boulle(grille(i,j).x,grille(i,j).y,3,blanc);\r
1518           call boulle(grille(i,j).x,grille(i,j).y,1,blanc);\r
1519           call boulle(grille(i,j).x,grille(i,j).y,4,blanc);\r
1520           call boulle(grille(i,j).x,grille(i,j).y,2,blanc);\r
1521 \r
1522          od;\r
1523        od;\r
1524       \r
1525    end;\r
1526 \r
1527   \r
1528   UNIT fleche: class;\r
1529     \r
1530     var \r
1531         tab_coord:arrayof arrayof coord2D;\r
1532 \r
1533     unit ligne:procedure(i,couleur:integer);\r
1534      \r
1535      var y1:integer;\r
1536      \r
1537      begin\r
1538      call color(couleur);\r
1539      \r
1540      y1:=(-(tab_coord(1,i).x-20)+tab_coord(1,i).x+3*tab_coord(1,i).y)div 3;\r
1541      call move(tab_coord(1,i).x,tab_coord(1,i).y);\r
1542      call draw(tab_coord(1,i).x-20,y1);\r
1543      \r
1544      y1:=(-(tab_coord(1,i).x-5)+tab_coord(1,i).x+3*tab_coord(1,i).y)div 3;\r
1545      call move(tab_coord(1,i).x-5-3,y1-3);\r
1546      call draw(tab_coord(1,i).x,tab_coord(1,i).y);\r
1547      \r
1548      call move(tab_coord(1,i).x,tab_coord(1,i).y+5);\r
1549      call draw(tab_coord(1,i).x,tab_coord(1,i).y);\r
1550     end;  \r
1551     \r
1552     unit colonne:procedure(i,couleur:integer); \r
1553     \r
1554       begin\r
1555      call color(couleur);\r
1556      call move(tab_coord(2,i).x,tab_coord(2,i).y);\r
1557      call draw(tab_coord(2,i).x+15,tab_coord(2,i).y+15);\r
1558      \r
1559      call move(tab_coord(2,i).x,tab_coord(2,i).y);\r
1560      call draw(tab_coord(2,i).x+5,tab_coord(2,i).y);\r
1561      \r
1562      call move(tab_coord(2,i).x,tab_coord(2,i).y);\r
1563      call draw(tab_coord(2,i).x,tab_coord(2,i).y+5);\r
1564       \r
1565       end;\r
1566    \r
1567    \r
1568    UNIT SelectAxe:procedure(inout i,j:integer);\r
1569    const droite=-77,gauche=-75,hauts=-72,bas=-80,retour=13;\r
1570    var key:integer;\r
1571    begin\r
1572     call drawrect(0,0,413,349,rouge);\r
1573     call ligne(line,15);\r
1574     call colonne(col,15); \r
1575     do\r
1576       do\r
1577         key:=inkey;\r
1578          if key<>0 then exit; fi; \r
1579       od;\r
1580       \r
1581       case key\r
1582          when hauts : call ligne(line,0);\r
1583                     if line+1<=4 then\r
1584                         line:=line+1;fi;\r
1585                    call ligne(line,15);\r
1586          when bas : call ligne(line,0);\r
1587                    if line-1>=1 then\r
1588                    line:=line-1; fi;\r
1589                    call ligne(line,15);\r
1590          when gauche : call colonne(col,0);\r
1591                    if col-1>=1 then\r
1592                    col:=col-1; fi;\r
1593                    call colonne(col,15);\r
1594          when droite : call colonne(col,0);\r
1595                    if col+1<=4 then\r
1596                    col:=col+1; fi;\r
1597                    call colonne(col,15);\r
1598          when retour : i:=line;\r
1599                    j:=col;\r
1600                    exit;\r
1601      esac;    \r
1602     od; \r
1603     call ligne(line,0);\r
1604     call colonne(col,0);\r
1605   call drawrect(0,0,413,349,blanc);\r
1606  end;\r
1607 \r
1608 \r
1609     begin\r
1610      array tab_coord dim(1:2);\r
1611      for line:=2 downto 1\r
1612         do \r
1613          array tab_coord(line) dim(1:4);\r
1614         od;\r
1615      line:=line+1;\r
1616      tab_coord(1,4):=new coord2D(53,219);\r
1617      tab_coord(1,3):=new coord2D(92,258);\r
1618      tab_coord(1,2):=new coord2D(116,282);\r
1619      tab_coord(1,1):=new coord2D(160,326);\r
1620      tab_coord(2,1):=new coord2D(190,332);\r
1621      tab_coord(2,2):=new coord2D(271,305);\r
1622      tab_coord(2,3):=new coord2D(328,286);\r
1623      tab_coord(2,4):=new coord2D(398,256);\r
1624 \r
1625    end;  \r
1626 \r
1627 \r
1628  var arrow:fleche;\r
1629 \r
1630 BEGIN\r
1631  block\r
1632   var i,j:integer;\r
1633   begin\r
1634 call gron(1);\r
1635 \r
1636 array grille dim(1:4);\r
1637 \r
1638 for i:=1 to 4\r
1639   do\r
1640   array grille(i) dim(1:4);\r
1641   od;\r
1642 \r
1643 array jeu dim(1:4);\r
1644 \r
1645 for i:=1 to 4\r
1646   do\r
1647   array jeu(i) dim(1:4);\r
1648   for j:=1 to 4\r
1649   do\r
1650    array jeu(i,j) dim (1:4);\r
1651   od;\r
1652   od;\r
1653 \r
1654 \r
1655 call color(grisfonce);\r
1656 call ombre(69,223,282,152,4);\r
1657 call color(grisclair);\r
1658 call ombre(69,211,282,140,0);\r
1659 \r
1660 call color(blanc);\r
1661 call plan(178,320,1);\r
1662 call rangee;\r
1663 call cadre;\r
1664 call move(440,10);\r
1665 call outstring("PUISSANCE 4 CHINOIS");\r
1666 \r
1667 call drawrect(418,220,620,349,blanc);\r
1668 call drawrect(0,0,413,349,blanc);\r
1669 line,col:=2;\r
1670 haut:=0;\r
1671 arrow:= new fleche;\r
1672 end;\r
1673 END; (* fin Plateau_Jeu *)\r
1674 \r
1675 UNIT menu: gestion_caractere function:integer;\r
1676 var choix:integer;\r
1677 begin\r
1678     call dialog2;\r
1679     call drawrect(418,220,620,349,blanc);\r
1680     call drawrect(418,50,620,200,rouge);\r
1681     call color(blanc);\r
1682     call move(480,60);\r
1683     call outstring(" OPTIONS ");\r
1684     call move(420,80);\r
1685     call outstring("[1] Un joueur");\r
1686     call move(420,100);\r
1687     call outstring("[2] Deux joueurs");\r
1688     call move(420,120);\r
1689     call outstring("[0] Quitter");\r
1690     call move(470,180);\r
1691     call outstring("Votre choix :");\r
1692     do\r
1693      choix:=ConvENT(saisie(1,1,570,180));\r
1694      if choix>=0 and choix<=2 then  exit; fi;\r
1695     od;\r
1696    result:=choix;\r
1697    call drawrect(418,50,620,200,blanc);\r
1698    call drawrect(418,220,620,349,rouge);\r
1699 end;\r
1700 UNIT withwho: gestion_caractere function:integer;\r
1701 var choix:integer;\r
1702 begin\r
1703     call dialog2;\r
1704     call drawrect(418,220,620,349,blanc);\r
1705     call drawrect(418,50,620,200,rouge);\r
1706     call color(blanc);\r
1707     call move(480,60);\r
1708     call outstring(" OPTIONS ");\r
1709     call move(420,80);\r
1710     call outstring("[1] Ordinateur");\r
1711     call move(440,90);\r
1712     call outstring(" contre Vous");\r
1713     call move(420,110);\r
1714     call outstring("[2] Ordinateur");\r
1715     call move(440,120);\r
1716     call outstring(" contre Ordinateur");\r
1717 \r
1718     call move(420,140);\r
1719     call outstring("[0] Retour");\r
1720     call move(470,180);\r
1721     call outstring("Votre choix :");\r
1722     do\r
1723      choix:=ConvENT(saisie(1,1,570,180));\r
1724      if choix>=0 and choix<=2 then  exit; fi;\r
1725     od;\r
1726    result:=choix;\r
1727    call drawrect(418,50,620,200,blanc);\r
1728    call drawrect(418,220,620,349,rouge);\r
1729 end;\r
1730 \r
1731 UNIT dialog1:iiuwgraph procedure;\r
1732 var i:integer;\r
1733 begin\r
1734    call color(0);\r
1735    for i:=1 to 108\r
1736      do\r
1737        call move(419,220+i);\r
1738        call draw(619,220+i);\r
1739      od;\r
1740   \r
1741 end;\r
1742 UNIT dialog2:iiuwgraph procedure;\r
1743 var i:integer;\r
1744 begin\r
1745    call color(0);\r
1746    for i:=1 to 148\r
1747      do\r
1748        call move(419,51+i);\r
1749        call draw(619,51+i);\r
1750      od;\r
1751   \r
1752 end;\r
1753 \r
1754 UNIT name:gestion_caractere function(i:integer):arrayof char;\r
1755 begin\r
1756    \r
1757    call dialog1;\r
1758    call drawrect(418,220,620,349,rouge);\r
1759    call color(blanc);\r
1760    call move(420,230);\r
1761    if i=1 then\r
1762    call outstring("Nom du joueur 1:");\r
1763    else  call outstring("Nom du joueur 2:");\r
1764    fi;\r
1765    result:=saisie(2,8,430,250);\r
1766    call drawrect(418,220,620,349,blanc);\r
1767 end;\r
1768 \r
1769 UNIT whostart:gestion_caractere function:integer;\r
1770 var i,c,a:integer;\r
1771 begin\r
1772      call dialog1;\r
1773      call drawrect(418,220,620,349,rouge);\r
1774      call color(blanc);\r
1775      call move(420,230);\r
1776      call outstring("    Voulez-vous que"); \r
1777      call move(420,240);\r
1778      call outstring("je commence la partie ?");\r
1779      i:=1;\r
1780      call move(440,260);\r
1781      call color(grisfonce);\r
1782      call outstring("NON");\r
1783      call move(540,260);\r
1784      call color(grisclair);\r
1785      call outstring("OUI");\r
1786      \r
1787      c:=inkey;\r
1788      while c<>13 do\r
1789        if c<>0 then\r
1790          i:=i+1;\r
1791          if i>2 then i:=1; fi;\r
1792 \r
1793         case i\r
1794          when 1:call move(440,260);\r
1795                 call color(grisfonce);\r
1796                 call outstring("NON");\r
1797                 call move(540,260);\r
1798                 call color(grisclair);\r
1799                 call outstring("OUI");\r
1800          when 2:call move(440,260);\r
1801                 call color(grisclair);\r
1802                 call outstring("NON");\r
1803                 call move(540,260);\r
1804                 call color(grisfonce);\r
1805                 call outstring("OUI");\r
1806         esac;  \r
1807        fi; \r
1808      c:=inkey; \r
1809      od;\r
1810      result:=i;\r
1811 end;\r
1812 \r
1813 unit thegame: gestion_caractere procedure;\r
1814 var a:integer;\r
1815 begin\r
1816           call dialog2;\r
1817           call displaystring(team(1).nom,430,90,bleuroi);\r
1818           call move(490,120);\r
1819           call color(blanc);\r
1820           call outstring("contre");\r
1821           call displaystring(team(2).nom,530,150,bleuroi);\r
1822 end;\r
1823 \r
1824 \r
1825 UNIT quelcouleur:gestion_caractere function(t:arrayof char):integer;\r
1826 const droite=-77,gauche=-75;\r
1827 var i,c,a:integer;\r
1828 begin\r
1829      call dialog1;\r
1830      call drawrect(418,220,620,349,rouge);\r
1831      call displaystring(t,420,230,blanc);\r
1832 \r
1833      call move(440,250);\r
1834      call outstring("Boule:");  \r
1835      c:=inkey;\r
1836      i:=1;a:=2;\r
1837      if i=boule then\r
1838             i:=i+1; \r
1839             a:=a+1 fi;\r
1840 \r
1841      call move(500,250);\r
1842      call color(i);\r
1843      call outstring("<Couleur>");\r
1844      call displaystring(unpack("->:couleur suivante"),420,310,grisfonce);\r
1845      call displaystring(unpack("<-:couleur pr\82c\82dente"),420,320,grisfonce);\r
1846      while c<>13  do\r
1847      if c<>0 then \r
1848         case c\r
1849           when droite:\r
1850                     i:=i+1;\r
1851                     if i>14 then i:=1; fi;\r
1852                     if i=boule then\r
1853                     i:=i+1; fi;\r
1854                     if i>14 then i:=1; fi;\r
1855           when gauche:\r
1856                    i:=i-1;\r
1857                    if i<1 then i:=14; fi;\r
1858                    if i=boule then i:=i-1;fi;\r
1859                    if i<1 then i:=14; fi;\r
1860        esac;            \r
1861         \r
1862      fi;\r
1863      if i<>a then\r
1864      a:=i;\r
1865      call move(500,250);\r
1866      call color(i);\r
1867      call outstring("<Couleur>");\r
1868      fi;\r
1869      c:=inkey;\r
1870      od;\r
1871      result:=i;\r
1872      call drawrect(418,220,620,349,blanc);\r
1873 end;\r
1874 \r
1875 signal quitter,gagner;\r
1876 VAR plateau:plateau_jeu,\r
1877     team: arrayof joueurs,\r
1878     c,i,j,boule:integer,\r
1879     partie:boolean,\r
1880     arbitre:controle;\r
1881 \r
1882 handlers\r
1883  when quitter:\r
1884        pref iiuwgraph block\r
1885        begin\r
1886        kill(arbitre);\r
1887        kill(team(1).joueur);\r
1888        kill(team(2).joueur);\r
1889        kill(team(1));\r
1890        kill(team(2));\r
1891        call groff;\r
1892        end;\r
1893        wind;\r
1894  when gagner:\r
1895           pref iiuwgraph block\r
1896           begin\r
1897           kill(team(1).joueur);\r
1898           kill(team(2).joueur);\r
1899           kill(arbitre);\r
1900           call color(0);\r
1901           call move(450,270);\r
1902           call outstring("          ");\r
1903 \r
1904           call color(rouge);\r
1905           call move(500,270);\r
1906           call outstring(" A GAGNE !");\r
1907           end;\r
1908           return;\r
1909      \r
1910 \r
1911 end;\r
1912 \r
1913 \r
1914 BEGIN\r
1915 plateau:=new plateau_jeu;\r
1916 array team dim(1:2);\r
1917 \r
1918  team(1):=new joueurs;\r
1919  team(2):=new joueurs;\r
1920 pref gestion_caractere block \r
1921 \r
1922 begin\r
1923 do\r
1924  boule:=0;\r
1925  partie:=false;\r
1926  case menu\r
1927    when 2:team(1).nom:=name(1); \r
1928           team(1).couleur:=quelcouleur(team(1).nom);\r
1929           boule:=team(1).couleur;\r
1930           team(1).joueur:=new humain(team(1).couleur,plateau);\r
1931           team(2).nom:=name(2);\r
1932           team(2).couleur:=quelcouleur(team(2).nom);\r
1933           team(2).joueur:=new humain(team(2).couleur,plateau);\r
1934           partie:=true;\r
1935           \r
1936    when 1: \r
1937           case withwho\r
1938              when 1:\r
1939               case whostart \r
1940                 when 2:team(1).nom:=name(1); \r
1941                        team(1).couleur:=quelcouleur(team(1).nom);\r
1942                        boule:=team(1).couleur;\r
1943                        team(1).joueur:=new humain(team(1).couleur,plateau);\r
1944                        team(2).nom:=unpack("COMPUTER");\r
1945                        team(2).couleur:=quelcouleur(team(2).nom);\r
1946                        team(2).joueur:=new ordi(team(2).couleur,plateau);\r
1947                        partie:=true;\r
1948 \r
1949                 when 1:team(2).nom:=name(2); \r
1950                        team(2).couleur:=quelcouleur(team(2).nom);\r
1951                        boule:=team(2).couleur;\r
1952                        team(2).joueur:=new humain(team(2).couleur,plateau);\r
1953                        team(1).nom:=unpack("COMPUTER");\r
1954                        team(1).couleur:=quelcouleur(team(1).nom);\r
1955                        team(1).joueur:=new ordi(team(1).couleur,plateau);\r
1956                        partie:=true;\r
1957 \r
1958               esac;\r
1959             when 2:team(1).nom:=unpack("Computer1"); \r
1960                        team(1).couleur:=quelcouleur(team(1).nom);\r
1961                        boule:=team(1).couleur;\r
1962                        team(1).joueur:=new ordi(team(1).couleur,plateau);\r
1963                        team(2).nom:=unpack("Computer2");\r
1964                        team(2).couleur:=quelcouleur(team(2).nom);\r
1965                        team(2).joueur:=new ordi(team(2).couleur,plateau);\r
1966                        partie:=true;\r
1967             esac;\r
1968    when 0: raise quitter;\r
1969    \r
1970    \r
1971  esac;\r
1972  if partie then \r
1973  call thegame;\r
1974  arbitre:=new controle(team,plateau);\r
1975  attach(arbitre);\r
1976  raise gagner;\r
1977  kill(arbitre);\r
1978  fi;\r
1979  od;\r
1980  \r
1981 end;\r
1982 \r
1983 END;\r