PROGRAM P3D;
  signal WIN1, WIN2, WIN3, PLEIN;
 
  UNIT INCHAR : IIuwgraph function : integer;
  begin
    do
      i := inkey;
      if i <> 0 then exit fi;
    od;
    result := i;
  end inchar;
 
  UNIT INIT_GRAPH : procedure;
  begin
  pref iiuwgraph block
  begin
    call hpage(0,1,1);
  end
  end init_graph;

(* DEFINIT LES 27 ZONES ACTIVE DE L'ECRAN
   OU L'ON PEUT CLIQUER A LA SOURIS *)

  UNIT MOUSEPOS : function : integer;
    var x, y : integer,
    pressed, l, r, c : boolean;
  begin
  pref mouse block
  begin
    call showcursor;
    do
      call getpress(0,x,y,b,l,r,c);
      if l then
      if ((x>110) and (x<130))
        then if ((y>290) and (y<310)) then result := 1; exit fi;
             if ((y>190) and (y<210)) then result := 11; exit fi;
             if ((y>090) and (y<110)) then result := 21; exit fi;
      fi;
      if ((x>260) and (x<280))
        then if ((y>290) and (y<310)) then result := 2; exit fi;
             if ((y>190) and (y<210)) then result := 12; exit fi;
             if ((y>090) and (y<110)) then result := 22; exit fi;
      fi;
      if ((x>410) and (x<430))
        then if ((y>290) and (y<310)) then result := 3; exit fi;
             if ((y>190) and (y<210)) then result := 13; exit fi;
             if ((y>090) and (y<110)) then result := 23; exit fi;
      fi;
      if ((x>160) and (x<180))
        then if ((y>250) and (y<270)) then result := 4; exit fi;
             if ((y>150) and (y<170)) then result := 14; exit fi;
             if ((y>050) and (y<070)) then result := 24; exit fi;
      fi;
      if ((x>310) and (x<330))
        then if ((y>250) and (y<270)) then result := 5; exit fi;
             if ((y>150) and (y<170)) then result := 15; exit fi;
             if ((y>050) and (y<070)) then result := 25; exit fi;
      fi;
      if ((x>460) and (x<480))
        then if ((y>250) and (y<270)) then result := 6; exit fi;
             if ((y>150) and (y<170)) then result := 16; exit fi;
             if ((y>050) and (y<070)) then result := 26; exit fi;
      fi;
      if ((x>210) and (x<230))
        then if ((y>210) and (y<230)) then result := 7; exit fi;
             if ((y>110) and (y<130)) then result := 17; exit fi;
             if ((y>010) and (y<030)) then result := 27; exit fi;
      fi;
      if ((x>360) and (x<380))
        then if ((y>210) and (y<230)) then result := 8; exit fi;
             if ((y>110) and (y<130)) then result := 18; exit fi;
             if ((y>010) and (y<030)) then result := 28; exit fi;
      fi;
      if ((x>510) and (x<530))
        then if ((y>210) and (y<230)) then result := 9; exit fi;
             if ((y>110) and (y<130)) then result := 19; exit fi;
             if ((y>010) and (y<030)) then result := 29; exit fi;
      fi;
    fi
    od;
    call hidecursor;
    end
  end mousepos;

(* STRUCTURE DEFINISSANT 3 CASES (BOX) ALIGNEES DANS LE CUBE *)

    UNIT LIGNE : class(tab_nb : arrayof integer);
      var suiv, pred  : ligne,
          occur       : arrayof box,
          i           : integer;
 
      UNIT box : class(nb : integer);
        var no   : integer,
            flag : boolean;
      begin
        no := nb;
        flag := false
      end box;
 
    begin
      array occur dim(1:3);
      for i := 1 to 3 do occur(i) := new box(tab_nb(i)) od
    end ligne;
 
(* LISTE DOUBLEMENT CHAINEE : POSSIBILITES D'UN JOUEUR *)

  UNIT POSS : class;
    var tactik,fin : ligne;
 
    UNIT VIDE : function : boolean;
    begin
      result := tactik = NONE
    end vide;
 
    UNIT DELPOSS : procedure;
    begin
      do
         if vide then exit fi;
         call supprimer(tactik);
      od
    end delposs;
 
    UNIT SUPPRIMER : procedure(e : ligne);
      var aux : ligne;
    begin
      if e=tactik
        then
          tactik:=tactik.suiv;
          kill(e);
          exit
        else
          if e=fin
            then
              fin := fin.pred;
              kill(e);
              exit
            else
          fi
      fi;
      aux := tactik.suiv;
      do
        if aux=e
          then
            aux.pred.suiv := aux.suiv;
            aux.suiv.pred := aux.pred;
            kill(aux);
            exit
          else
            aux := aux.suiv
        fi
      od
    end supprimer;
 
    UNIT AJOUTER : procedure(e : ligne);
      var i : integer;
    begin
      if vide then tactik,fin := e
              else fin.suiv := e;
                   e.pred := fin;
                   fin := e
      fi
    end ajouter;
  end poss;
 
  UNIT ELEMENT : class;
    var tab : arrayof integer,
        suivant : element;
  begin
    array tab dim(1:3)
  end element;

(* PILE D'ELEMENTS : LISTE DE TOUTES LES SOLUTIONS POUR UNE CASE DONNEE *)

  UNIT PILE : class;
    var tete : element;
 
    UNIT PILEVIDE : function : boolean;
    begin
      result := tete = NONE
    end pilevide;
 
    UNIT EMPILER : procedure(e : element);
    begin
      if not pilevide then e.suivant := tete fi;
      tete := e
    end empiler;
 
    UNIT DEPILER : function : element;
      var aux : element;
    begin
      result := tete;
      if not pilevide then tete := tete.suivant fi
    end depiler;
 
    UNIT DELPILE : procedure;
      var aux : element;
    begin
      do if pilevide then exit fi;
        aux := tete;
        tete := tete.suivant;
        kill(aux)
      od
    end delpile;
  end pile;

(* LISTE DE NUMEROS DE CASE A NE PAS JOUER *)

  UNIT LISTE : class;
    var tete, queue : numero;
 
    UNIT NUMERO : class(val : integer);
      var next : numero;
    end numero;
 
    UNIT LISTEVIDE : function : boolean;
    begin
      if tete = NONE then result := true fi
    end listevide;
 
    UNIT AJOUT : procedure(e : integer);
      var aux : numero;
    begin
      if listevide then tete, queue := new numero(e)
                   else aux := new numero(e);
                        queue.next := aux;
                        queue := aux
      fi
    end ajout;
 
    UNIT MEMBER : function(e : integer) : boolean;
      var aux : numero;
    begin
      if listevide then exit fi;
      aux := tete;
      do if aux = NONE then exit fi;
         if aux.val = e then result := true;
                             exit
                        else aux := aux.next
         fi
      od
    end member;
 
    UNIT DELLISTE : procedure;
      var aux : numero;
    begin
      do if listevide then exit fi;
         aux := tete.next;
         kill(tete);
         tete := aux
      od
    end delliste;
  end liste;

(* INITIALISATION DU CUBE MATERIALISE PAR UN TABLEAU A TROIS DIMENSIONS *)

  UNIT M3D : class;
    var i, j, k : integer,
        chape   : arrayof arrayof arrayof integer;
 
  begin
    array chape dim (1:3);
    for i := 1 to 3
      do
        array chape(i) dim (1:3)
      od;
    for j := 1 to 3
      do
        for k := 1 to 3
          do
            array chape(j,k) dim (1:3)
          od
      od
  end M3D;
 
(* TRANSFORME UN ENTIER X (0 < X < 28) EN COORDONNEES DU CUBE I,J,K *)
  UNIT INT_COORD : procedure (val : integer; output i, j, k : integer);
  begin
    k := (val div 10)+1;
    i := (((val mod 10)-1) div 3)+1;
    j := (((val mod 10)-1) mod 3)+1;
  end int_coord;

(* MISE A JOUR DU TABLEAU DES COUPS OPTIMUMS *)

  UNIT MAJTOP : procedure(topcoup : arrayof integer);
    var i     : integer,
        lig   : ligne;
  begin
    for i := 1 to 29 do topcoup(i) := 0 od;
    lig := jeu1.tactik;
    do
      if lig = NONE then exit fi;
      for i := 1 to 3
        do
          if (not(lig.occur(i).flag) and (MDJ.disponible(lig.occur(i).no)))
            then topcoup(lig.occur(i).no) := topcoup(lig.occur(i).no) + 1
          fi
        od;
        lig := lig.suiv
    od
  end MAJTOP;

(* MISE A JOUR DES LISTES DOUBLEMENT CHAINEES EN FONCTION DU COUPS JOUE *)

  UNIT MAJJEU : procedure (poss1 : poss);
    var poss2     : poss,
        sol       : element,
        lig, nouv : ligne,
        i, pasbon : integer,
        identique, good : boolean;
  begin
    if MDJ.premier then pasbon := 2;
                        poss2 := jeu2;
                   else pasbon := 1;
                        poss2 := jeu1
    fi;
    do
      if pile_sol.pilevide then exit fi;
      sol := pile_sol.depiler;
      lig := poss1.tactik;
      do
        if lig = NONE then exit fi;
        identique := true;
        for i := 1 to 3
          do if lig.occur(i).no = clic then lig.occur(i).flag := true fi;
             if lig.occur(i).no <> sol.tab(i)
               then identique := false
             fi
          od;
        if identique then exit fi;
        lig := lig.suiv;
      od;
      if not identique
        then
             good := true;
             for i := 1 to 3
               do
                 if MDJ.joue(sol.tab(i)) = pasbon
                   then
                     good := false;
                     exit
                 fi
               od;
             if good then
               nouv := new ligne(sol.tab);
               call poss1.ajouter(nouv);
               for i := 1 to 3
                 do if ((MDJ.joue(poss1.fin.occur(i).no) <> 0) or
                        (poss1.fin.occur(i).no = clic))
                      then poss1.fin.occur(i).flag := true
                    fi
                 od
             fi
      fi
    od;
    lig := poss2.tactik;
    do
      if lig = NONE then exit fi;
      for i := 1 to 3
        do if lig.occur(i).no = clic
             then
               nouv := lig.suiv;
               call poss2.supprimer(lig);
               exit
             else nouv := lig.suiv
           fi
        od;
      lig := nouv;
    od;
  end majjeu;

  UNIT ERREURCLIC : procedure;
  begin
    pref iiuwgraph block
    begin
      call hpage(1,1,1);
      call move(125,90);
      call color(12);
      call outstring("Cher utilisateur,");
      call move (100,100);
      call outstring("Vous ne pouvez jouer que sur des cases marrons !");
      call move(400,340);
      call color(14);
      call outstring("< Appuyez sur une touche >");
      i := 0;
      pref mouse block
      begin
      do
        if driver then
          call getpress(0,xm,ym,b,l,r,c);
          if l then l := false;
                    call setposition(xm+20,ym+20);
                    exit fi;
        fi;
        i:=inkey;
        if i<>0 then exit fi
      od
      end;
      call hpage(0,1,0);
    end
  end erreurclic;

(* LE MAITRE DU JEU *)

  UNIT ARBITRE : class;

(* DESSINE LE CUBE EN MODE GRAPHIQUE *)
    UNIT INIT_AFFCUBE : procedure;
      var i, j , k, x, y, couleur : integer;
  begin
  pref iiuwgraph block
    begin
      x := 120; y := 300;
      call color(9);
      call move(x,y);
      call draw(x,y-200); call draw(x+300,y-200);
      call draw(x+300,y); call draw(x,y);
      y := y-200; call move(x,y);
      call draw(x+100,y-75); call draw(x+400,y-75); call draw(x+300,y);
      call move(x+400,y-75);
      call draw(x+400,y+125); call draw(x+300,y+200);
      y := y+200; call move(x+350,y-37);
      call draw(x+350,y-237); call draw(x+50,y-237);
      call move(x+150,y);
      call draw(x+150,y-200); call draw(x+250,y-275);
      call move(x,y-100);
      call draw(x+300,y-100); call draw(x+400,y-175);
      call style(5); call move(x,y);
      call draw(x+100,y-75); call draw(x+100,y-275);
      call move(x+100,y-75); call draw(x+400,y-75);
      call move(x+350,y-37);
      call draw(x+50,y-37); call draw(x+50,y-237);
      call move(x+150,y);
      call draw(x+250,y-75); call draw(x+250,y-275);
      call move(x,y-100);
      call draw(x+100,y-175); call draw(x+400,y-175);
      call move(x+200,y-37); call draw(x+200,y-237);
      call move(x+50,y-137); call draw(x+350,y-137);
      call move(x+150,y-100); call draw(x+250,y-175);
      call style(1);
      call color(6);
      couleur := 6;
      for k := 1 to 3
        do if k > 1 then call color(15); couleur := 15 fi;
           for j := 1 to 3
             do for i := 1 to 3
                  do x := 120+(j-1)*150+(i-1)*50;
                     y := 300-((k-1)*100+(i-1)*37);
                     call cirb(x, y, 3, 0.0, 0.0, couleur, couleur, 1, 1);
                  od
             od
        od
    end
  end init_affcube;

(* AFFICHE SUR LE CUBE L'ENDROIT OU A ETE JOUE LE COUPS *)
    UNIT AFFCOUPS : procedure(i,j,k : integer);
      var x, y : integer;
    begin
      pref iiuwgraph block
        begin
          x := 120+(j-1)*150+(i-1)*50;
          y := 300-((k-1)*100+(i-1)*37);
          x := x-3; y := y-4;
          call move(x,y);
          if MDJ.premier then call color(12)
                         else call color(10)
          fi;
          call outstring("Ű");
          call move(x-5,y-3);
          call draw(x+12,y-3); call draw(x+12,y+10);
          call draw(x-5,y+10); call draw(x-5,y-3);
          call color(15);
        end
    end affcoups;
 
(* INITIALISATION DES 13 FACES CONTENUES DANS LE CUBE :
   ASSOCIATION DE 9 NUMEROS DE CASES POUR CHACUNE D'ELLES *)

    UNIT INIT_FACES : procedure;
      var i, j, k, t : integer;
    begin
      array face dim(1:13);
      for i:= 1 to 13
        do array face(i) dim(1:9)
        od;
      for i := 1 to 9
        do face (1,i) := i;
           face (2,i) := i+10;
           face (3,i) := i+20;
           face (12,i) := 3*i;
        od;
      for i := 1 to 3
        do for j := 1 to 3
             do face (3+i, j) := i+3*(j-1);
                face (3+i,j+3) := i+10+3*(j-1);
                face (3+i,j+6) := i+20+3*(j-1);
             od;
        od;
      k := 1;
      for t := 1 to 3
        do for i := 7 to 9
             do for j := 1 to 3
                do face (i,j+3*(t-1)) := k;
                   k := k+1;
                od;
             od;
           k := k+1;
        od;
      for i := 1 to 3
        do face (10,i) := i;
           face (10,i+3) := i+13;
           face (10,i+6) := i+26;
        od;
      for i := 1 to 3
        do face (11,i) := i+6;
           face (11,i+3) := i+13;
           face (11,i+6) := i+20;
        od;
      for i := 1 to 3
        do face (13,i) := 1+3*(i-1);
           face (13,i+3) := face (13,i)+11;
           face (13,i+6) := face (13,i)+22;
        od;
    end init_faces;

(* CREATION DU MASQUE POUR TROUVER TOUTES LES SOLUTIONS SELON UNE CASE *)
    UNIT INIT_MASK : procedure;
      var i : integer;
    begin
      array mask dim(1:8);
      for i := 1 to 8
        do array mask(i) dim(1:3) od;
      for i := 1 to 3 do mask(1,i) := i od;
      for i := 1 to 3 do mask(2,i) := i+3 od;
      for i := 1 to 3 do mask(3,i) := i+6 od;
      for i := 1 to 3 do mask(4,i) := 1+3*(i-1) od;
      for i := 1 to 3 do mask(5,i) := 2+3*(i-1) od;
      for i := 1 to 3 do mask(6,i) := 3+3*(i-1) od;
      for i := 1 to 3 do mask(7,i) := 1+4*(i-1) od;
      for i := 1 to 3 do mask(8,i) := 2*i+1 od;
    end INIT_MASK;

(* EMPILE TOUTES LES SOLUTIONS SELON UNE CASE CHOISIE *)
    UNIT SOLUTIONS : procedure(nobox : integer);
      var i, j, k, l, m,z : integer,
          e          : element;
    begin
      call pile_sol.delpile;
      for i := 1 to 13
        do for j := 1 to 9
             do if face(i,j) = nobox
                  then for k := 1 to 8
                         do for l := 1 to 3
                              do if mask(k,l) = j
                                   then
                                     e := new element;
                                     for m := 1 to 3
                                       do
                                       e.tab(m) := face(i,mask(k,m)) od;
                                       call pile_sol.empiler(e);
                                 fi
                              od
                         od
                fi
             od
        od
    end solutions;

(* INDIQUE SI LA CASE CHOISIE PAR UN JOUEUR EST ACCESSIBLE OU NON *)
    UNIT DISPONIBLE : function (choix : integer) : boolean;
      var i, j, k : integer;
    begin
      result := false;
      call int_coord(choix,i,j,k);
      if dispo(i,j) = choix then result := true fi
    end disponible;

(* MISE A JOUR DE LA MATRICE CONTENANT TOUTES LES CASE DISPONIBLES.
   CHANGEMENT DE COULEUR POUR LE PION SITUE AU DESSUS DU COUPS JOUE *)

    UNIT MAJDISPO : procedure(i, j ,k : integer);
    var x, y, h, c, l : integer;
    begin
      dispo(i,j) := dispo(i,j)+10;
      pref iiuwgraph block
      begin
      if dispo(i,j) > 29
        then dispo(i,j) := 0
        else call int_coord(dispo(i,j), c, l, h);
          x := 120+(l-1)*150+(c-1)*50;
          y := 300-((h-1)*100+(c-1)*37);
          call color(6);
          call cirb(x, y, 3, 0.0, 0.0, 6, 6, 1, 1);
      fi
      end
    end majdispo;

(* RENVOIE, POUR UNE CASE DONNEE, LE NUMERO DU JOUEUR QUI A JOUE DESSUS *)
    UNIT JOUE : function(endroit : integer) : integer;
      var i, j, k : integer;
    begin
      call int_coord(endroit, i, j, k);
      result := cube.chape(i,j,k)
    end joue;

(* MISE A JOUR DES NUMEROS DU CUBE POUR SAVOIR QUI A JOUE A QUEL ENDROIT.
   POR SAVOIR SI LE CUBE EST PLEIN OU SI UN JOUEUR A GAGNE *)

    UNIT MAJCUBE : function(i, j, k : integer; nojoueur : boolean) : integer;
      var m, n    : integer,
          x, y, x1, y1, z1, x2, y2, z2 : integer,
          pasfini : boolean,
          poss1   : poss,
          aux     : ligne;
    begin
      result := 0;
      pasfini := false;
      if nojoueur then cube.chape(i, j, k) := 1;
                  else cube.chape(i, j, k) := 2
      fi;
      for m := 1 to 3
        do for n := 1 to 3
             do if cube.chape(m,n,3) = 0
                  then pasfini := true;
                       exit exit
                fi
             od
        od;
      if not pasfini then result := FINI fi;
      if MDJ.premier then poss1 := jeu1
                     else poss1 := jeu2
      fi;
      aux := poss1.tactik;
      pasfini := false;
      while ((aux <> NONE) and (not pasfini))
        do if (aux.occur(1).flag AND
               aux.occur(2).flag AND
               aux.occur(3).flag)
             then pref iiuwgraph block
                  begin
                  call color(11);
                  call int_coord(aux.occur(1).no,x1,y1,z1);
                  call int_coord(aux.occur(3).no,x2,y2,z2);
                  x := 120+(y1-1)*150+(x1-1)*50;
                  y := 300-((z1-1)*100+(x1-1)*37);
                  call move(x,y);
                  x := 120+(y2-1)*150+(x2-1)*50;
                  y := 300-((z2-1)*100+(x2-1)*37);
                  call draw(x,y);
                  call color(15);
                  end;
                  pasfini := true;
             else aux := aux.suiv
           fi;
        od;
      if pasfini then
         result := GAGNE fi;
    end majcube;

(* DECLARATIONS DES VARIABLES DE L'ARBITRE *)
    const GAGNE = 1, FINI = 2;
    var cube        : M3D,
        face, mask  : arrayof arrayof integer,
        premier     : boolean,
        x, y, z,
        i, j,
        resultat    : integer,
        joueur1     : strat1,
        joueur2     : strat2,
        joueur3     : user;


(* LE MAITRE DE JEU ENGAGE LA PARTIE *)

    UNIT START_GAME : procedure;
    begin
    pref iiuwgraph block
    begin
      pile_sol := new pile;
      listdef  := new liste;
      call init_faces;
      call init_mask;
      cube := new M3D;
      call init_affcube;
      array dispo dim(1:3);
      for i := 1 to 3
        do array dispo(i) dim(1:3);
           for j := 1 to 3 do dispo(i,j) := i*3+j-3 od
        od;
      premier := true;
      do
        call move(100,320);
        call color(4);
        if nbjoueur
          then call outstring("Choisissez la premiŠre case du joueur ROUGE");
          else call outstring("Choisissez la premiŠre case pour l'ORDINATEUR")
        fi;
        joueur1 := new strat1;
        if disponible(clic) then exit fi;
          call erreurclic;
        kill(joueur1)
      od;
      call int_coord(clic, x, y, z);
      call solutions(clic);
      i := majcube(x,y,z,premier);
      call majdispo(x, y, z);
      call majjeu(jeu1);
      call affcoups(x,y,z);
      premier := not premier;
      do
        call move(100,320);
        if nbjoueur
        then
          call color(2);
          call outstring("Choisissez la premiŠre case du joueur VERT    ");
          joueur2 := new strat2;
          if disponible(clic) then exit fi;
          call erreurclic;
          kill(joueur2)
        else
          call outstring("                                              ");
          call move(100,320);
          call color(14);
          call outstring("Votre choix ? ");
          joueur3 := new user;
          if disponible(clic) then exit fi;
          call erreurclic;
          kill(joueur3)
        fi;
      od;
      call move(100,320);
      call outstring("                                              ");
      call int_coord(clic, x, y, z);
      call solutions(clic);
      i := majcube(x,y,z,premier);
      call majdispo(x, y, z);
      call majjeu(jeu2);
      call affcoups(x, y, z);
      premier := not premier;
      do
        do
          if premier then attach(joueur1)
                     else if nbjoueur then attach(joueur2)
                                      else attach(joueur3)
                          fi
          fi;
          if disponible(clic) then exit fi;
        od;
        call int_coord(clic, x, y, z);
        resultat := majcube(x, y, z, premier);
        call affcoups(x, y, z);
        if resultat = GAGNE
          then if premier then raise WIN1
                          else if nbjoueur then raise WIN2
                                           else raise WIN3
                               fi
               fi
        fi;
        if resultat = FINI then raise PLEIN fi;
        call majdispo(x, y, z);
        premier := not premier;
      od;
      lastwill : call move(70,340);
                 call color(3);
                 call outstring("Arbitre : Belle partie n'est-ce pas ?");
                 call move (410,340);
                 call color(14);
                 call outstring("< Appuyez sur une touche >");
                 i := 0;
                 pref mouse block
                 begin
                 do
                   if driver
                    then
                       call getpress(0,xm,ym,b,l,r,c);
                       if l then l := false;
                                 call setposition(xm+20,ym+20);
                                 exit fi
                   fi;
                   i:=inkey;
                   if i<>0 then exit fi
                 od;
                 if driver then call hidecursor fi
                 end;
                 call hpage(0,0,0);
    end
    end start_game;
  end arbitre;

(* STRATEGIE COMMUNE AUX DEUX JOUEURS : ATTAQUE OU DEFENSE IMMEDIATE *)
 
  UNIT STRATEGIE : procedure(output priorite : boolean);
    var nb_flag,i    : integer,
        lig          : ligne,
        poss1, poss2 : poss;
  begin
    if MDJ.premier then poss1 := jeu1;
                    poss2 := jeu2
               else poss1 := jeu2;
                    poss2 := jeu1
    fi;
    priorite := false;
    lig := poss1.tactik;
    do
      if lig = NONE then exit fi;
      nb_flag := 0;
      for i:=1 to 3
        do if lig.occur(i).flag then nb_flag := nb_flag+1 fi
        od;
      if nb_flag = 2
        then for i := 1 to 3
               do if not lig.occur(i).flag then exit fi
               od;
             if MDJ.disponible(lig.occur(i).no)
               then priorite := true;
                    clic := lig.occur(i).no;
                    exit
             fi
      fi;
      lig := lig.suiv
    od;
    if not priorite
      then
        lig := poss2.tactik;
        call listdef.delliste;
        do
          if lig = NONE then exit fi;
          nb_flag := 0;
          for i:=1 to 3
            do if lig.occur(i).flag then nb_flag := nb_flag+1 fi od;
          if nb_flag = 2
            then
              for i := 1 to 3
                do
                  if not lig.occur(i).flag then exit fi
                od;
                 if MDJ.disponible(lig.occur(i).no)
                   then
                        priorite := true;
                        clic := lig.occur(i).no;
                        exit
                   else call listdef.ajout(lig.occur(i).no-10);
                 fi
          fi;
          lig := lig.suiv
        od
    fi
  end strategie;
 
(* STRATEGIE D'ATTAQUE DU JOUEUR 1 *)

  UNIT STRAT1 : coroutine;
    var trouve,priorite         : boolean,
        i, j, k, max, imax, min : integer;
 
  begin
    pref mouse block
    begin
      if driver then clic := mousepos
                else read(clic)
      fi
    end;
    return;
    do
      call strategie(priorite);
      if not priorite then
         call majtop(topcoups1);
         for i := 29 downto 1
           do if ((topcoups1(i) > max) and (not listdef.member(i)))
               then
                 max := topcoups1(i);
                 imax := i;
                 trouve := true;
             fi;
           od;
           if trouve
             then clic := imax
             else min := 30;
                  for i := 1 to 3
                    do for j := 1 to 3
                         do
                           if ((dispo(i,j) < min) and (dispo(i,j) > 0))
                             then min := dispo(i,j)
                           fi
                         od
                    od;
                  clic := min
           fi
      fi;
      call MDJ.solutions(clic);
      call majjeu(jeu1);
      call int_coord(clic, i, j, k);
      max := MDJ.majcube(i, j, k, MDJ.premier);
      detach
    od
  end strat1;

(* STRATEGIE DE DEFENSE DU JOUEUR 2 *)

  UNIT STRAT2 : coroutine;
    var trouve, priorite   : boolean,
        i, j, k, max, imax : integer;
 
  begin
    pref mouse block
    begin
      if driver then clic := mousepos
                else read(clic)
      fi
    end;
    return;
    do
      call strategie(priorite);
      if not priorite then
         call majtop(topcoups1);
         for i := 29 downto 1
           do if ((topcoups1(i) > max) and (not listdef.member(i)))
               then
                 max := topcoups1(i);
                 imax := i;
                 trouve := true
             fi;
           od;
           if trouve
             then clic := imax
               else max := 1;
                  for i := 1 to 3
                    do for j := 1 to 3
                         do
                           if dispo(i,j) > max
                             then max := dispo(i,j)
                           fi
                         od
                    od;
                  clic := max
           fi
      fi;
      call MDJ.solutions(clic);
      call majjeu(jeu2);
      call int_coord(clic, i, j, k);
      max := MDJ.majcube(i, j, k, MDJ.premier);
      detach
    od
  end strat2;
 
(* CAS OU L'UTILISATEUR EST LE JOUEUR 2 *)

  UNIT USER : coroutine;
    var i, j, k, max : integer;
  begin
    pref mouse block
    begin
      if driver then clic := mousepos
                else read(clic)
      fi
    end;
    return;
    pref iiuwgraph block
    begin
    do
      call move(100,320);
      call outstring("                                                     ");
      call move(100,320);
      call color(14);
      call outstring("Votre choix ? ");
      do
        pref mouse block
        begin
          if driver then clic := mousepos
                    else read(clic)
          fi
        end;
        if MDJ.disponible(clic) then exit fi;
          call erreurclic;
      od;
      call move(100,320);
      call outstring("                                                     ");
      call MDJ.solutions(clic);
      call majjeu(jeu2);
      call int_coord(clic, i, j, k);
      max := MDJ.majcube(i, j, k, MDJ.premier);
      detach
    od
    end
  end user;

(* DECLARATIONS DES VARIABLES DU PROGRAMME PRINCIPAL *)
  var dispo      : arrayof arrayof integer,
      jeu1, jeu2 : poss,
      topcoups1,
      topcoups2  : arrayof integer,
      MDJ        : arbitre,
      pile_sol   : pile,
      listdef    : liste,
      clic, i, b,
      xm, ym     : integer,
      nbjoueur,
      driver, a, l, r, c : boolean;

(* TRAITEMENT DES SIGNAUX *)
  handlers
      when WIN1  : pref iiuwgraph block
                   begin
                   call move(100,325);
                   call color(4);
                   call outstring("MA STRATEGIE D'ATTAQUE ETAIT IMPARABLE !");
                   call color(15);
                   end;
                   wind;
      when WIN2  : pref iiuwgraph block
                   begin
                   call move(100,325);
                   call color(10);
                   call outstring("MA DEFENSE M'A MEME EMMENE A LA VICTOIRE !!!! ");
                   call color(15);
                   end;
                   wind;
      when WIN3  : pref iiuwgraph block
                   begin
                   call move(80,325);
                   call color(13);
                   call outstring
                   ("Bravo, vous venez de gagner contre un professionnel !!!! ");
                   call color(15);
                   end;
                   wind;
      when PLEIN : pref iiuwgraph block
                   begin
                   call move(100,325);
                   call color(15);
                   call outstring("Le cube est plein, aucun joueur n'a gagn‚");
                   end;
                   wind;
  end handlers;
 
begin (* MAIN *)
  write(chr(27),"[2J");
  pref iiuwgraph block
  begin
  pref mouse block
    begin
      call gron(5);
      driver := init(b);
      call init_graph;
      call move (210,150);
      call color(3);
      call outstring("M O R P I O N      3 D");
      call move(20,250);
      call color(13);
      call outstring("Voulez-vous jouer avec l'ordinateur (o/n) ?");
      b := inchar;
      if b = 111 then nbjoueur := false;
                      call color(2);
                      call move(20,270);
                      call outstring("Vous ˆtes le joueur VERT.");
                      call move(360,340);
                      call color(14);
                      call outstring("< Appuyez sur une touche >");
                      b := 0;
                      do if driver
                         then
                         call getpress(0,xm,ym,b,l,r,c);
                         if l then l := false;
                                   call setposition(xm+20,ym+20);
                                   exit fi
                         fi;
                         b:=inkey;
                         if b<>0 then exit fi
                      od;
                 else nbjoueur := true
      fi;
      call init_graph;
  jeu1 := new poss;
  jeu2 := new poss;
  array topcoups1 dim (1:29);
  array topcoups2 dim (1:29);
  mdj := new arbitre;
  call mdj.start_game;
end
end
end P3D.