PROGRAM BACKTRACKING ;

(*************************************************************************)
(* Programme : BACKTRAC.LOG                                              *)
(* Date : 04/03/93                                                       *)
(* Auteur  : SIMON Philippe           LICENCE INFORMATIQUE  1992/93      *)
(*                                                                       *)
(*      Ce programme permet d'effectuer des op‚rations de retour arriŠre *)
(* de fa‡on intelligente. Pour cela 2 exemples de BACKTRACKING ont ‚t‚   *)
(* choisi. La Gestion du Planning d'une Semaine et le ProblŠme des Pions *)
(* Noirs et Blancs. Le choix de  ces 2  exemples ce faisant par un  MENU *)
(* principal.                                                            *)
(*************************************************************************)



      VAR  choix,touche : integer,
           r : SEM,
           pi :pion;

(*************************************************************************)
(*                         METHODES  USUELLES                            *)
(*                                                                       *)
(* Cette partie contient des m‚thodes usuelles de travail (BIBLIOTHEQUE) *)
(*************************************************************************)


      UNIT eff : PROCEDURE ;
       (* envoie un ordre d'‚ffacer l'‚cran *)
        var i : integer ;
       BEGIN
             WRITE( chr(27), "[2J");
       END ;


      UNIT GetCar : IIuwgraph FUNCTION : INTEGER;
      (* attend que l'utilisateur tape une touche et renvoie le code ASCII *)
         VAR i : INTEGER;
        BEGIN
                i := 0;
                WHILE i=0
                DO
                   i := INKEY;
                   Result := i;
                OD;
        END GetCar;


      UNIT attendre : PROCEDURE(t : integer);
      (* Procedure permettant d'attendre pendant 't' seconde(s)  *)

         VAR j : integer;

        BEGIN
           j := TIME;
           while (ABS(j - TIME) < t) do od;
        END;


   (*--------------------------------------------------------------*)
   (*  PROCEDURE li‚es la gestion du MENU Principal                *)
   (*--------------------------------------------------------------*)

       UNIT menu : PROCEDURE ;
         (* Appelle les m‚thodes correspondantes au choix de l'utilisateur *)

         VAR    boucle : BOOLEAN;

         BEGIN
           boucle := TRUE;
           WHILE (boucle)
            DO
             CALL eff;
             WRITELN;
             WRITELN ("     ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿");
             WRITELN ("     ³                 M E N U                  ³");
             WRITELN ("     ³                                          ³");
             WRITELN ("     ³       'BACKTRACKING  INTELLIGENT'        ³");
             WRITELN ("     ³                                          ³");
             WRITELN ("     ³                                          ³");
             WRITELN ("     ³      0.......... QUITTER                 ³");
             WRITELN ("     ³                                          ³");
             WRITELN ("     ³                                          ³");
             WRITELN ("     ³      1 ..... Gestion du planning de la   ³");
             WRITELN ("     ³              semaine.                    ³");
             WRITELN ("     ³                                          ³");
             WRITELN ("     ³      2 ..... ProblŠme des pions noirs    ³");
             WRITELN ("     ³              et blancs.                  ³");
             WRITELN ("     ³                                          ³");
             WRITELN ("     ³                                          ³");
             WRITELN ("     ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ");
             WRITELN;WRITELN;
             WRITE   ("     Entrez votre choix : ");
             READLN (choix);

             CASE choix
               WHEN 0 : boucle := FALSE;

               WHEN 1 : CALL eff;
                        r := NEW SEM;

               WHEN 2 : CALL eff;
                        pi := NEW pion;
            ESAC;
            choix := 0;
          OD;
        END menu;

(***************************************************************************)
(*             LA  PARTIE GESTION  DU  PLANNING DE LA  SEMAINE             *)
(*                                                                         *)
(*            il s'agit ici de la DECLARATION de l'objet SEM               *)
(*             (utilise la bibliothŠque Graphique IIugraph)                *)
(***************************************************************************)


   UNIT SEM : IIuwgraph CLASS;

      VAR   i,cpt,ex,pl,et,arg,retour,val,N,N2,M : integer,
            exercice,plaisir,argent,etude,interv,interv2,interv3 : integer,
            MA,ME,JE,res : ARRAYOF integer,
            L1,L2,V1,V2 : ARRAYOF ARRAYOF integer,
            solution_possible : boolean;

      UNIT recurs : PROCEDURE(i : integer, res : ARRAYOF integer);
      (* recurs est la proc‚dure principale, appel‚e de fa‡on recursive  *)
      (* afin de cr‚er l'arboresence de tous les cas possibles d'une     *)
      (* Gestion de Semaine. A l'interieur de cette proc‚dure nous avons *)
      (* 6 autres sous_proc‚dures li‚es aux 6 premiers jours de la       *)
      (* semaine (LUNDI MARDI MERCREDI JEUDI VENDREDI). Chacune de ces   *)
      (* proc‚dures est propre … un test, … des affectation et … des     *)
      (* retours arriŠres particuliers.                                  *)
      (* Chaque solution trouv‚e est rang‚e dans le tableau 'res'.       *)



        VAR j,w : integer;


        UNIT lundi : PROCEDURE;
        (* La proc‚dure lundi correspond en quelque sorte … la racine   *)
        (* de l'arbre de gestion de la semaine. Les affectations        *)
        (* touchent ici les exercices, le plaisir, et l'argent. De plus *)
        (* on gŠre, grace … la variable retour, les retours arriŠres    *)
        (* afin de calculer les branches de l'arbre … ‚laguer.          *)


          BEGIN
             FOR w := 1 TO N
               DO
                 FOR j := 1 TO M
                   DO
                     (* on initialise les variables de travail li‚es
                        aux exercices, aux plaisirs, et … l'argent   *)
                     ex := 0; pl := 0; arg := 0; et := 0;
                     res(i) := L1(2,w);
                     res(i+1) := L2(2,j);
                     res(i+2) := L1(1,w) + L2(1,j);
                     (* On incr‚mente les variables de travail *)
                     ex := ex + res(i);
                     pl := pl + res(i+1);
                     arg := arg + res(i+2);

                     (* appel de la procedure recurs correspondant au mardi *)
                     CALL recurs(i+1,res);

                     (* On decrement les variable de travail  *)
                     ex := ex - res(i);
                     pl := pl - res(i+1);
                     arg := arg - res(i+2);

                     (* retour = 4 ou 5 correspond au vendredi  *)
                     IF retour = 4 THEN w := (exercice - val)/interv2;
                                        j := M;
                     FI;
                     IF retour = 5 THEN j := (plaisir - val);
                     FI;
                     retour := 0;

                  OD;
               OD;
             solution_possible := FALSE;
          END lundi;

        UNIT mardi : PROCEDURE;
        (* La proc‚dure mardi correspond … la seconde tranche de l'arbre*)
        (* de gestion de la semaine. Les affectations touchent ici les  *)
        (* ‚tudes.                                                      *)
        (* On gŠre, grace … la variable retour, les retours arriŠres du *)
        (* mercredi afin de calculer les branches de l'arbre … ‚laguer. *)

         BEGIN
           FOR w := 1 TO N
            DO
              res(i+2) := MA(w);
              et := 0;
              IF retour = 0 THEN
                  (* On incremente les variable de travail  *)
                  et := et + res(i+2);

                  (* appel de la procedure recurs correspondant au mercredi *)
                  CALL recurs(i+1,res);

                  (* On decremente les variable de travail  *)
                  et := et - res(i+2);
              FI;
              (* retour = 2 correspond au mercredi  *)
              IF retour = 2 THEN w := (etude - val)/interv;
                                 IF w >= N THEN retour := 1;
                                       ELSE retour := 0;
                                 FI;
              FI;
            OD;
          solution_possible := FALSE;
         END mardi;



        UNIT mercredi : PROCEDURE;
        (* La proc‚dure mercredi correspond … la troisiŠme tranche de   *)
        (* l'arbre de gestion de la semaine. Les affectations touchent  *)
        (* ici les ‚tudes.                                              *)
        (* On gŠre, grace … la variable retour, les retours arriŠres du *)
        (* jeudi afin de calculer les branches de l'arbre … ‚laguer.    *)

         BEGIN
           FOR w := 1 TO N
             DO
               res(i+2) := ME(w);
               IF retour = 0 THEN
                     (* On incremente les variable de travail  *)
                     et := et + res(i+2);

                     (* appel de la procedure recurs correspondant au jeudi *)
                     CALL recurs(i+1,res);

                     (* On decremente les variable de travail  *)
                     et := et - res(i+2);
               FI;
               (* retour = 3 correspond au jeudi  *)
               IF retour = 3 THEN w := (etude - val)/interv;
                                  IF w >= N THEN retour := 2;
                                                 val := val + ME(N);
                                       ELSE retour := 0;
                                  FI;
               FI;
             OD;
           solution_possible := FALSE;
          END mercredi;


        UNIT jeudi : PROCEDURE;
        (* La proc‚dure jeudi correspond … la quartriŠme tranche de     *)
        (* l'arbre de gestion de la semaine. Les affectations touchent  *)
        (* ici les ‚tudes.                                              *)
        (* On gŠre, grace … la variable retour, les retours arriŠres du *)
        (* jeudi au mercredi afin de calculer les branches de l'arbre … *)
        (* ‚laguer.                                                     *)

         BEGIN
            FOR w := 1 TO N
              DO
               res(i+2) := JE(w);
               IF retour = 0 THEN
                        (* On incremente les variable de travail  *)
                        et := et + res(i+2);
                        IF et < etude THEN
                              (* si aucun cas n'est trouv‚ on indique un
                                 retour arriŠre et on calcul grace … la
                                 variable val et a l'indice de boucle w
                                 les branches … ‚laguer.              *)

                              IF w = N THEN retour := 3;
                                            val := et;
                                   ELSE w := (etude - et)/interv;
                                        IF w>=N THEN w := N - 1 FI;
                              FI;
                            ELSE
                              (* appel de la procedure recurs correspondant
                                 au vendredi       *)
                               CALL recurs(i+1,res);
                         FI;
                         (* On decremente les variable de travail  *)
                         et := et - res(i+2);
               FI;
              OD;
            solution_possible := FALSE;
         END jeudi;


        UNIT vendredi : PROCEDURE;
        (* La proc‚dure vendredi correspond … la cinquiŠme tranche de   *)
        (* l'arbre de gestion de la semaine. Les affectations touchent  *)
        (* ici les exercices, le plaisir, et l'argent.                  *)
        (* On gŠre, grace … la variable retour, les retours arriŠres du *)
        (* lundi afin de calculer les branches de l'arbre … ‚laguer.    *)

         BEGIN
            FOR w := 1 TO N
              DO
                FOR j := 1 TO M
                  DO
                    res(i+2) := V1(2,w);
                    res(i+3) := V2(2,j);
                    res(i+4) := V1(1,w) + V2(1,j);
                    (* On incremente les variable de travail  *)
                    ex := ex + res(i+2);
                    pl := pl + res(i+3);
                    arg := arg + res(i+4);
                    IF arg > argent THEN j := M;
                        ELSE
                           IF ex < exercice THEN
                              (* si aucun cas n'est trouv‚ on indique un
                                 retour arriŠre et on calcul grace … la
                                 variable val et … l'indice de boucle w
                                 les branches … ‚laguer.              *)

                                IF w = N THEN retour := 4;
                                              val := ex;
                                              exit;
                                    ELSE w := ((exercice - ex)/interv2);
                                         IF w >= N THEN w := N-1 FI;
                                         j := M;
                                FI
                              ELSE
                                IF pl < plaisir THEN
                                  (* si aucun cas n'est trouv‚ on indique un
                                      retour arriŠre et on calcul grace … la
                                      variable val et a l'indice de boucle j
                                      les branches … ‚laguer.              *)

                                      IF j = M THEN retour := 5;
                                                    val := pl;
                                           ELSE j := (plaisir - pl)/interv3;
                                      FI;
                                (* appel de la procedure recurs correspondant
                                   … une solution trouv‚e             *)
                                    ELSE  CALL recurs(i+1,res);
                                FI
                           FI
                    FI;
                    (* On decremente les variable de travail  *)
                    ex := ex - res(i+2);
                    pl := pl - res(i+3);
                    arg := arg - res(i+4);
                 OD;
               OD;
            solution_possible := FALSE;
         END vendredi;



       BEGIN

          retour := 0;
          solution_possible := TRUE;

          CASE i

             WHEN 1 : CALL lundi;

             WHEN 2 : CALL mardi;

             WHEN 3 : CALL mercredi;

             WHEN 4 : CALL jeudi;

             WHEN 5 : CALL vendredi;

          ESAC;

          (* si une solution est trouv‚e on l'imprime … l'‚cran *)
          IF solution_possible THEN CALL imprim(res)  FI;

       END recurs;


   (*------------------------------------------------------------------*)
   (*  PROCEDURE li‚es la gestion du MENU de la Gestion de la Semaine  *)
   (*------------------------------------------------------------------*)

      UNIT menu_ps : PROCEDURE;
          VAR i : integer;

        BEGIN
            WRITELN("     ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ");
            WRITELN("     ³ PLANNING DE LA SEMAINE AVEC CONTRAINTES ³ ");
            WRITELN("     ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ");
            WRITELN(" Chaque jour implique un choix particulier :");
            WRITELN;
            WRITELN("   * LUNDI :");
            FOR i := 1 TO N  DO
               WRITE(" $",L1(1,i):2,"   Exercice ",L1(2,i):2);
               IF i > M THEN WRITELN;
                 ELSE WRITELN("      $",L2(1,i):2," Plaisir ",L2(2,i));
               FI;
            OD;
            WRITELN;
            WRITELN("    * MARDI     MERCREDI    JEUDI :");
            FOR i := 1 TO N DO
                 WRITELN(" Etude ",MA(i):2,"         ",ME(i):2,"     ",JE(i));
            OD;
            WRITELN;
            WRITELN("    * VENDREDI :");
            FOR i := 1 TO N  DO
               WRITE(" $",V1(1,i):2,"   Exercice ",V1(2,i):2);
               IF i > M THEN WRITELN;
                 ELSE WRITELN("      $",V2(1,i):2," Plaisir ",V2(2,i));
               FI;
            OD;
            WRITELN;
            WRITE("  CONTRAINTES : ");
            WRITE(" Exercice >= ",exercice:2,"   Argent ($) =< ",argent:2);
            WRITELN("  Etude >= ",etude:2,"   Plaisir >= ",plaisir:2);
            touche := Getcar;
        END;



   (*---------------------------------------------------------------------*)
   (*  PROCEDURES li‚es la gestion de l'AFFICHAGE … l'‚cran des resultats *)
   (*---------------------------------------------------------------------*)


      UNIT imprim : PROCEDURE(res : ARRAYOF integer);
      (* La proc‚dure imprim permet d'afficher toutes les solutions   *)
      (* possibles (les unes a la suite des autres) pages par pages … *)
      (* l'‚cran, sous forme de tableau de resultat.                  *)

         VAR j : integer;

        BEGIN
          IF cpt = 0 THEN CALL eff;
                          (* affichage de l'entete … l'‚cran  *)
                          CALL entete;
          FI;
          WRITE ("³",res(1):4,"³",res(2):4,"³",res(3):4);
          WRITE ("³",res(4):6,"  ³",res(5):6,"  ³",res(6):6);
          WRITE ("  ³",res(7):4,"³",res(8):4,"³",res(9):4);
          WRITE ("º",ex:4,"³",pl:4,"³",arg:4,"³",et:4,"³");
          WRITELN;
          cpt := cpt + 1;
          IF cpt = 16 THEN WRITELN ("Appuyez sur une touche pour continuer...");
                           touche := Getcar;
                           cpt := 0;
          FI;

        END imprim;


     UNIT entete : PROCEDURE;
     (* Affiche l'entete du tableau de resultat … l'‚cran.   *)
      BEGIN
         WRITELN("CONTRAINTES : ");
         WRITE("Exercice >= ",exercice:2,"   Argent ($) =< ",argent:2);
         WRITELN("  Etude >= ",etude:2,"   Plaisir >= ",plaisir:2);
         WRITE("ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÂÄÄÄÄÄ");
         WRITELN("ÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄËÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿");
         WRITE("³     LUNDI    ³ MARDI  ³MERCREDI³ JEUD");
         WRITELN("I  ³   VENDREDI   º      TOTAL        ³");
         WRITE("ÃÄÄÄÄÂÄÄÄÄÂÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄ");
         WRITELN("ÄÄÄÅÄÄÄÄÂÄÄÄÄÂÄÄÄÄÎÄÄÄÄÂÄÄÄÄÂÄÄÄÄÂÄÄÄÄ´");
         WRITE("³Exer³Plai³ $  ³ Etude  ³ Etude  ³ Etud");
         WRITELN("e  ³Exer³Plai³ $  ºExer³Plai³ $  ³Etud³");
         WRITE("ÃÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄ");
         WRITELN("ÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÎÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄ´");
      END entete;


     UNIT fin : PROCEDURE;
     (* Affiche la fin du  tableau de resultat … l'‚cran.   *)

      BEGIN
         WRITE("ÀÄÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÁÄÄÄÄÄ");
         WRITELN("ÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄÙ");
         WRITELN ("Appuyez sur une touche pour continuer...");
         touche := Getcar;
      END fin;


   BEGIN
     PREF IIUWGraph block;
      BEGIN
       (* Initialisation des tableaux et des variables de JEUX D'ESSAI *)

       N := 4;
       M := 3;
       N2 := 2;
       (* D‚claration d'intervalles  *)
       interv := 2;
       interv2 := 5;
       interv3 := 1;
       ARRAY res DIM (1:9);
       ARRAY L1 DIM (1:N2);
       FOR i := 1 TO N2
        DO
          ARRAY L1(i) DIM (1:N);
        OD;
       ARRAY L2 DIM (1:N2);
       FOR i := 1 TO N2
        DO
          ARRAY L2(i) DIM (1:M);
        OD;
       ARRAY MA DIM (1:N);
       ARRAY ME DIM (1:N);
       ARRAY JE DIM (1:N);
       ARRAY V1 DIM (1:N2);
       FOR i := 1 TO N2
        DO
          ARRAY V1(i) DIM (1:N);
        OD;
       ARRAY V2 DIM (1:N2);
       FOR i := 1 TO N2
        DO
          ARRAY V2(i) DIM (1:M);
        OD;

       (* Initialisation des tableaux jeux d'essai du mardi,mercredi et
          jeudi concernant les ‚tudes.                                  *)

       FOR i := 1 TO N
         DO
              MA(i),ME(i),JE(i) := (i-1) * interv;
         OD;

       (* Initialisation des tableaux jeux d'essai du lundi et vendredi
          concernant l'argent.                                          *)

       L1(1,1),V1(1,1) := 0;
       L1(1,2),V1(1,2) := 0;
       L1(1,3),V1(1,3) := 0;
       L1(1,4),V1(1,4) := 20;

       (* Initialisation des tableaux jeux d'essai du lundi et vendredi
          concernant les exercices.                                     *)

       FOR i := 1 TO N
         DO
             L1(2,i),V1(2,i) := (i-1) * interv2;
         OD;

       (* Initialisation des tableaux jeux d'essai du lundi et vendredi
          concernant les plaisirs ou divertissements.                   *)

       L2(1,1),V2(1,1) := 0;
       L2(1,2),V2(1,2) := 0;
       L2(1,3),V2(1,3) := 20;

       FOR i := 1 TO M
         DO
            L2(2,i),V2(2,i) := (i-1) * interv3;
         OD;

       (*  Les contraintes d'une semaine ‚quilibr‚e sont les suivantes :  *)

       argent := 30;
       etude := 14;
       exercice := 20;
       plaisir := 2;

       cpt := 0;
       CALL GRON(1);
       CALL menu_ps;
       CALL recurs(1,res);
       CALL fin;
       CALL GROFF;
      END;
   END SEM;



(***************************************************************************)
(*       LA  PARTIE GESTION  DU  JEU DES PIONS NOIRS ET BLANCS             *)
(*                                                                         *)
(*            il s'agit ici de la DECLARATION de l'objet PION              *)
(*             (utilise la bibliothŠque Graphique IIugraph)                *)
(***************************************************************************)


   UNIT PION : IIuwgraph CLASS;

      VAR   n,i,M : integer,
            tab : ARRAYOF char,
            trouve,manuel: boolean;


      UNIT procent : PROCEDURE(A,B : char, P,NN : integer);
      (* La procedure procent permet de parcourir l'arbre des solutions  *)
      (* en anticipant le meilleur des chemins c'est a dire en parcourant*)
      (* le moins de chemin possible.                                    *)
      (* Les paramŠtres d'entr‚s A et B prennent soit la valeur Noir et  *)
      (* Blanc ou Blanc et Noir. Idem pour les 2 entier P et NN qui      *)
      (* prennent en fonction de la couleur des pions soit la valeur 1 et*)
      (* M (2*n+1) ou -1 et 1. (P indique le sens de deplacement).       *)

             VAR bo : boolean,
                 j, k : integer;

         UNIT proc : PROCEDURE(X : char);
         (* La proc‚dure proc permet de connaitre si l'on se trouve dans *)
         (* position de blocage ou bien si l'on peut continuer dans ce   *)
         (* chemin. (Cas o— l'on place un pion … cot‚ d'un autre pion de *)
         (* mˆme couleur).                                               *)

            BEGIN
              bo := TRUE;
              k := 2;
              j := i + 2*P;
              IF (j >= 1) AND (j <= M) THEN
                          WHILE ((bo) AND (j <> NN+P))
                            DO
                               (* On test si tous les pions suivants sont
                                  de mˆme couleur. Si oui alors on poursuit
                                  le chemin dans l'arbre, sinon on se trouve
                                  bloqu‚.                                 *)

                               IF tab(j) <> X THEN bo := FALSE;
                                      ELSE k := k + 1;
                               FI;
                               j := j + P;
                             OD;
              FI;
            END proc;


          UNIT affect2 : PROCEDURE;
          (* La proc‚dure affect2 permet de d‚placer un pion en sautant *)
          (* par dessus un pion de couleur adverse.                    *)
          (* Le sens du d‚placement ‚tant indiquer par l'entier  P.     *)

            BEGIN
                tab(i) := tab(i-2*P);
                tab(i-2*P) := ' ';
                i := i - 2*P;
                (* appel de la proc‚dure principale tentative *)
                CALL tentative;
                i := i + 2*P;
                tab(i-2*P) := tab(i);
                tab(i) := ' ';
            END affect2;



          UNIT affect1 : PROCEDURE;
          (* La procedure affect1 permet de d‚placer un pion d'une   *)
          (* case en avant (pion avance dans la case vide).          *)
          (* Le sens du d‚placement ‚tant indiquer par l'entier  P.  *)

            BEGIN
                tab(i) := tab(i-P);
                tab(i-P) := ' ';
                i := i - P;
                (* appel de la proc‚dure principale tentative *)
                CALL tentative;
                i := i + P;
                tab(i-P) := tab(i);
                tab(i) := ' ';
            END affect1;



         BEGIN
           (* On test si l'on se trouve en bordures du jeux (du tableau)
              C'est a dire que l'on verifie que les indices de tables
              sont toujours valide pour continuer les tests suivants.    *)
           IF ((i-P) > 0) AND ((i-P) <= M) THEN

             (* On test si l'on peut avancer le pion dans la case vide en
                fonction de P (indique le sens du d‚placement).           *)
             IF tab(i-P) = A THEN

                (* On test si l'on se trouve en bordures du jeux, en
                   fonction du sens du d‚pacement.                    *)
                IF ((i+P) > 0) AND ((i+P) <= M) THEN

                   (* On test si le pion situ‚ aprŠs la case vide est de
                      mˆme couleur que celui plac‚ avant.                *)
                   IF tab(i+P) = A THEN
                                     (* Si oui on appele la proc‚dure proc *)
                                     CALL proc(A);
                                     (* On test si l'on poursuit le chemin *)
                                     IF bo THEN
                                          CALL affect1;
                                          (* On test si l'on se trouve dans
                                             l'‚tat final du jeux. (k=n)   *)
                                          IF k = n THEN trouve := FALSE  FI;
                                          IF trouve THEN CALL aff_retour_ar FI;
                                     FI;
                        ELSE
                             (* Sinon on appele la proc‚dure d'affectation
                                affect1, et on poursuit le chemin.        *)
                             CALL affect1;
                             IF trouve THEN CALL aff_retour_ar  FI;
                   FI;
                  ELSE
                      (* Sinon on appele la proc‚dure d'affectation affect1 *)
                      CALL affect1;
                      IF trouve THEN CALL aff_retour_ar  FI;
               FI;
              ELSE

                 (* On test si l'on se trouve en bordures du jeux (du tableau)
                    C'est a dire que l'on verifie que les indices de tables
                    sont toujours valide pour continuer les tests suivants. *)
                   IF ((i-2*P) > 0) AND ((i-2*P) <= M) THEN

                      (* On test si l'on peut avancer le pion plac‚ 2 cases
                         avant la case vide en sautant un pion de couleur
                         adverse plac‚ une case avant la case vide, toujours
                         en fonction du sens P.                             *)
                      IF (tab(i-2*P) = A) AND (tab(i-P) = B) THEN

                         (* On test si l'on se trouve en bordures du jeux, en
                            fonction du sens du d‚pacement.                 *)
                         IF ((i+P) > 0) AND ((i+P) <= M) THEN

                            (* On test si le pion situ‚ aprŠs la case vide
                               est de mˆme couleur que celui plac‚ 2 cases
                               avant la case vide.                        *)
                            IF tab(i+P) = A THEN
                                     (* Si oui on appele la proc‚dure proc *)
                                     CALL proc(A);
                                     (* On test si l'on poursuit le chemin *)
                                     IF bo THEN
                                         CALL affect2;
                                         (* On test si l'on se trouve dans
                                            l'‚tat final du jeux. (k=n)    *)
                                         IF k = n THEN  trouve := FALSE;  FI;
                                         IF trouve THEN CALL aff_retour_ar FI;
                                     FI;
                                ELSE
                                 (* Sinon appel de la proc‚dure d'affectation
                                    affect2, et on poursuit le chemin.    *)
                                   CALL affect2;
                                   IF trouve THEN CALL aff_retour_ar  FI;
                               FI;
                            ELSE
                             (* appel de la proc‚dure d'affectation affect2 *)
                               CALL affect2;
                               IF trouve THEN CALL aff_retour_ar  FI;
                        FI;
                     FI;
                  FI;
              FI;
           FI;
       END procent;




      UNIT tentative : PROCEDURE;
      (* Cette proc‚dure permet de parcourir l'arbre du jeux des pions.  *)
      (* En faisant d'abord avancer les pions Noirs puis les pions Blancs*)
      (* Tant que l'‚tat final n'est pas atteint on affiche l'‚volution  *)
      (* du d‚placement dans l'arbre.                                    *)

       BEGIN
         IF trouve THEN
                        CALL cls;
                        (* On imprime le resultat a l'instant t *)
                        CALL imprim;
                        (* On d‚place les pions Noirs *)
                        CALL procent('N','B',1,M);
                        (* On d‚place les pions Blancs *)
                        CALL procent('B','N',-1,1);

         FI;
       END tentative;



   (*---------------------------------------------------------------------*)
   (*  PROCEDURES li‚es la gestion de l'AFFICHAGE … l'‚cran des resultats *)
   (*---------------------------------------------------------------------*)


      UNIT aff_retour_ar : PROCEDURE;
      (* Proc‚dure permettant d'indiquer … l'‚cran que l'on effectue *)
      (* un retour arriŠre (BACKTRACKING).                           *)

       BEGIN
            CALL CLS;
            CALL move(150,220);   CALL draw(360,220);
            CALL move(150,260);   CALL draw(360,260);
            CALL move(150,220);   CALL draw(150,260);
            CALL move(360,220);   CALL draw(360,260);
            CALL move(180,237);
            CALL outstring("RETOUR  ARRIERE ...");
            CALL imprim;
       END;




      UNIT imprim : PROCEDURE;
      (* Proc‚dure permettant d'afficher de maniŠre graphique les    *)
      (* pions Noirs et Blancs dans un tableaux proportionnel au     *)
      (* nombre de pions.                                            *)
      (* Les proc‚dures graphiques utilis‚es : outstring, move, draw *)
      (* cirb.                                                       *)

        VAR  l,col,xi,touche : integer;

       BEGIN
          CALL move(100,10);
          CALL outstring("LE PROBLEME DES PIONS NOIRS ET BLANCS");

          (* Affichage du tableau de jeux *)
          CALL move(70,80);   CALL draw(70+60*(2*n+1),80);
          CALL move(70,120);  CALL draw(70+60*(2*n+1),120);
          FOR l := 0 TO ((n+1)*2-1)  DO
              CALL move(70+(60*l),80);  CALL draw(70+(60*l),120);
          OD;

          (* Affichage des pions Noirs et Blancs  *)
          FOR l := 1 TO M
             DO
               xi := 100 + ((l-1) * 60);
               IF tab(l) <> ' '
                  THEN IF tab(l) = 'B' THEN col := 15;
                                ELSE  col := 0;
                       FI;
                       CALL cirb(xi,100,20,10,10,15,col,2,2);
               FI;
             OD;
             IF manuel THEN
                    CALL move(50,300);
                    CALL outstring("Appuyez sur une touche pour continuer...");
                    touche := Getcar;
                ELSE CALL attendre(2);
             FI;
       END imprim;


     UNIT menu_p : PROCEDURE;
          VAR choix : integer;

       BEGIN
         manuel := TRUE;
         CALL eff;
         WRITELN("        ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ");
         WRITELN("        ³  PROBLEME DES PIONS NOIRS ET BLANCS  ³ ");
         WRITELN("        ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ");
         WRITELN; WRITELN;
         WRITELN ("   A partir d'un etat initial qui est le suivant :");
         WRITELN ("             NNN*BBB");
         WRITELN ("   Il faut aboutir … un etat final qui est le suivant :");
         WRITELN ("             BBB*NNN");
         WRITELN;
         WRITELN ("   Sachant que l'on … des rŠgles fix‚es :");
         WRITELN ("                                ÄÄ> <ÄÄ");
         WRITELN ("     - Les sens sont fix‚s :    NNN*BBB");
         WRITELN ("     - Un pion peut avancer dans une case vide '*' si :");
         WRITELN ("            * Elle est juste devant. ");
         WRITELN ("            * Il l'atteint en sautant par dessus un pion");
         WRITELN ("              de couleur adverse.");
         WRITELN;
         WRITELN ("   D‚sirez vous un traitement :");
         WRITELN;
         WRITELN ("          1 ......... MANUEL");
         WRITELN ("          2 ......... AUTOMATIQUE");
         WRITELN;
         WRITE ("  Votre choix : ");
         READLN (choix);
         IF choix = 2 THEN manuel := FALSE   FI;
         CALL eff;
         WRITELN; WRITELN; WRITELN; WRITELN;
         n := 0;
         WHILE ((n < 2) OR (n > 4))
          DO
              WRITE("       Donnez le Nombre de Pions (2,3 ou 4) : ");
              READLN (n);
          OD;
     END;



   BEGIN
     (* On utilise pour repr‚senter de fa‡on graphique … l'‚cran les pions *)
     (* Noirs et Blancs la Biblioth‚que graphique  IIugraph.               *)

     PREF IIUWGraph block;
       BEGIN
          CALL GRON(1);
          CALL menu_p;

          (* initialisation … l'‚tat initial du tableau de jeux en fonction *)
          (* du nombres de pions entr‚s pr‚alablement.    ex: NNN BBB       *)

          ARRAY tab DIM (1:(n*2)+1);

          FOR i := 1 TO n DO tab(i) := 'N' OD;
          tab(n+1) := ' ';
          FOR i := (n+2) TO (n*2)+1 DO tab(i) := 'B' OD;

          i := n + 1;

          (* La variable M repr‚sente l'indice maximum du tableau du jeux *)
          (* en fonction du nombres de pions.  ex: si n=3 ÄÄ> M=7         *)
          M := 2*n + 1;

          trouve := TRUE;
          (* Appel de la proc‚dure principale 'tentative' de parcours
             d'arbre.                                                 *)
          CALL tentative;
          CALL GROFF;
        END;
   END PION;



(*******************************)
(***  PROGRAMME  PRICIPAL  *****)
(*******************************)

BEGIN
     (* Appel du menu principal *)
     CALL menu;
END BACTRACKING;