PROGRAM Labyrinthe;
 
BEGIN
 
pref iiuwgraph block ;
 
var entree : couple,
    TailleMax : couple,
    F : file,
    SortieProg : Boolean,
    Choix : Char,
    Mat : Matrice ;
 
UNIT couple : CLASS;
  Var absi, ordo :integer;
END couple;
 
UNIT Link : CLASS (Val: couple);
  Var Next : Link;
END Link;
 
 
UNIT pile : CLASS;
  var top : Link;
End Pile;
 
UNIT empty : FUNCTION (p: pile): boolean;
  Begin
    If p=none
    Then
      result:= True ;
    Else
      Result:= (p.top = none);
    Fi;
  END empty;
 
UNIT push : FUNCTION ( Curseur :couple ; p: pile) : Pile;
Var Aux : link;
  Begin
    aux := New Link( Curseur);
    If(not empty(p)) then
      Aux.next:= p.top;
    Fi;
    Result := New Pile;
    Result.top := Aux;
  END push;
 
UNIT tete : FUNCTION ( P : pile ): couple;
  Begin
    Result := new couple;
    If(not empty(p)) then
      Result := P.top.Val;
    Fi;
  END tete;
 
UNIT pop : FUNCTION (p : pile): pile;
var lk : link;
  Begin
    If(not empty(p))
    Then
      lk := New Link(p.top.val);
      result:= new pile;
      result.top:= p.top.next;
      lk:= p.top;
      kill(lk);
    Fi;
  END pop;
 
 
 
UNIT matrice : CLASS ;
  var A: arrayof arrayof integer;
  var i: integer;
 
 
  UNIT sortie : FUNCTION ( Curseur : couple ) : boolean;
       BEGIN
         If    NOT((entree.absi = Curseur.absi) AND
                   (entree.ordo = Curseur.ordo))  ANDIF
               ( (Curseur.absi = 1) OR (Curseur.absi = TailleMax.absi) OR
                 (Curseur.ordo = 1) OR (Curseur.ordo = TailleMax.ordo) )
         Then
           result:=true;
         Else
           result:=false;
         Fi;
       END sortie;
 
  UNIT droite : FUNCTION ( Curseur : couple ) : boolean;
       BEGIN
         If ( Curseur.Absi <> TailleMax.Absi) ANDIF
            ( A(Curseur.absi + 1, Curseur.ordo) = 1 )
         Then
           result:=true
         Else
           result:=false;
         Fi
       END droite;
 
  UNIT gauche : FUNCTION ( Curseur : couple ) : boolean;
       BEGIN
         If ( Curseur.Absi <> 1 ) ANDIF
            ( A(Curseur.absi-1 , Curseur.ordo) = 1)
         Then
           result:= true
         Else
           result:=false;
         Fi
       END gauche;
 
  UNIT devant : FUNCTION ( Curseur : couple ) : boolean;
       BEGIN
         If ( Curseur.Ordo <> TailleMax.Ordo) ANDIF
            ( A(Curseur.absi , Curseur.ordo+1) = 1 )
         Then
           result:=true
         Else
           result:=false;
         Fi
       END devant;
 
  UNIT derriere : FUNCTION ( Curseur : couple ) : boolean;
       BEGIN
         If ( Curseur.Ordo <> 1 ) ANDIF
            ( A(Curseur.absi , Curseur.ordo-1) = 1 )
         Then
           result:= true;
         Else
           result := false;
         Fi
       END derriere;
 
  END Matrice;
 
 
  UNIT CreatMat : PROCEDURE (mat : matrice);
  var i:integer;
       BEGIN
         Array Mat.A Dim (1 : TailleMax.Absi);
         For i:= 1 To TailleMax.Absi Do
             Array Mat.A(i) dim (1 : TailleMax.Ordo);
         Od;
        END CreatMat;
 
 UNIT InitMat : PROCEDURE (mat : matrice);
 var i, j :integer;
      BEGIN
       (* Initialisation de la matrice; toutes les cases sont des murs *)
       For i:= 1 To TailleMax.Ordo Do
           For j:= 1 To TailleMax.Absi Do
               Mat.A(j,i) := 0;
           Od;
       Od;
