examples/jeu/alumet.log

   1 \r
   2 PROGRAM p2;\r
   3 begin\r
   4 \r
   5  (* auteur: VERNAZOBRES Fr\82d\82ric 1992/1993 *)\r
   6  \r
   7 pref iiuwgraph block;\r
   8  \r
   9  \r
  10 (****************************************************************************)\r
  11 (*               Attente d'un caract\82re \85 lire au clavier                   *)\r
  12 (****************************************************************************)\r
  13  \r
  14   UNIT Readkey:FUNCTION:CHAR;\r
  15    VAR Car:CHAR;\r
  16   BEGIN\r
  17     Car:=CHR(0);\r
  18     WHILE (Car=CHR(0))\r
  19     DO\r
  20       CAR:=CHR(INKEY);\r
  21     OD;\r
  22     RESULT:=Car;\r
  23   END Readkey;\r
  24  \r
  25 (****************************************************************************)\r
  26 (*                      Affichage des allumettes                            *)\r
  27 (****************************************************************************)\r
  28  \r
  29   unit alumet:procedure(x,y:integer);\r
  30   begin\r
  31     call color(6);\r
  32     call move(160+y*20,50+x*50);\r
  33     call draw(163+y*20,50+x*50);\r
  34     call draw(163+y*20,20+x*50);\r
  35     call draw(160+y*20,20+x*50);\r
  36     call draw(160+y*20,50+x*50);\r
  37     call color(4);\r
  38     call cirb(161+y*20,20+x*50,3,10,10,4,2,3,2);\r
  39    end;\r
  40  \r
  41  \r
  42  \r
  43  \r
  44  \r
  45   UNIT dessin_all:procedure(x:integer);\r
  46    var i,j,k,s:integer;\r
  47   begin\r
  48     s:=x div 16;\r
  49     for j:=1 to s\r
  50      do\r
  51           for i:=0 to 14\r
  52            do\r
  53              call alumet(j,i);\r
  54            od;\r
  55      od;\r
  56     FOR i:=0 to ((x mod 16)+s-1)\r
  57     do\r
  58      call alumet(s+1,i);\r
  59     od\r
  60    end;\r
  61  \r
  62  \r
  63 (****************************************************************************)\r
  64 (*                          Effacement d'une allumette                       *)\r
  65 (****************************************************************************)\r
  66  \r
  67    unit feu:coroutine;\r
  68    var i,j,s,t,k,l:integer,c:char,y,z:real;\r
  69    begin\r
  70    return;\r
  71    do\r
  72     t:=nb;\r
  73     for i:=1 to x\r
  74      do\r
  75       s:=(t-1) div 15;\r
  76       if (s=0) then j:=t mod 16-1 else j:=t mod (15*s+1) fi;\r
  77       s:=s+1;\r
  78       for k:=0 to 28\r
  79       do\r
  80         call color(4);\r
  81         call cirb(161+j*20,20+s*50+k,3,10,10,2,2,2,2);\r
  82         call move(157+j*20,18+s*50+k);\r
  83         call color(2);\r
  84         call draw(162+j*20,11+s*50+k);\r
  85         call draw(165+j*20,18+s*50+k);\r
  86         for l:=1 to 300 do od;\r
  87         call color(0);\r
  88         call cirb(161+j*20,20+s*50+k,3,10,10,0,2,2,2);\r
  89         call move(157+j*20,18+s*50+k);\r
  90         call color(0);\r
  91         call draw(162+j*20,11+s*50+k);\r
  92         call draw(165+j*20,18+s*50+k);\r
  93       od;\r
  94       t:=t-1;\r
  95     od;\r
  96     detach;\r
  97     od;\r
  98    end feu;\r
  99  \r
 100  \r
 101  \r
 102 (****************************************************************************)\r
 103 (*     Strategie nø1 (l'ordinateur gagne si le nb d'allumettes =/= 4n+5)    *)\r
 104 (****************************************************************************)\r
 105  \r
 106  \r
 107    UNIT strategie1:coroutine;\r
 108    var g,l:integer,c:char,f:feu;\r
 109    begin\r
 110    return;\r
 111    do\r
 112     if (nb>=5)\r
 113      then\r
 114        x:=(nb-5) mod 4;\r
 115        if (x=0) then x:=1 fi;\r
 116      else\r
 117       x:=nb-1\r
 118      fi;\r
 119     call move(100,280);\r
 120     call color(2);\r
 121     c:=chr(48+x);\r
 122     if (rep=3) then call outstring(" strat\82gie 1:") fi;\r
 123     call outstring(" j'enl\8ave ");\r
 124     call hascii(48+x);\r
 125     call outstring(" allumette(s)");\r
 126     for l:=1 to 6800 do od;\r
 127     f:=new feu;\r
 128     attach(f);\r
 129     kill(f);\r
 130     call move(100,280);\r
 131     call outstring("                                            ");\r
 132     nb:=nb-x;\r
 133     detach;\r
 134     od;\r
 135    end;\r
 136  \r
 137  \r
 138 (****************************************************************************)\r
 139 (*                      Strategie Nø2 (arbre de jeu)                        *)\r
 140 (****************************************************************************)\r
 141  \r
 142  \r
 143  \r
 144   Unit noeud:class;\r
 145   var valeur:integer,\r
 146       gauche,centre,droit:noeud;\r
 147    end noeud;\r
 148  \r
 149  \r
 150  \r
 151  \r
 152   Unit arbre_jeu:procedure(nb:integer;inout pair:boolean;inout cpt:integer);\r
 153   var tree:noeud;\r
 154   begin\r
 155     tree:=new noeud;\r
 156     tree.valeur:=nb;\r
 157     if tree.valeur=1\r
 158      then\r
 159       if pair then cpt:=cpt-1 else cpt:=cpt+1 fi;\r
 160     fi;\r
 161     pair:=not pair;\r
 162     if nb>1 then call arbre_jeu(nb-1,pair,cpt) fi;\r
 163     if nb>2 then call arbre_jeu(nb-2,pair,cpt) fi;\r
 164     if nb>3 then call arbre_jeu(nb-3,pair,cpt) fi;\r
 165     kill (tree);\r
 166   end;\r
 167  \r
 168  \r
 169  \r
 170  \r
 171  \r
 172   Unit undeuxtrois:procedure(nb:integer;output choix:integer);\r
 173   var cptg,cptc,cptd:integer,\r
 174       pair:boolean;\r
 175   begin\r
 176    cptg:=0;\r
 177    cptc:=0;\r
 178    cptd:=0;\r
 179    pair:=true;\r
 180    if nb>1 then call arbre_jeu(nb-1,pair,cptg) fi;\r
 181    if nb>2 then call arbre_jeu(nb-2,pair,cptc) fi;\r
 182    if nb>3 then call arbre_jeu(nb-3,pair,cptd) fi;\r
 183    if ((cptg<=cptc) and (cptg<=cptd))\r
 184     then\r
 185        choix:=1\r
 186     else\r
 187        if ((cptc<=cptg) and (cptc<=cptd))\r
 188         then\r
 189           choix:=2\r
 190         else\r
 191           if ((cptd<=cptg) and (cptd<=cptc))\r
 192            then\r
 193              choix:=3\r
 194           fi;\r
 195         fi;\r
 196     fi;\r
 197    end;\r
 198  \r
 199  \r
 200  \r
 201  \r
 202  \r
 203   Unit strategie2:coroutine;\r
 204   var l:integer,f:feu;\r
 205   begin\r
 206     return;\r
 207     do\r
 208       call move(100,280);\r
 209       call outstring("   je reflechis !!!");\r
 210       call undeuxtrois(nb,x);\r
 211       call move(100,280);\r
 212       call outstring("                       ");\r
 213       call move(100,280);\r
 214       call color(2);\r
 215       if (rep=3) then call outstring(" strat\82gie 2:") fi;\r
 216       call outstring(" j'enl\8ave ");\r
 217       call hascii(48+x);\r
 218       call outstring(" allumette(s)");\r
 219       for l:=1 to 6800 do od;\r
 220       f:=new feu;\r
 221       attach(f);\r
 222       kill(f);\r
 223       call move(100,280);\r
 224       call outstring("                                            ");\r
 225       nb:=nb-x;\r
 226       detach;\r
 227    od;\r
 228   end;\r
 229  \r
 230  \r
 231  \r
 232  \r
 233  \r
 234  \r
 235  \r
 236  \r
 237  \r
 238 (****************************************************************************)\r
 239 (*                      programme principal                                 *)\r
 240 (****************************************************************************)\r
 241  \r
 242    var c,ch,car:char,x,rep,y,amoi,nb,g:integer,\r
 243        s1:strategie1,f:feu,s2:strategie2;\r
 244    begin\r
 245    do\r
 246  \r
 247  \r
 248     do\r
 249       write(chr(27),"[2J");\r
 250       writeln;\r
 251       writeln;\r
 252       writeln;\r
 253       writeln("1: Jouer contre l'ordinateur niveau facile");\r
 254       writeln("2: Jouer contre l'ordinateur niveau difficile ");\r
 255       writeln("3: Mode d\82monstration");\r
 256       writeln("4: Sortir");\r
 257       writeln;\r
 258       write("R\82ponse:");\r
 259       readln(rep);\r
 260       if (rep>0) and (rep<5) then exit fi;\r
 261     od;\r
 262  \r
 263  \r
 264  \r
 265     if (rep=4) then exit fi;\r
 266  \r
 267  \r
 268  \r
 269     do\r
 270       writeln;\r
 271       writeln;\r
 272       if (rep=2) then\r
 273        write("Avec combien d'allumettes(2<= =>30) voulez vous jouer?: ")\r
 274       else\r
 275        write("Avec combien d'allumettes(2<= =>16) voulez vous jouer?: ");\r
 276       fi;\r
 277       readln(nb);\r
 278       if (rep=2) then\r
 279         if (nb>=2) and (nb<=30) then exit fi;\r
 280       else\r
 281         if (nb>=2) and (nb<=15) then exit fi;\r
 282       fi;\r
 283    od;\r
 284  \r
 285  \r
 286     c:='n';\r
 287     if (rep<3) then\r
 288     do\r
 289      writeln;\r
 290      writeln;\r
 291      write("Voulez vous commencer (y/n)?: ");\r
 292      readln(c);\r
 293      if (c='y') orif (c='n') then exit fi;\r
 294     od;\r
 295     fi;\r
 296  \r
 297  \r
 298     call gron(1);\r
 299     call cls;\r
 300     call color(5);\r
 301     call move(70,250);\r
 302     call draw(455,250);\r
 303     call draw(455,310);\r
 304     call draw(70,310);\r
 305     call draw(70,250);\r
 306     if (c='n') then g:=0 else g:=1 fi;\r
 307     if (rep=2) orif (rep=3) then s1:=new strategie1 fi;\r
 308     if (rep=1) orif (rep=3) then s2:=new strategie2 fi;\r
 309  \r
 310  \r
 311     do\r
 312       call dessin_all(nb);\r
 313       if (c='n')\r
 314       then\r
 315         if (nb=1) then exit fi;\r
 316         if (rep=1) orif (rep=3)\r
 317          then\r
 318           attach(s2)\r
 319         else\r
 320           attach(s1)\r
 321         fi;\r
 322         g:=1-g;\r
 323         if nb=1 then exit fi;\r
 324       fi;\r
 325       c:='n';\r
 326  \r
 327  \r
 328       if (rep<>3) then\r
 329       do\r
 330        call color(2);\r
 331        call move(110,280);\r
 332        call outstring("Combien voulez vous enlever");\r
 333        call move(110,290);\r
 334        call outstring("d'allumettes (entre 1 et 3) ? : ");\r
 335        car:=readkey;\r
 336        x:=(ord(car)-48);\r
 337        call hascii(x+48);\r
 338        if (car='1') orif (car='2') orif (car='3')\r
 339        then\r
 340           if (nb-x>=1) then  exit fi;\r
 341        fi\r
 342       od;\r
 343  \r
 344  \r
 345       f:=new feu;\r
 346       attach(f);\r
 347       kill(f);\r
 348       call move(100,280);\r
 349       call outstring("                                        ");\r
 350       call move(100,290);\r
 351       call outstring("                                           ");\r
 352       nb:=nb-x;\r
 353       else\r
 354         attach(s1)\r
 355       fi;\r
 356       g:=1-g;\r
 357      od;\r
 358  \r
 359  \r
 360      call move(210,290);\r
 361      call color(2);\r
 362      if (g=0) then\r
 363         if (rep=3) then call outstring("strategie 2: ") fi;\r
 364         call outstring("J'AI PERDU")\r
 365      else\r
 366        if (rep=3)\r
 367        then\r
 368          call outstring("strategie 1: J'AI PERDU")\r
 369        else\r
 370         call outstring("VOUS AVEZ PERDU")\r
 371        fi;\r
 372      fi;\r
 373      ch:=readkey;\r
 374      call groff;\r
 375     od;\r
 376    end;\r
 377  \r
 378  \r
 379 END p2;\r