PROGRAM p2;
begin

 (* auteur: VERNAZOBRES Fr‚d‚ric 1992/1993 *)
 
pref iiuwgraph block;
 
 
(****************************************************************************)
(*               Attente d'un caract‚re … lire au clavier                   *)
(****************************************************************************)
 
  UNIT Readkey:FUNCTION:CHAR;
   VAR Car:CHAR;
  BEGIN
    Car:=CHR(0);
    WHILE (Car=CHR(0))
    DO
      CAR:=CHR(INKEY);
    OD;
    RESULT:=Car;
  END Readkey;
 
(****************************************************************************)
(*                      Affichage des allumettes                            *)
(****************************************************************************)
 
  unit alumet:procedure(x,y:integer);
  begin
    call color(6);
    call move(160+y*20,50+x*50);
    call draw(163+y*20,50+x*50);
    call draw(163+y*20,20+x*50);
    call draw(160+y*20,20+x*50);
    call draw(160+y*20,50+x*50);
    call color(4);
    call cirb(161+y*20,20+x*50,3,10,10,4,2,3,2);
   end;
 
 
 
 
 
  UNIT dessin_all:procedure(x:integer);
   var i,j,k,s:integer;
  begin
    s:=x div 16;
    for j:=1 to s
     do
          for i:=0 to 14
           do
             call alumet(j,i);
           od;
     od;
    FOR i:=0 to ((x mod 16)+s-1)
    do
     call alumet(s+1,i);
    od
   end;
 
 
(****************************************************************************)
(*                          Effacement d'une allumette                       *)
(****************************************************************************)
 
   unit feu:coroutine;
   var i,j,s,t,k,l:integer,c:char,y,z:real;
   begin
   return;
   do
    t:=nb;
    for i:=1 to x
     do
      s:=(t-1) div 15;
      if (s=0) then j:=t mod 16-1 else j:=t mod (15*s+1) fi;
      s:=s+1;
      for k:=0 to 28
      do
        call color(4);
        call cirb(161+j*20,20+s*50+k,3,10,10,2,2,2,2);
        call move(157+j*20,18+s*50+k);
        call color(2);
        call draw(162+j*20,11+s*50+k);
        call draw(165+j*20,18+s*50+k);
        for l:=1 to 300 do od;
        call color(0);
        call cirb(161+j*20,20+s*50+k,3,10,10,0,2,2,2);
        call move(157+j*20,18+s*50+k);
        call color(0);
        call draw(162+j*20,11+s*50+k);
        call draw(165+j*20,18+s*50+k);
      od;
      t:=t-1;
    od;
    detach;
    od;
   end feu;
 
 
 
(****************************************************************************)
(*     Strategie nø1 (l'ordinateur gagne si le nb d'allumettes =/= 4n+5)    *)
(****************************************************************************)
 
 
   UNIT strategie1:coroutine;
   var g,l:integer,c:char,f:feu;
   begin
   return;
   do
    if (nb>=5)
     then
       x:=(nb-5) mod 4;
       if (x=0) then x:=1 fi;
     else
      x:=nb-1
     fi;
    call move(100,280);
    call color(2);
    c:=chr(48+x);
    if (rep=3) then call outstring(" strat‚gie 1:") fi;
    call outstring(" j'enlŠve ");
    call hascii(48+x);
    call outstring(" allumette(s)");
    for l:=1 to 6800 do od;
    f:=new feu;
    attach(f);
    kill(f);
    call move(100,280);
    call outstring("                                            ");
    nb:=nb-x;
    detach;
    od;
   end;
 
 
(****************************************************************************)
(*                      Strategie Nø2 (arbre de jeu)                        *)
(****************************************************************************)
 
 
 
  Unit noeud:class;
  var valeur:integer,
      gauche,centre,droit:noeud;
   end noeud;
 
 
 
 
  Unit arbre_jeu:procedure(nb:integer;inout pair:boolean;inout cpt:integer);
  var tree:noeud;
  begin
    tree:=new noeud;
    tree.valeur:=nb;
    if tree.valeur=1
     then
      if pair then cpt:=cpt-1 else cpt:=cpt+1 fi;
    fi;
    pair:=not pair;
    if nb>1 then call arbre_jeu(nb-1,pair,cpt) fi;
    if nb>2 then call arbre_jeu(nb-2,pair,cpt) fi;
    if nb>3 then call arbre_jeu(nb-3,pair,cpt) fi;
    kill (tree);
  end;
 
 
 
 
 
  Unit undeuxtrois:procedure(nb:integer;output choix:integer);
  var cptg,cptc,cptd:integer,
      pair:boolean;
  begin
   cptg:=0;
   cptc:=0;
   cptd:=0;
   pair:=true;
   if nb>1 then call arbre_jeu(nb-1,pair,cptg) fi;
   if nb>2 then call arbre_jeu(nb-2,pair,cptc) fi;
   if nb>3 then call arbre_jeu(nb-3,pair,cptd) fi;
   if ((cptg<=cptc) and (cptg<=cptd))
    then
       choix:=1
    else
       if ((cptc<=cptg) and (cptc<=cptd))
        then
          choix:=2
        else
          if ((cptd<=cptg) and (cptd<=cptc))
           then
             choix:=3
          fi;
        fi;
    fi;
   end;
 
 
 
 
 
  Unit strategie2:coroutine;
  var l:integer,f:feu;
  begin
    return;
    do
      call move(100,280);
      call outstring("   je reflechis !!!");
      call undeuxtrois(nb,x);
      call move(100,280);
      call outstring("                       ");
      call move(100,280);
      call color(2);
      if (rep=3) then call outstring(" strat‚gie 2:") fi;
      call outstring(" j'enlŠve ");
      call hascii(48+x);
      call outstring(" allumette(s)");
      for l:=1 to 6800 do od;
      f:=new feu;
      attach(f);
      kill(f);
      call move(100,280);
      call outstring("                                            ");
      nb:=nb-x;
      detach;
   od;
  end;
 
 
 
 
 
 
 
 
 
(****************************************************************************)
(*                      programme principal                                 *)
(****************************************************************************)
 
   var c,ch,car:char,x,rep,y,amoi,nb,g:integer,
       s1:strategie1,f:feu,s2:strategie2;
   begin
   do
 
 
    do
      write(chr(27),"[2J");
      writeln;
      writeln;
      writeln;
      writeln("1: Jouer contre l'ordinateur niveau facile");
      writeln("2: Jouer contre l'ordinateur niveau difficile ");
      writeln("3: Mode d‚monstration");
      writeln("4: Sortir");
      writeln;
      write("R‚ponse:");
      readln(rep);
      if (rep>0) and (rep<5) then exit fi;
    od;
 
 
 
    if (rep=4) then exit fi;
 
 
 
    do
      writeln;
      writeln;
      if (rep=2) then
       write("Avec combien d'allumettes(2<= =>30) voulez vous jouer?: ")
      else
       write("Avec combien d'allumettes(2<= =>16) voulez vous jouer?: ");
      fi;
      readln(nb);
      if (rep=2) then
        if (nb>=2) and (nb<=30) then exit fi;
      else
        if (nb>=2) and (nb<=15) then exit fi;
      fi;
   od;
 
 
    c:='n';
    if (rep<3) then
    do
     writeln;
     writeln;
     write("Voulez vous commencer (y/n)?: ");
     readln(c);
     if (c='y') orif (c='n') then exit fi;
    od;
    fi;
 
 
    call gron(1);
    call cls;
    call color(5);
    call move(70,250);
    call draw(455,250);
    call draw(455,310);
    call draw(70,310);
    call draw(70,250);
    if (c='n') then g:=0 else g:=1 fi;
    if (rep=2) orif (rep=3) then s1:=new strategie1 fi;
    if (rep=1) orif (rep=3) then s2:=new strategie2 fi;
 
 
    do
      call dessin_all(nb);
      if (c='n')
      then
        if (nb=1) then exit fi;
        if (rep=1) orif (rep=3)
         then
          attach(s2)
        else
          attach(s1)
        fi;
        g:=1-g;
        if nb=1 then exit fi;
      fi;
      c:='n';
 
 
      if (rep<>3) then
      do
       call color(2);
       call move(110,280);
       call outstring("Combien voulez vous enlever");
       call move(110,290);
       call outstring("d'allumettes (entre 1 et 3) ? : ");
       car:=readkey;
       x:=(ord(car)-48);
       call hascii(x+48);
       if (car='1') orif (car='2') orif (car='3')
       then
          if (nb-x>=1) then  exit fi;
       fi
      od;
 
 
      f:=new feu;
      attach(f);
      kill(f);
      call move(100,280);
      call outstring("                                        ");
      call move(100,290);
      call outstring("                                           ");
      nb:=nb-x;
      else
        attach(s1)
      fi;
      g:=1-g;
     od;
 
 
     call move(210,290);
     call color(2);
     if (g=0) then
        if (rep=3) then call outstring("strategie 2: ") fi;
        call outstring("J'AI PERDU")
     else
       if (rep=3)
       then
         call outstring("strategie 1: J'AI PERDU")
       else
        call outstring("VOUS AVEZ PERDU")
       fi;
     fi;
     ch:=readkey;
     call groff;
    od;
   end;
 
 
END p2;