END InitMat;
 
 
 
 
(* Procedures n‚cessaires … l'affichage de la matrice *)
 
  UNIT Bold : PROCEDURE;
  Begin
    write( chr(27), "[1m")
  End Bold;
 
  UNIT Reverse : PROCEDURE;
  Begin
    write( chr(27), "[7m")
  End Reverse;
 
  UNIT Normal : PROCEDURE;
  Begin
    write( chr(27), "[0m")
  End Normal;
 
  UNIT Underscore : PROCEDURE;
  Begin
    write( chr(27), "[4m")
  End Underscore;
 
  UNIT EraseLine : PROCEDURE;
  Begin
    write( chr(27), "[K")
  End EraseLine;
 
 UNIT inchar : IIUWgraph FUNCTION : integer;
    var i : integer;
  Begin
    Do
      i := inkey;
      If i <> 0 Then exit Fi;
    Od;
    result := i;
  End inchar;
 
  UNIT NewPage : PROCEDURE;
  Begin
    write( chr(27), "[2J")
  End NewPage;
 
  UNIT SetCursor : PROCEDURE (row, column : integer);
    var c,d,e,f  : char,
        i,j : integer;
  Begin
    i := row div 10;
    j := row mod 10;
    c := chr(48+i);
    d := chr(48+j);
    i := column div 10;
    j := column mod 10;
    e := chr(48+i);
    f := chr(48+j);
    write( chr(27), "[", c, d, ";", e, f, "H")
  End SetCursor;
 
 
(* Procedure d'affichage du labyrinthe *)
 
UNIT AffichageLaby : PROCEDURE ( Mat : matrice);
 
var i,j:integer;
 
BEGIN
  call NewPage;
  writeln;
  For i:= 1 To TailleMax.Ordo Do
      Call Normal;
      write (" ");
      For j := 1 To TailleMax.Absi  Do
          call Reverse;
          call Bold;
          If Mat.A (j,i) = 0
          Then (* On a un mur *)
              write (" ",chr(88));
          Else
              write ("  ");
          Fi;
      Od;
      writeln (" ");
  Od;
  Call Normal;
 
END AffichageLaby;
 
 
UNIT RechChemin : PROCEDURE ( Mat : matrice );
 
Var SolExiste : boolean,
    Curseur,Elem : couple,
    Retour : boolean,
    i : integer,
    P : Pile ;
 
    UNIT AfficheChemin : PROCEDURE ( Curseur : couple , Retour : boolean );
     Var i : integer;
      Begin
        i := 0;
        While i < 10
        Do
          Call SetCursor ( Curseur.ordo + 1 , (Curseur.absi*2) + 1 );
          Call Reverse;
          Call Underscore;
          If Retour
          Then
             write ( "." );
          Else
             write ( chr(254) );
          Fi;
          Call SetCursor ( Curseur.ordo + 1, (Curseur.absi*2) + 1 );
          Call Normal ;
          i := i+1;
       Od;
      End AfficheChemin;
 
BEGIN
 
  Call SetCursor (22,10);
  Call EraseLine;
  Call SetCursor (23,15);
  Call EraseLine;
  Call SetCursor (24,15);
  Call EraseLine;
 
  Curseur := New Couple ;
  Curseur.Absi := Entree.absi;
  Curseur.Ordo := Entree.Ordo;
  Mat.A ( Curseur.absi, Curseur.Ordo ) := 2;
  Retour := False;
  Call AfficheChemin ( Curseur , Retour );
 
  SolExiste := true;
  P := new Pile;
 
  While (Not Mat.Sortie(curseur)) AND ( SolExiste )
  Do
    If Mat.Gauche(curseur)
    Then
       Retour := False;
       Call AfficheChemin ( Curseur, Retour );
       Elem := New Couple ;
       Elem.Absi := Curseur.Absi;
       Elem.Ordo := Curseur.Ordo;
       P := Push ( Elem , P );
       Curseur.absi := Curseur.absi - 1;
       Mat.A ( Curseur.Absi, Curseur.Ordo) := 2;
       Call AfficheChemin ( Curseur, Retour );
    Else
       If Mat.devant(curseur)
       Then
          Retour := False;
          Call AfficheChemin ( Curseur, Retour );
          Elem := New Couple;
          Elem.Absi := Curseur.Absi;
          Elem.Ordo := Curseur.ordo;
          P := Push ( Elem , P );
          Curseur.ordo := Curseur.ordo + 1;
          Mat.A(Curseur.Absi, Curseur.Ordo) := 2;
          Call AfficheChemin ( Curseur, Retour );
       Else
          If Mat.droite(curseur)
          Then
             Retour := False;
             Call AfficheChemin (Curseur, Retour );
             Elem := New Couple;
             Elem.absi := Curseur.absi;
             Elem.ordo := Curseur.ordo;
             P := push ( Elem ,P );
             Curseur.absi := curseur.absi + 1;
             Mat.A(Curseur.Absi, Curseur.Ordo) := 2;
             Call AfficheChemin ( Curseur, Retour );
          Else
             If Mat.Derriere(curseur)
             Then
                Retour := False;
                Call AfficheChemin(Curseur,Retour);
                Elem := New Couple;
                Elem.Absi := Curseur.absi;
                Elem.Ordo := Curseur.ordo;
                P := push ( Elem , P);
                Curseur.ordo := Curseur.ordo - 1;
                Mat.A(Curseur.absi, Curseur.Ordo) := 2;
                Call AfficheChemin ( Curseur,Retour );
             Else
               If not empty (P)
               Then
                   (* On revient sur un endroit defja visit‚ *)
                   Retour := True;
                   Call AfficheChemin ( Curseur, Retour );
                   Elem := New Couple;
                   Elem := Tete(P);
                   Curseur.Ordo:= Elem.Ordo;
                   Curseur.Absi := Elem.Absi;
                   kill(Elem);
                   P := pop(P);
                   Call AfficheChemin ( Curseur , Retour);
                Else
                   SolExiste := false;
                Fi;
             Fi;
          Fi;
       Fi;
    Fi;
  Od;
  call Bold;
  If SolExiste then
    If Curseur.Ordo = 1 then
      call SetCursor(1, (Curseur.Absi*2)+1);
      write("S");
    Fi;
    If Curseur.Ordo = TailleMax.Ordo then
      call SetCursor(TailleMax.Ordo+2, (Curseur.Absi*2)+1);
      write("S");
    Fi;
    If Curseur.Absi = 1 then
      call SetCursor (Curseur.Ordo+1, 1);
      write("S");
    Fi;
    If Curseur.Absi = TailleMax.Absi then
      call SetCursor ( Curseur.ordo+1, (TailleMax.Absi*2)+3);
      write("S");
    Fi;
  else
    call SetCursor(22,15);
    write(" Le labyrinthe n'a pas de sortie ... ");
  fi;
  call Normal;
  call SetCursor(23,15);
  write(" Pour revenir au Menu :");
  call Bold;
  write(" Tapez ",chr(17), chr(217));
  call Normal;
  i := inchar;
  kill(curseur);
  kill(p);
END RechChemin;
 
UNIT ChargeLaby : PROCEDURE (output Mat : Matrice);
var i, j : integer;
 
Begin
  Mat := New Matrice;
  open(F,integer,unpack("donnees.lab"));
  call reset(F);
  get(F, Entree.Absi, Entree.Ordo, TailleMax.Absi, TailleMax.Ordo);
  call CreatMat(Mat);
  for i:= 1 to TailleMax.Ordo do
     for j:= 1 to TailleMax.Absi do
       get(F,Mat.A(j,i));
     od;
  od;
  kill(f);
  call AffichageLaby(Mat);
End ChargeLaby;
 
 
UNIT SauveLaby : PROCEDURE ( Entree : couple,
                             TailleMax : couple,
                             mat : matrice;
                             output F : file);
var i, j : integer;
 
BEGIN
  open(F,integer,unpack("donnees.lab"));
  call rewrite(f);
  put(f, Entree.Absi, Entree.Ordo, TailleMax.Absi, TailleMax.Ordo);
  for i:= 1 to TailleMax.Ordo do
    for j:= 1 to TailleMax.Absi do
     put(f,Mat.A(j,i));
    od;
  od;
  kill(f);
END SauveLaby;
 
 
 
 
UNIT CreationLaby : PROCEDURE ( inout mat : matrice);
 
 UNIT CreationChemin : PROCEDURE (inout Mat : Matrice);
   var Curseur : couple,
        I      : integer,
        Erreur : Boolean;
 
   BEGIN
 
    BLOCK; (* Affichage des moyens de deplacement du curseur *)
 
     Begin
 
      Call Bold;
      Call SetCursor(2, 77);
      write("8");
      Call Normal;
      Call SetCursor(3, 77);
      write(chr(30));
      Call Bold;
      Call SetCursor(4, 74);
      write("4");
      Call Normal;
      write(chr(17),"-|-",chr(16));
      Call Bold;
      write("6");
      Call Normal;
      Call SetCursor(5, 77);
      write(chr(31));
      Call Bold;
      Call SetCursor(6, 77);
      write("2");
 
      Call Normal;
      Call SetCursor(22, 10);
      write("Deplacez vous … l'aide des fl‚ches ");
      Call SetCursor(23,15);
      write("Selectionnez l'");
      Call Bold;
      write("Entr‚e");
      Call Normal;
      write(" du labyrinthe ");
      Call SetCursor(24, 15);
      write("Validez avec la touche ");
      Call Bold;
      write(chr(17),chr(217));
 
     End; (* block Affichage des moyens de deplacement du curseur *)
 
 
   BLOCK (* Validation de l'entree du Ladyrinthe *)
 
    Begin
      Entree.Ordo:= 0;
      Entree.absi:= 0;
 
      While NOT ( (Entree.Ordo = 1) Or (Entree.Ordo = TailleMax.Ordo) Or
                  (Entree.Absi = 1) Or (Entree.Absi = TailleMax.Absi) )
      Do
        (* Verification de la conformit‚ de l'entr‚e *)
 
        If Entree.Ordo <> 0
        Then
           Call Normal;
           Call Reverse;
           Call Bold;
           Call SetCursor ( Entree.ordo + 1 , (Entree.Absi*2) + 1 );
           write(chr(88));
           Call Normal;
           Call Bold;
           Call SetCursor ( 25, 10 ) ;
           write ("L'entr‚e S‚lectionn‚e n'est pas conforme ... Recommencez");
        Fi;
 
        Entree.Ordo := 1;
        Entree.Absi := 1;
        Call SetCursor ( 2, 3 );
        write(chr(219));
        Call SetCursor (2, 3);
 
        I := Inchar ;
        Call SetCursor( 25, 10 );
        Call EraseLine;
 
        Call SetCursor (2 , 3);
 
        While (I <> 13)  (* RC *)
        Do
           (* Avant de d‚placer le curseur on reinscrit un mur
              dans la case non validee *)
           Call Reverse;
           write(chr(88)); (* X *)
           Call SetCursor(Entree.ordo + 1 , ( Entree.Absi*2) + 1);
           Call Normal;
           Call Bold;
 
           Case I
           (* Placement de l'entree suivant les touches frappees *)
             When 50 : If Entree.Ordo < TailleMax.Ordo
                       Then
                          (* Bas *)
                          Entree.Ordo := Entree.Ordo + 1;
                       Fi;
             When 52 : If Entree.Absi > 1
                       Then
                          (* Gauche *)
                          Entree.Absi := Entree.Absi - 1;
                       Fi;
             When 54 : If Entree.Absi < TailleMax.Absi
                       Then
                          (* Droite *)
                          Entree.Absi := Entree.Absi + 1;
                       Fi;
             When 56 : If Entree.Ordo > 1
                       Then
                          (* Derriere *)
                          Entree.Ordo := Entree.Ordo - 1;
                       Fi;
            Otherwise  erreur:=True;
           Esac;
 
          (* On Place le curseur Sur les nouvelles coordonnees de l'entree *)
          Call SetCursor(Entree.ordo + 1 , ( Entree.Absi*2) + 1 );
          write(chr(219));
          Call SetCursor(Entree.ordo + 1 , ( Entree.Absi*2) + 1 );
 
          I:= inchar;
        Od;
      Od;
 
      (* Affichage D'un signe au point d'entree  *)
 
      If Entree.Ordo = 1
      Then
         Call SetCursor ( 1, (Entree.Absi*2) + 1 );
         Write("E");
         Call SetCursor ( 1, (Entree.Absi*2) + 1 );
      Fi;
 
      If Entree.Ordo = TailleMax.Ordo
      Then
         Call SetCursor ( Entree.Ordo + 2 , ( Entree.Absi*2 ) + 1 );
         Write("E");
         Call SetCursor ( Entree.Ordo + 2 , ( Entree.Absi*2 ) + 1 );
      Fi;
 
      If Entree.Absi = 1
      Then
         Call SetCursor ( Entree.Ordo + 1, 1);
         Write ("E");
         Call SetCursor ( Entree.Ordo + 1, 1);
      Fi;
 
      If Entree.Absi = TailleMax.Absi
      Then
         Call SetCursor ( Entree.Ordo + 1, (Entree.Absi* 2 ) + 3);
         Write ("E");
         Call SetCursor (Entree.Ordo + 1 , (Entree.Absi* 2) + 3);
      Fi;
 
   End; (* Block Validation de l'entree *)
 
 
   BLOCK (* Affichage des options *)
     Begin
 
      Call SetCursor(10,74);
      write("Espace");
      Call normal;
      Call SetCursor(11, 73);
      write("Restaure");
      Call SetCursor(12, 75);
      write("Mur");
 
      Call SetCursor(23, 15);
      Call EraseLine;
      write("Choisissez les ");
      Call Bold;
      write("Chemins");
      Call Normal;
      write(" du labyrinthe ");
      Call Bold;
      Call SetCursor(Entree.Ordo + 1 , (Entree.Absi*2) + 1 );
 
     End; (* Block Affichage des options *)
 
 
   BLOCK (* Validation du ou des Chemins du Labyrinthe *)
 
     Begin
      (* Positionnement sur le point d'entree *)
      Curseur := New Couple;
      Curseur.Absi := Entree.absi;
      Curseur.Ordo := Entree.ordo;
      Mat.A(Entree.Absi, Entree.Ordo):= 1;
 
      I:= Inchar;
 
      While (I <> 13)
      Do
         (* Creation des chemins *)
 
         (* Affichage de la valeur de la case avant d‚placement du curseur *)
         Call Reverse;
         Call SetCursor(Curseur.Ordo+1, (Curseur.Absi*2) + 1);
         If Mat.A ( Curseur.Absi, Curseur.Ordo ) = 0
         Then
            write ( chr(88) );
         Else
            write(" ");
         Fi;
         Call SetCursor(Curseur.Ordo + 1 , (Curseur.Absi*2) + 1) ;
         Call Normal;
         Call Bold;
 
         Erreur := False;
 
         Case I
           (* Interpretation de la touche frapp‚e *)
           When 50 : If Curseur.Ordo < TailleMax.Ordo
                     Then
                        (* Bas *)
                        Curseur.Ordo := Curseur.Ordo + 1;
                     Else
                        Erreur := True;
                     Fi;
           When 52 : If Curseur.Absi > 1
                     Then
                        (* Gauche *)
                        Curseur.Absi := Curseur.Absi - 1;
                     Else
                        Erreur := True;
                     Fi;
           When 54 : If Curseur.Absi < TailleMax.Absi
                     Then
                        (* Droite *)
                        Curseur.Absi := Curseur.Absi + 1;
                     Else
                        Erreur := True;
                     Fi;
           When 56 : If Curseur.Ordo > 1
                     Then
                        (* Derriere *)
                        Curseur.Ordo:= Curseur.Ordo-1;
                     Else
                        Erreur := True;
                     Fi;
           When 32 : If (Curseur.Ordo = Entree.Ordo) And
                        (Curseur.Absi = Entree.Absi)
                     Then
                        (* On ne peut pas murer l'entree *)
                        Erreur := True;
                     Fi;
           Otherwise
                     Erreur := True;
 
         Esac;
 
         If not Erreur
         Then
            If ( I = 32 ) (*Si on veut murer *)
            Then
               Mat.A(Curseur.Absi,Curseur.Ordo) := 0 ;
            Else
               Mat.A(Curseur.Absi, Curseur.Ordo) := 1;
            Fi;
         Fi;
 
 
         (* Affichage du curseur sur la nouvelle case *)
 
         Call SetCursor (Curseur.Ordo + 1 ,(Curseur.Absi*2) + 1 );
         If Mat.A ( Curseur.Absi, Curseur.Ordo) = 1
         Then
            Write(chr(219));
         Else
            Write (chr(88));
         Fi;
         Call SetCursor(Curseur.Ordo + 1 , (Curseur.Absi*2) + 1 );
 
         I:= Inchar;
 
      Od;
 
      Call SetCursor (Curseur.Ordo + 1, (Curseur.Absi * 2) + 1);
      Call Reverse;
      If Mat.A ( Curseur.Absi, Curseur.Ordo) = 1
      Then
        write ("  ");
      Else
        write ( chr(88));
      Fi;
      Call SetCursor (Curseur.Ordo + 1, (Curseur.Absi * 2) + 1);
      Call Normal;
 
     End ; (* Block Validation des chemins *)
 
   END CreationChemin;
 
  BEGIN (* creation labyrinthe *)
 
    Call Newpage;
    TailleMax.Ordo:=0;
    TailleMax.Absi:=0;
 
    While (TailleMax.Ordo < 1) Or (TailleMax.Ordo > 20) Or
          (TailleMax.Absi < 1) Or (TailleMax.Absi > 30)
    Do
       (* Lecture de la taille du labyrinthe *)
       writeln(" Entrez la hauteur du labyrinthe ");
       write(" comprise entre 1 et 20 : ");
       readln(TailleMax.Ordo);
       writeln;
       writeln(" Entrez la largeur du labyrinthe");
       write(" comprise entre 1 et 30 : ");
       readln(TailleMax.Absi);
       writeln;
    Od;
 
    Call CreatMat(mat);
    Call InitMat(Mat);
    Call AffichageLaby(Mat);
 
    Call CreationChemin(Mat);
    call SetCursor(25,1);
    write(" Le labyrinthe cr‚e est sauvegard‚ dans le fichier DONNEES.LAB ... ");
 
  END CreationLaby;
 
UNIT Menu : PROCEDURE (output Choix : char);
 
BEGIN
  call NewPage;
  call Reverse;
  call Underscore;
  call SetCursor(5,32);
  write(" MENU ");
  call Normal;
  call Bold;
  call SetCursor(9,20);
  write("1");
  call Normal;
  call SetCursor(9,22);
  write("- Cr‚ation d'un labyrinthe. ");
  call Bold;
  call SetCursor(12,20);
  write("2");
  call Normal;
  call SetCursor(12,22);
  write("- Chargement d'un labyrinthe.");
  call Bold;
  call SetCursor(15,20);
  write("3");
  call Normal;
  call SetCursor(15,22);
  write("- Sortie du programme.");
  call Bold;
  call SetCursor(19,30);
  write("Choix : ");
  call Normal;
  call SetCursor(22,20);
  write("Validez votre choix avec ");
  call Bold;
  write(chr(17),chr(217));
  call SetCursor(19,38);
  readln(choix);
  while (ord(Choix) <> 49) AND (ord(Choix) <> 50) AND (ord(Choix) <> 51) do
    call Bold;
    call SetCursor(24,10);
    write("Choix incorrect ");
    call Normal;
    call SetCursor(19,38);
    Readln(Choix);
  od;
 
END Menu;
 
BEGIN (* Programme principal *)
 
  SortieProg:= false;
  while not SortieProg do
    call Menu(choix);
    case ord(choix)
      when 49 :  Mat := New Matrice;
                 Entree := New Couple;
                 TailleMax := New Couple;
                 call CreationLaby(mat);
                 call SauveLaby(Entree, TailleMax, Mat, F);
                 call RechChemin(Mat);
                 Kill(Mat.A);
                 Kill(Mat);
                 kill(entree);
                 kill(TailleMax);
 
      when 50 :  Mat := New Matrice;
                 Entree := New Couple;
                 TailleMax := New Couple;
                 call ChargeLaby(Mat);
                 call RechChemin(Mat);
                 Kill(Mat.A);
                 kill(Mat);
                 kill(Entree);
                 kill(TailleMax);
 
      when 51 :  SortieProg := True;
    esac;
  od;
  end; (* End iiuwgraph *)
 
END; (* End Programme *)