Program Evaluationdepropositionslogiques;
 
(********************************************)
(*           ARDANTZ  Jean-Michel           *)
(*           CAZAUBON Eric                  *)
(*           TOURNIER Vincent               *)
(********************************************)
 
Const moinsun = -1,
      moins59 = -59,
      moins60 = -60,
      moins61 = -61,
      moins62 = -62,
      moins68 = -68;
Var ch                  : Chaine,
    l                   : Liste,
    e                   : Elem,
    racine              : Noeud,
    i,longueur,xx,y,Z   : Integer,
    H                   : Boolean,
    Valeur              : ArrayOf Char,
    Courant,Diagramme,X : Node;
 
 
(******************************************)
(*   Lecture d'une chaine de caracteres   *)
(******************************************)
 
(*  Cette classe lit une chaine de caractŠres  *)
(*  et la met dans un tableau "Valeur"            *)
 
Unit Chaine : Class;
Var c,d : integer,
    i,X : Integer;
Begin
Pref IIUWGRAPH Block
Begin
    X:=110+(longueur*8);
    i := 1+longueur;
    C:=0 ;
    do
       Call Color (12) ;
       C := 0 ;
       while C=0
       Do
         Call Texte(X,184,0," ");
         c:=inkey;
         Call Texte(X,184,15,"-");
       Od;
       Call Color (12) ;
       Call move(X,180) ;
       If (c=97)or(c=98)or(c=99)or(c=100)or(c=120)or(c=121)
          or(c=122)or(c=40)or(c=41)
       Then d:=c;
            c:=0;
       Fi;
       Case C
       When 13 :
                 Exit ;
       When moins59 :
              If X < 486 Then
                      Call dessine_et(X,180);
                      valeur(i):='&' ;
                      i:=i+1 ;
                      X:=X+8 ;
              Fi;
       When moins60 :
              If X < 486 Then
                      Call dessine_ou(X,180);
                      valeur(i):='%' ;
                      i:=i+1 ;
                      X:=X+8 ;
              Fi;
       When moins61 :
              If X < 486 Then
                      Call dessine_implique(X,180);
                      valeur(i):='>' ;
                      i:=i+1 ;
                      X:=X+8 ;
              Fi;
       When moins62 :
              If X < 486 Then
                      Call dessine_non(X,180);
                      valeur(i):='|' ;
                      i:=i+1 ;
                      X:=X+8 ;
              Fi;
       When moins68 :
            Call groff;
            Writeln;
            Writeln("    pa pa !   ");
            Call Endrun;
       When 8 : If X > 110 Then
                  i:=i-1;
                  X:=X-8;
                  Call move(X,180);
                  Call Hascii(0);
                  Call texte(X,184,15,"-");
                  Call move(X,180);
                Fi;
       When 0 :
           If X < 486 Then
              Call Hascii (0) ;
              Call Hascii (d);
              valeur(i):=chr(d);
              i:=i+1;
              X:=X+8;
           Fi;
       Otherwise
           Call texte(105,258,15,"CaractŠre ill‚gal");
           Call texte(105,274,15,"Appuyez sur une touche pour continuer");
           while inkey=0 do od;
           Call Fill (101,251,398,38,0) ;
           Call move(110+(longueur*8),180);
       esac;
       if i=48 then
       Call texte(105,258,15,"Chaine trop longue ");
       Call texte(105,274,15,"Appuyez sur une touche pour continuer");
       while inkey=0 do od;
       Call Fill (101,251,398,38,0) ;
       Call move(110+(longueur*8),180);
       fi;
    od;
    longueur:=i-1;
End;
End Chaine;
 
(************************************************)
(*              Analyseur lexical               *)
(************************************************)
 
(*  Ces deux proc‚dures v‚rifient la validit‚   *)
(*  syntaxique de la chaine                     *)
 
Unit Evolution : procedure(inout etat:Integer; inout nbre:Integer;
                           inout nbcar:Integer; input c:Char);
Begin
  case etat
     when 1 : case c
                when '(' : nbcar := 0;
                           nbre:=nbre+1;
                           etat := 1 ;
                when 'a','b','c','d','x','y','z' : nbcar := nbcar + 1;
                                   etat := 2 ;
                when '|' : etat := 3 ;
                otherwise etat := 0;
              esac;
     when 2 : case c
                when '&','%','>' : etat := 1 ;
                when ')' : nbcar := 0;
                           nbre:=nbre-1;
                           etat := 2 ;
                otherwise etat := 0;
              esac;
     when 3 : case c
                when '(' : nbre:=nbre+1;
                           etat := 1 ;
                otherwise etat := 0;
              esac;
  esac;
End Evolution;
 
 
(*La fonction analyseur retourne un booleen selon que la formule
  propositionnel est correcte ou non *)
 
 
Unit Analyseur : function(longueur : Integer) : Boolean;
Var etat,nbre,nbcar,i : Integer,
    b : boolean,
    c : Char;
Begin
  B:=False;
  etat:=1;
  nbre:=0;
  nbcar:=0;
  i:=1;
  while (( etat > 0 ) and (i <= longueur ))
    do
      c := valeur(i);
      If C='>' Or C='&' Or C='%' Or C='|' Then B:=True; Fi;
      call Evolution(etat,nbre,nbcar,c);
      if nbcar>2 then
         etat := -1;
      fi;
      i := i+1;
    Od;
  result:=false;
  If Not B Then
     Call Texte(105,266,15,"Erreur de s‚mantique");
  Else
     case etat
       when 0 : Call texte(105,266,15,"Erreur de syntaxe");
       when moinsun : Call texte(105,266,15,
                "Chaine incorrecte, parenth‚sez vos expressions !");
       otherwise if nbre < 0 then
                    Call texte(105,266,15,
                    "Chaine incorrecte, caractŠre(s)  (  absent(s)");
                 else if nbre > 0 then
                         Call texte(105,266,15,
                      "Chaine incorrecte, caractŠre(s)  )  absent(s)");
                      fi;
                  fi;
     esac;
     If ((etat > 0) and (nbre=0)) then
        Call texte(105,266,15,"Chaine correcte");
        result:=true;
     Fi;
  Fi;
End Analyseur;
 
(***********************************************)
(*           Impl‚mentation de la pile         *)
(***********************************************)
 
Unit Unepile : Class(type telem);
Var p1,p2 : Pile;
 
   Unit Link : Class;
   Var next : Link,
       valeur : telem;
   End Link;
 
   Unit Pile : Class;
   Var top : Link;
   End Pile;
 
   Unit Push : Function (E : Telem ; S : Pile) : Pile;
   Var aux : Link;
   Begin
      aux := New Link;
      aux.valeur := E;
      if Empty_Pile(S)
      then
           aux.next := None;
      else
           aux.next := S.top;
      fi;
      Result := New Pile;
      result.top := aux;
   End Push;
 
   Unit Empty_Pile : Function (S : Pile) : Boolean;
   Begin
      Result := (S=None);
   End Empty_Pile;
 
   Unit Top : Function (S : Pile) : Telem;
   Begin
      Result := S.top.valeur;
   End Top;
 
   Unit Down : Function (S : Pile) : Pile;
   Begin
       if s.top.next <> none
       then Result := New Pile;
            Result.top := S.top.next;
       else
            Result:=none;
       fi;
   End Down;
 
End Unepile;
 
(************************************************)
(*     Recherche des operateurs principaux      *)
(************************************************)
 
(*   Cette proc‚dure construit l'arbre associ‚  *)
(*   la formule entr‚e par l'utilisateur        *)
 
Unit Elem : Class;
     Var Valeur:Char;
End Elem;
 
 
Unit Noeud : Class;
Var left , right : Noeud,
    Valeur : Char ;
End Noeud ;
 
 
Unit Operateur : procedure(longueur : Integer; output racine : Noeud);
Var i : Integer,
    n,p,ng,nd : Noeud,
    up1,up2 : UnePile,
    e,aux : Elem,
    c : Char;
 
Begin
 
up1 := new UnePile(Noeud);
up2 := new UnePile(Elem);
for i:=1 to longueur
do
 
c:=valeur(i);
case c
     When 'a','b','c','d','x','y','z' : n := New Noeud;
                        n.valeur := c;
                        up1.p1 := up1.Push(n,up1.p1);
     when '&','%','>','|' : e := new elem;
                            e.valeur := c;
                            up2.p2 := up2.Push(e,up2.p2);
     when ')' : if not up2.Empty_Pile(up2.p2)
                then
                     aux := up2.top(up2.p2);
                     up2.p2 := up2.down(up2.p2);
                     nd := up1.top(up1.p1);
                     up1.p1 := up1.down(up1.p1);
                     if aux.valeur <> '|'
                     then ng := up1.top(up1.p1);
                          up1.p1 := up1.down(up1.p1);
                     else
                          ng := none;
                     fi;
                     p := new Noeud;
                     p.left := ng;
                     p.right := nd;
                     p.valeur := aux.valeur;
                     up1.p1 := up1.push(p,up1.p1);
                fi;
esac;
od;
if not up2.Empty_Pile(up2.p2)
then aux := up2.top(up2.p2);
     up2.p2 := up2.down(up2.p2);
     nd := up1.top(up1.p1);
     up1.p1 := up1.down(up1.p1);
     if aux.valeur <> '|' then
        ng := up1.top(up1.p1);
        up1.p1 := up1.down(up1.p1);
     else
        ng := none;
     fi;
     p := new Noeud;
     p.left := ng;
     p.right := nd;
     p.valeur := aux.valeur;
fi;
racine := p;
End;
 
 
 
 
(************************************************)
(*           Impl‚mentation de la liste         *)
(************************************************)
 
(*   Cette impl‚mentation de liste permettra    *)
(*   d'ins‚rer les variables en fin de liste    *)
(*   et les op‚rateurs au d‚but                 *)
 
Unit Node : Class ;
     Var Val: Sequence ,
     Left, Right: Node ;
End Node;
 
Unit Sequence : Class;
     Var Gauche, Droite: Liste ;
End Sequence;
 
Unit Liste : Class;
Var Debut: Noeud,
    suivant : Liste;
End Liste;
 
 
Unit Empty_Liste : function(l:Liste) : Boolean;
Begin
   result := l=none;
End Empty_Liste;
 
 
Unit Insert : Function (E:Noeud;L:Liste) : Liste ;
Var l1,aux : Liste;
Begin
    If Empty_Liste(l)
    Then L := new Liste;
         L.Debut:=New Noeud;
         L.Debut := E;
    Else
         l1:=L;
         aux:=new Liste ;
         If E.Valeur<>'|' Andif E.Valeur<>'%'
            Andif E.Valeur<>'&' Andif E.Valeur<>'>'
         Then
              Aux.Debut := E ;
              While L1.Suivant <> None
              Do
                l1 := L1.Suivant ;
              Od ;
              L1.Suivant := Aux ;
         Else
              Aux.Debut := E ;
              Aux.Suivant := L ;
              L := Aux ;
         Fi ;
    Fi;
    Result := L ;
 
End Insert;
 
 
Unit Delete : Function(L:Liste): Liste;
Begin
     Result := L.suivant;
End Delete;
 
 
(************************************************************)
(*  Procedures de d‚composition d'une expression bool‚enne  *)
(************************************************************)
 
(*     Ces proc‚dures permettent de d‚composer la liste     *)
(*     initiale gr…ce … la m‚thode de GENTZEN de maniŠre     *)
(*     … n'obtenir que des variables aux feuilles           *)
 
 
 
Unit Copie_Liste : Function (L:Liste) : Liste ;
Var Der,Aux:Liste ;
Begin
     Result := New Liste ;
     if L<>None Then Der := New Liste ;
                     Der := Copy (L) ;
                     l := L.Suivant ;
     Fi ;
     Result := Der ;
     While L <> None
     Do
       Aux := New Liste ;
       Aux := Copy (L) ;
       Der.Suivant := Aux ;
       L := L.Suivant ;
       Der :=Aux ;
     Od ;
End Copie_Liste ;
 
 
 
Unit Op_Negation_G : Procedure(Input Racine:Noeud;Inout D:Node) ;
Var L,R : Liste ,
    X   : Node ;
Begin
 
     X := new Node ;
     X.Val := New Sequence ;
     L := Copie_Liste (D.Val.Gauche) ;
     R := Copie_Liste (D.Val.Droite) ;
     L := Delete (L) ;
     R := Insert (Racine.Right,R) ;
     X.Val.Droite:=Copie_Liste (R);
     X.Val.Gauche:=Copie_Liste (L) ;
     D.Right:=New Node;
     D.Right:=X;
     Kill (L) ;
     Kill (R) ;
 
End Op_Negation_G ;
 
 
Unit Op_Alternative_G : Procedure(Input Racine:Noeud;Inout D:Node ) ;
Var L,S : Liste ,
    X,Y : Node ;
Begin
 
     X := new Node ;
     X.Val := New Sequence ;
     Y := new Node ;
     Y.Val := New Sequence ;
     X.Val.Droite:= Copie_Liste (D.Val.Droite) ;
     Y.Val.Droite:= Copie_Liste (D.Val.Droite) ;
     l := Copie_Liste (D.Val.Gauche) ;
     L := Delete (L) ;
     S := Copie_Liste (L) ;
     L := Insert (Racine.Left,L) ;
     S := Insert (Racine.Right,S) ;
     X.Val.Gauche:= Copie_Liste (L) ;
     Y.Val.Gauche:= Copie_Liste (S) ;
     D.Left := New Node ;
     D.Right := New Node ;
     D.Left:= X ;
     D.Right:= Y ;
     Kill (L) ;
     Kill (S) ;
 
End Op_Alternative_G ;
 
Unit Op_Conjonction_G : Procedure (Input Racine:Noeud;Inout D : Node);
Var L : Liste ,
    X   : Node;
Begin
      X := new Node ;
      X.Val := New Sequence ;
      L := Copie_Liste (D.val.Gauche) ;
      L := Delete (L) ;
      L := Insert (Racine.Left,L) ;
      L := Insert (Racine.Right,L) ;
      X.Val.Gauche:=Copie_Liste (L) ;
      X.Val.Droite:=Copie_Liste (D.Val.Droite) ;
      D.Right:=New Node ;
      D.Right:=X ;
      Kill (L) ;
 
End Op_Conjonction_G ;
 
Unit Op_Implique_G : Procedure (Input Racine:Noeud;Inout D:Node ) ;
Var L,R : Liste ,
    X,Y : Node ;
Begin
      X := new Node ;
      X.Val := New Sequence ;
      Y := new Node ;
      Y.Val := New Sequence ;
      L := Copie_Liste (D.Val.Gauche) ;
      R := Copie_Liste (D.Val.Droite) ;
      X.val.Droite := Copie_Liste (R) ;
      L := Delete (L) ;
      Y.Val.Gauche := Copie_Liste (L) ;
      Y.Val.Droite := Copie_Liste (Insert (Racine.Left,R)) ;
      X.Val.Gauche := Copie_Liste (Insert (Racine.Right,L)) ;
      D.Left := New Node ;
      D.Right := New Node ;
      D.Left := X ;
      D.Right := Y ;
      Kill (L) ;
      Kill (R) ;
 
End Op_Implique_G ;
 
 
Unit Op_Negation_D : Procedure(Input Racine:Noeud; Inout D : Node ) ;
Var L,R : Liste ,
    X   : Node ;
Begin
 
      X := new Node ;
      X.Val := New Sequence ;
      L := Copie_Liste (D.Val.Gauche) ;
      R := Copie_Liste (D.val.Droite) ;
      L := Insert (Racine.Right,L) ;
      R := Delete (R) ;
      X.Val.Droite:=Copie_Liste (R);
      X.Val.Gauche:=Copie_Liste (L) ;
      D.Right := New Node ;
      D.Right:=X;
      Kill (L) ;
      Kill (R) ;
 
End Op_Negation_D ;
 
 
Unit Op_Alternative_D : Procedure(Input Racine:Noeud;Inout D:Node ) ;
Var R : Liste ,
    X : Node ;
Begin
 
      X := new Node ;
      X.Val := New Sequence ;
      R := Copie_Liste (D.Val.Droite) ;
      R := Delete (R) ;
      R := Insert (Racine.Left,R) ;
      R := Insert (Racine.Right,R) ;
      X.Val.Gauche := Copie_Liste (D.Val.Gauche) ;
      X.Val.Droite := Copie_Liste (R) ;
      D.Right := New Node ;
      D.Right := X ;
      Kill (R) ;
 
End Op_Alternative_D ;
 
 
Unit Op_Conjonction_D : Procedure (Input Racine:Noeud;
                                   Inout D : Node) ;
Var S,R : Liste ,
    X,Y   : Node ;
Begin
 
      X := new Node ;
      X.Val := New Sequence ;
      Y := new Node ;
      Y.Val := New Sequence ;
      R := Copie_Liste (D.Val.Droite) ;
      R := Delete (R) ;
      S := Copie_Liste (R) ;
      S := Insert (Racine.Left,S) ;
      R := Insert (Racine.Right,R) ;
      X.Val.Gauche := Copie_Liste (D.Val.Gauche) ;
      X.Val.Droite := Copie_Liste (S) ;
      Y.val.Gauche := Copie_Liste (D.Val.Gauche) ;
      Y.Val.Droite := Copie_Liste (R) ;
      D.Left := New Node ;
      D.Right := New Node ;
      D.Left := X ;
      D.Right := Y ;
      Kill (R) ;
      Kill (S) ;
 
End Op_Conjonction_D ;
 
 
Unit Op_Implique_D : Procedure (Input Racine:Noeud;Inout D:Node ) ;
Var L,R : Liste ,
    X   : Node ;
Begin
 
      X := new Node ;
      X.Val := New Sequence ;
      L := Copie_Liste (D.Val.Gauche) ;
      R := Copie_Liste (D.val.Droite) ;
      X.Val.Gauche := Copie_Liste (Insert (Racine.Left,L)) ;
      R := Delete (R) ;
      X.Val.Droite := Copie_Liste (Insert (Racine.Right,R)) ;
      D.Right := New Node ;
      D.Right := X ;
      Kill (L) ;
      Kill (R) ;
 
End Op_Implique_D ;
 
 
Unit Trait_List_G : Procedure (Racine:Noeud;Inout D:Node);
Begin
 
     Case Racine.Valeur
          When '|' : Call Op_Negation_G (Racine,D) ;
          When '%' : Call Op_Alternative_G (Racine,D) ;
          When '&' : Call Op_Conjonction_G (Racine,D) ;
          When '>' : Call Op_Implique_G (Racine,D) ;
     Esac;
 
End trait_List_G ;
 
Unit Trait_List_D : Procedure (Racine:Noeud;Inout D:Node);
 
Begin
 
     Case Racine.Valeur
          When '|' : Call Op_Negation_D (Racine,D) ;
          When '%' : Call Op_Alternative_D (Racine,D) ;
          When '&' : Call Op_Conjonction_D (Racine,D) ;
          When '>' : Call Op_Implique_D (Racine,D) ;
     Esac;
 
End trait_List_D ;
 
 
 
 
Unit Decompose : Procedure (Inout Diagramme : Node);
Var D,X,Y:Node,
    Courant,L : Liste ,
    Fin,Trouve : Boolean ,
    Racine : Noeud ;
Begin
    D := Diagramme ;
    If D<>None
    Then
       If D.Val.Gauche<>None AndIf (D.Val.Gauche.Debut.Valeur='&'
                                 Or D.Val.Gauche.Debut.Valeur='%'
                                 Or D.Val.Gauche.Debut.Valeur='>'
                                 Or D.Val.Gauche.Debut.Valeur='|')
       Then
            Racine := Copy (D.Val.Gauche.Debut) ;
            Call Trait_List_G (Racine,D) ;
 
       Else
       If D.Val.Droite<>None AndIf (D.Val.Droite.Debut.Valeur='&'
                                    Or D.Val.Droite.Debut.Valeur='%'
                                    Or D.Val.Droite.Debut.Valeur='>'
                                    Or D.Val.Droite.Debut.Valeur='|')
            Then Racine := Copy (D.Val.Droite.Debut) ;
                 Call Trait_List_D (Racine,D) ;
            Fi ;
       Fi;
       WriteLn ;
       Call Decompose (D.Left) ;
       Call Decompose (D.right) ;
       Diagramme := D ;
    Fi ;
End Decompose ;
 
 
 
Unit Parcours_Arbre_Right : Procedure(racine : Noeud;Sens,I,J:Integer;
                                      Inout Z:Integer);
Var P : Noeud ;
Begin
Pref IIUWGRAPH Block
Begin
   p:=racine;
   If p <> none Then
      If P.Left<>None
      Then Call Move (I+8*Z,J) ;
           Call Hascii (0) ;
           Call Hascii (40) ;
           Z:=Z+1 ;
      Fi ;
      Call Parcours_Arbre_Right(p.Left,Sens,I,J,Z);
      Call Move (I+8*Z,J);
      Call Hascii (0) ;
      Case P.Valeur
           When '&' : Call dessine_et(I+8*Z,J);
           When '%' : Call dessine_ou(I+8*Z,J);
           When '>' : Call dessine_implique(I+8*Z,J);
           When '|' : Call dessine_non(I+8*Z,J);
           otherwise  Call Hascii(Ord(P.Valeur));
      esac;
      Z:=Z+1;
      If P.Valeur='|'
      Then Call Move (I+8*Z,J) ;
           Call Hascii (0) ;
           Call Hascii (40) ;
           Z:=Z+1 ;
      Fi;
      call parcours_Arbre_Right(p.Right,Sens,I,J,Z);
      If P.Right<>None Or P.Valeur='|'
      Then Call Move (I+8*Z,J) ;
           Call Hascii (0) ;
           Call Hascii (41) ;
           Z:=Z+1 ;
      Fi ;
  Fi ;
End;
End Parcours_Arbre_Right;
 
 
 
Unit Parcours_Arbre_Left : procedure(racine : Noeud;Sens,I,J:Integer;
                                     InOut Z:Integer);
Var P : Noeud ;
Begin
Pref IIUWGRAPH Block
Begin
   p:=racine;
   If p <> none Then
      If P.Left<>None Or P.Valeur='|'
      Then Call Move (I+8*Z,J) ;
           Call Hascii (0) ;
           Call Hascii (41) ;
           Z:=Z-1 ;
      Fi ;
      Call parcours_Arbre_Left(p.Right,Sens,I,J,Z);
      If P.Valeur='|'
      Then Call Move (I+8*Z,J) ;
           Call Hascii (0) ;
           Call Hascii (40) ;
           Z:=Z-1 ;
      Fi;
      Call Move (I+8*Z,J);
      Call Hascii (0) ;
      Case P.Valeur
           When '&' : Call dessine_et(I+8*Z,J);
           When '%' : Call dessine_ou(I+8*Z,J);
           When '>' : Call dessine_implique(I+8*Z,J);
           When '|' : Call dessine_non(I+8*Z,J);
           otherwise  Call Hascii(Ord(P.Valeur));
      esac;
      Z:=Z-1;
      Call parcours_Arbre_Left(p.Left,Sens,I,J,Z);
      If P.Right<>None And P.Valeur<>'|'
      Then Call Move (I+8*Z,J) ;
           Call Hascii (0) ;
           Call Hascii (40) ;
           Z:=Z-1 ;
      Fi ;
  Fi ;
End;
End Parcours_Arbre_Left;
 
 
 
Unit Affiche_Liste : Procedure (Input L:Liste;I,J,Sens:Integer );
Var Z : Integer ;
Begin
  Pref IIUWGRAPH Block
  Begin
       Call color(12);
       Call Move (I,J) ;
       Call dessine_fleche(I,J);
       Z:=0;
       Call color(15);
     If L=None
     Then Call Move(I+Sens,J);
          Call dessine_vide(I+sens,J);
     Fi ;
     While L<>None
     Do
       Z:=0;
       I:=I+Sens;
       Call Move (I,J) ;
       If Sens =-8
       Then Call Parcours_Arbre_Left (L.Debut,Sens,I,J,Z);
       Else Call Parcours_Arbre_Right(L.Debut,Sens,I,J,Z);
       Fi ;
       L := L.Suivant ;
       If L<>None
       Then I:=I+8*Z;
            Call Move (I,J);
            Call Hascii (0) ;
            Call Hascii (44);
       Fi ;
     Od ;
  End;
End Affiche_Liste ;
 
 
Unit Parcours : Procedure(Racine:Node;X,Y,Z:integer);
Var P : Node ;
Begin
  Pref IIUWGRAPH Block
  Begin
   P := Racine;
   If P <> None Then
      Call Affiche_Liste (P.Val.Gauche,X,Y,-8) ;
      Call Affiche_Liste (P.Val.Droite,X,Y,+8) ;
      Call Parcours(P.Left,X-Z,Y+32,Z/2) ;
      If P.Left<>None Then Call color(11);
                           Call Move (X,Y+8) ;
                           Call Draw (X-Z,Y+30) ;
                           Call Move (X,Y+8) ;
                           Call Draw (X+Z,Y+30) ;
                           Call color(15);
                           Call Parcours(P.Right,X+Z,Y+32,Z/2) ;
                      Else If P.Right<>None
                           Then Call color(11);
                                Call Move (X,Y+8) ;
                                Call Draw (X,Y+30) ;
                                Call color(15);
                           Fi ;
                           Call Parcours(P.Right,X,Y+32,Z/2) ;
      Fi;
   Fi;
  End;
End Parcours;
 
 
(****************************************************)
(*  Evaluation de la Tautologicit‚ de la formule    *)
(****************************************************)
 
 
Unit Recherche_Tautologie : Procedure(Left,Right:Liste;X,Y,Z:Integer;
                                      OutPut H:Boolean) ;
Var Element : Char,
    Large,Xx: Integer,
    Totaul  : Boolean,
    L,R     : Liste;
 
Begin
     Totaul := False ;
     Large := 24;
     Xx:=x;
     X := X-8;
     H := False ;
     L := Copie_Liste (Left);
     R := Copie_Liste (Right);
     If (Left=None) Or (Right=None)
     Then
          call texte(150,Y+20,11,
               "Cette expression n'est pas une tautologie.") ;
     Else Element := Left.Debut.valeur ;
          Do
            Do
              If Element = Right.Debut.Valeur Then Exit; Fi;
              Right := Right.Suivant ;
              If Right = None Then Exit; Fi;
            Od;
            If Right<>None Then
                     call texte(150,Y+20,11,
                     "Cette expression est une tautologie.");
                                Totaul:=True ;
                                H := True ;
            Fi ;
            If Totaul Then Exit; Fi;
            Left := Left.Suivant ;
            If Left = None Then
                call texte(150,Y+20,11,
                "Cette expression n'est pas une tautologie.");
                                Exit;
            Fi;
            Right := Copie_Liste(R);
          Od;
     Fi ;
     If Not Totaul
     Then While L<>None
          Do L:=L.Suivant ;
             If L<>None Then X:=X-16;
                             Large:=Large+16;
             Fi;
         Od;
         While R<>None
          Do R:=R.Suivant ;
             If R<>None Then Large:=Large+16;
             Fi;
         Od;
         Call Rectangle (X-1,Y,Large+2,8,15) ;
     Fi;
 
End Recherche_Tautologie;
 
 
Unit Affiche_Feuille:Procedure (D:Node;X,Y,Z:Integer;Inout H:Boolean);
Begin
     If D<>None
     Then If Not H Then Return;
          Fi;
          Call Affiche_Feuille (D.Left,X-Z,Y+32,Z/2,H) ;
          If D.Left<>None
          Then Call Affiche_Feuille (D.Right,X+Z,Y+32,Z/2,H) ;
          Else Call Affiche_Feuille (D.Right,X,Y+32,Z/2,H) ;
          Fi ;
          If (D.Left=None) And (D.Right=None)
          Then
          Call Recherche_Tautologie(D.Val.Gauche,D.Val.Droite,X,Y,Z,H);
          Fi ;
     Fi;
End Affiche_Feuille ;
 
 
(************************************)
(*      Proc‚dures Graphiques       *)
(************************************)
 
 
 
Unit Rectangle : Procedure (X,Y,Large,Haut,Col:Integer) ;
Begin
Pref IIUWGRAPH Block
Begin
     Call Color(Col) ;
     Call Move (X,Y) ;
     Call Draw (X+Large,Y) ;
     Call Draw (X+Large,Y+Haut) ;
     Call Draw (X,Y+haut) ;
     Call Draw (X,Y) ;
End ;
End ;
 
 
 
Unit Fill : Procedure (X,Y,Large,Haut,Col:Integer) ;
Var I:Integer ;
Begin
Pref IIUWGRAPH Block
Begin
     Call Color (Col) ;
     For I:=Y To Y+Haut
     Do
       Call Move(X,I) ;
       Call Draw(X+Large,I) ;
     Od ;
End ;
End ;
 
 
Unit Texte : Procedure (X,Y,col : integer; s : string);
Begin
Pref IIUWGRAPH Block
Begin
     Call Color (Col) ;
     Call Move (X,Y);
     Call outstring(s);
End ;
End ;
 
 
Unit dessine_et : Procedure(X,Y : integer);
Begin
Pref IIUWGRAPH Block
Begin
   Call Hascii(0);
   Call move(X,Y+6);
   Call draw(X+3,Y+2);
   Call draw(X+6,Y+6);
End;
End;
 
 
Unit dessine_ou : Procedure(X,Y : integer);
Begin
Pref IIUWGRAPH Block
Begin
   Call Hascii(0);
   Call move(X,Y+2);
   Call draw(X+3,Y+6);
   Call draw(X+6,Y+2);
End;
End;
 
 
Unit dessine_implique : Procedure(X,Y : integer);
Begin
Pref IIUWGRAPH Block
Begin
   Call Hascii(0);
   Call move(X,Y+2);
   Call draw(X+4,Y+2);
   Call move(X,Y+4);
   Call draw(X+4,Y+4);
   Call move(X+3,Y);
   Call draw(X+6,Y+3);
   Call draw(X+3,Y+6);
 
End;
End;
 
 
Unit dessine_non : Procedure(X,Y : integer);
Begin
Pref IIUWGRAPH Block
Begin
   Call Hascii(0);
   Call move(X+1,Y);
   Call draw(X+3,Y);
   Call draw(X+3,Y+6);
End;
End;
 
 
Unit dessine_vide : Procedure(X,Y : integer);
Begin
Pref IIUWGRAPH Block
Begin
   Call Hascii(0);
   Call cirb(X+3,Y+4,3,0,0,15,0,1,1);
   Call move(X,Y+7);
   Call draw(X+8,Y);
End;
End;
 
 
Unit dessine_fleche : Procedure(X,Y : integer);
Begin
Pref IIUWGRAPH Block
Begin
   Call Hascii(0);
   Call move(X+1,Y+4);
   Call draw(X+7,Y+4);
   Call move(X+4,Y+1);
   Call draw(X+7,Y+4);
   Call draw(X+4,Y+7);
End;
End;
 
 
(********************************)
(*      Programe Principal      *)
(********************************)
 
Begin
     array valeur dim(1:47);
     Pref IIUWGRAPH Block
     Begin
       Call Gron (0) ;
       Do
         Call Cls ;
         Call Rectangle (120,10,344,40,15);
         Call Rectangle (125,51,345,6,15);
         Call Rectangle (465,15,6,42,15);
         Call Fill (126,51,344,5,9);
         Call Fill (465,16,5,37,9);
         Call texte(121,27,15,
                    "    EVALUATION DE PROPOSITIONS LOGIQUES   ");
         Call Rectangle (100,150,400,72,15) ;
         Call move(100,200);
         Call draw(500,200);
         Call Rectangle (144,200,44,22,15);
         Call Rectangle (232,200,44,22,15);
         Call texte(105,208,12,"F1:");
         Call dessine_et(131,208);
         Call texte(149,208,12,"F2:");
         Call dessine_ou(175,208);
         Call texte(193,208,12,"F3:");
         Call dessine_implique(219,208);
         Call texte(237,208,12,"F4:");
         Call dessine_non(263,208);
         Call texte(285,208,12,"Variables : a,b,c,d,x,y,z");
         Call texte(105,160,15,"Entrez la proposition : (");
         Call texte(308,160,12,"F10 ");
         Call texte(340,160,15,"pour quitter)");
         Call texte(110,184,15,
                   "------------------------------------------------");
         Call Rectangle (100,250,400,60,15) ;
         Call Move (100,290) ;
         Call Draw (500,290) ;
         Call Texte (225,297,12,"Fenˆtre de messages");
         Call Move(110,180);
         longueur:=0;
 
  Do
    Ch := New Chaine;
    If Analyseur(Longueur) Then
       Call texte(153,280,15,"Appuyez sur une touche pour continuer");
       while inkey=0 do od;
       Exit;
    else
       Call texte(153,280,15,"Appuyez sur une touche pour continuer");
       while inkey=0 do od;
       Call Fill (101,251,398,38,0) ;
       Call move(110+(longueur*8),180);
    Fi;
  Od;
 
  call cls ;
  call color(15);
  H := True ;
  i:=1;
  call Operateur(longueur,racine);
  xx :=320;
  Y := 80;
  Z:=256;
  Diagramme := New Node;
  Diagramme.Val := New Sequence ;
  Diagramme.Val.Droite := Insert (Racine,Diagramme.Val.Droite) ;
  Courant := Diagramme ;
  Call decompose(Diagramme) ;
  Call texte(105,32,12,
       "Evolution de la formule suivant la methode de GENTZEN") ;
  Call texte(97,40,12,
       "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ") ;
  Call color(15);
  Call parcours(Courant,xx,y,Z);
  Call texte(130,320,12,"Appuyez sur une touche pour continuer");
  While inkey=0 do od;
  Call Texte(130,320,12,"                                     ");
  Call Affiche_Feuille (Diagramme,320,80,256,H) ;
  While inkey=0 do od;
Od;
  Call Groff;
End ;
End Evaluationdepropositionslogiques;