(*************************************************************)
(**                                                         **)
(**                 PROGRAMME   MINI-SE                     **)
(**                                                         **)
(*************************************************************)

program mini_se;

uses
  crt, printer;

(******************************************************)
(**         Declarations des types                   **)
(******************************************************)

type
  chaine = string[50];
  pcell = ^cell;
  tetat = (vrai, faux, indetermine, inconnu);

  taffirmation = record
    fait: pcell;
    etat: tetat;
  end;

  tfait = record
    libelle: chaine;
    etat: tetat;
    editable: boolean;
    demandable: boolean;
    deduit_de: pcell;
  end;

  tregle = record
    cond: pcell;
    action: taffirmation;
    active: boolean;
  end;

  cell = record
    next: pcell;
    case integer of
      1: (rval: tregle);
      2: (fval: tfait);
      3: (aval: taffirmation);
  end;

  enreg_regle = record
    libelle: chaine;
    etat: tetat;
    premisse: boolean;
  end;

  tfichier_regle = file of enreg_regle;
  tfichier_fait = file of tfait;


(******************************************************)
(**         Declarations des variables globales      **)
(******************************************************)

var
  bregles: pcell;
  bfaits: pcell;
  base_active: chaine;

(*************************************************************)
(**                                                         **)
(**                 OPERATIONS SUR LES LISTES               **)
(**                                                         **)
(*************************************************************)


(******************************************************)
(**         Ajouter une cellule a une liste          **)
(******************************************************)

procedure ajoute_cell(var p, liste: pcell);
var
  cell_courante: pcell;

begin
  p^.next := nil;
  if liste = nil then
  begin
    liste := p;
    exit;
  end;
  cell_courante := liste;
  while cell_courante^.next <> nil do
    cell_courante := cell_courante^.next;
  cell_courante^.next := p;
end;

(******************************************************)
(**         Supprimer une cellule d'une liste        **)
(******************************************************)

procedure supprime_cell(var p, liste: pcell);
var
  cell_courante, pred: pcell;

begin
  if liste = nil then
    exit;
  if p = liste then
  begin
    liste := liste^.next;
    exit;
  end;
  cell_courante := liste;
  while (cell_courante <> p) and (cell_courante <> nil) do
  begin
    pred := cell_courante;
    cell_courante := cell_courante^.next;
  end;
  if cell_courante = nil then
    exit;
  pred^.next := p^.next;
end;

(******************************************************)
(**  Verifier qu'une cellule appartient a une liste  **)
(******************************************************)

function membre(p, liste: pcell): boolean;
var
  elt: pcell;

begin
  elt := liste;
  while elt <> nil do
  begin
    if elt = p then
    begin
      membre := true;
      exit;
    end;
    elt := elt^.next;
  end;
  membre := false;
end;

(*************************************************************)
(**                                                         **)
(**        OPERATIONS SUR LA BASE DE FAITS                  **)
(**                                                         **)
(*************************************************************)


(******************************************************)
(**          Imprimer la base de faits               **)
(******************************************************)

procedure montre_fait(fait: tfait; periph: chaine);
var
  fich: text;

begin
  assign(fich, periph);
  rewrite(fich);
  writeln(fich);
  writeln(fich, fait.libelle);
  if fait.demandable then
    writeln(fich, 'demandable: oui')
  else
    writeln(fich, 'demandable: non');
  if fait.editable then
    writeln(fich, 'editable: oui')
  else
    writeln(fich, 'editable: non');
  close(fich);
end;

procedure imprime_faits;
var
  rang: integer;
  fait: pcell;

begin
  fait := bfaits;
  rang := 1;
  writeln('Impression de la base de faits, patientez...');
  while fait <> nil do
  begin
    writeln(lst, 'Fait numero ', rang, ' :');
    montre_fait(fait^.fval, 'prn');
    fait := fait^.next;
    rang := rang + 1;
  end;
  writeln('Impression terminee');
end;

(******************************************************)
(**             Visualiser des faits                 **)
(******************************************************)

procedure fait_a_visualiser(var fait: pcell; var sortie: boolean);
var
  rep: string[4];
  rang, i, code_erreur: integer;
  c: char;

begin
  sortie := true;
  writeln;
  repeat
    write('Entrez le numero du fait (ou ESC): ');
    c := readkey;
    if c = #27 then
      exit;
    write(c);
    readln(rep);
    rep := c + rep;
    val(rep, rang, code_erreur);
  until (code_erreur = 0) and (rang > 0);
  fait := bfaits;
  i := 1;
  while (fait <> nil) and (i < rang) do
  begin
    fait := fait^.next;
    i := i + 1;
  end;
  if fait = nil then
    writeln('La base ne contient que ', i - 1, ' faits')
  else
    montre_fait(fait^.fval, 'con');
  sortie := false;
end;

procedure visualise_fait;
var
  fait: pcell;
  sortie: boolean;

begin
  repeat
    fait_a_visualiser(fait, sortie);
  until sortie;
end;

(******************************************************)
(**             Supprimer des faits                  **)
(******************************************************)

function regle_dependante(regle: tregle; fait: pcell): boolean;
begin
  if (membre(fait, regle.cond)) or (regle.action.fait = fait) then
    regle_dependante := true
  else
    regle_dependante := false;
end;

function fait_a_supprimer: boolean;
var
  fait, regle: pcell;
  sortie: boolean;
  c: char;

begin
  fait_a_supprimer := true;
  fait_a_visualiser(fait, sortie);
  if sortie then
  begin
    fait_a_supprimer := false;
    exit;
  end;
  if fait = nil then
    exit;
  writeln;
  write('Confirmez-vous la suppression? (O/N): ');
  repeat
    c := readkey;
    write(#8, c);
  until upcase(c) in ['O', 'N'];
  writeln;
  if upcase(c) = 'N' then 
    exit;
  regle := bregles ;
  while regle <> nil do
  begin
    if regle_dependante(regle^.rval, fait) then
      supprime_cell(regle, bregles);
    regle := regle^.next;
  end;
  supprime_cell(fait, bfaits);
end;

procedure supprime_fait;
begin
  while fait_a_supprimer do;
end;

(************************************************************)
(** Ajouter des faits                                      **)
(************************************************************)
function fait_similaire(libelle: chaine): pcell;
var
  fait: pcell;

begin
  fait_similaire := nil;
  fait := bfaits;
  while fait <> nil do
    if fait^.fval.libelle = libelle then
    begin
      fait_similaire := fait;
      exit;
    end
    else
      fait := fait^.next;
end;

procedure demande_libelle(var libelle: chaine; var fait: pcell; var sortie: boolean);
var
  c: char;

begin
  sortie := false;
  writeln;
  writeln('Entrez le libelle du fait (ou ESC) :');
  c := readkey;
  if c = #27 then
  begin
    sortie := true;
    exit;
  end;
  write(c);
  readln(libelle);
  libelle := c + libelle;
  fait := fait_similaire(libelle);
end;

procedure creer_fait(var fait: pcell; var libelle: chaine);
var
  c: char;

begin
  new (fait) ;
  write ('Est-il demandable ? (O/N) : ');
  repeat
    c := readkey;
    write (#8, c);
  until upcase(c) in ['O', 'N'];
  writeln;
  fait^.fval.demandable := (upcase(c) = 'O');
  write ('Est-il editable ? (O/N) : ');
  repeat
    c := readkey;
    write(#8, c);
  until upcase(c) in ['O', 'N'];
  writeln;
  fait^.fval.editable := (upcase(c) = 'O');
  fait^.fval.libelle := libelle;
  ajoute_cell(fait, bfaits);
end;

function fait_a_ajouter: boolean;
var
  libelle: chaine;
  fait: pcell;
  sortie: boolean;
  c: char;

begin
  fait_a_ajouter := true;
  demande_libelle(libelle, fait, sortie);
  if sortie then
  begin
    fait_a_ajouter := false;
    exit;
  end;
  if fait <> nil then
  begin
    writeln ('Ce fait existe deja.');
    exit;
  end;
  creer_fait(fait, libelle);
end;

procedure ajoute_fait;
begin
  while fait_a_ajouter do;
end;

(***************************************************************)
(**                                                           **)
(**          OPERATIONS SUR LA BASE DE REGLES                 **)
(**                                                           **)
(***************************************************************)

(*************************************************************)
(**            Imprimer la base de regles                   **)
(*************************************************************)
procedure ecrit_premisses(regle: tregle; var fich: text);
var
  affirm: pcell;
  libelle: chaine;
  i: integer;

begin
  writeln(fich);
  affirm := regle.cond;
  while affirm <> nil do
  begin
    libelle := affirm^.aval.fait^.fval.libelle;
    write (fich,'si   ', libelle);
    for i := (length(libelle)) to 60 do
      write(fich,' ');
    if affirm^.aval.etat = vrai then
      writeln(fich, 'Vrai')
    else
      writeln(fich, 'Faux');
    affirm := affirm^.next;
  end;
end;

procedure montre_regle(regle: tregle; periph: chaine);
var
  fich: text;
  libelle: chaine;
  i: integer;

begin
  assign(fich, periph);
  rewrite(fich);
  writeln(fich);
  ecrit_premisses(regle, fich);
  writeln(fich);
  libelle := regle.action.fait^.fval.libelle;
  write(fich, 'alors ', libelle);
  for i := length(libelle) to 60 do
    write(fich, ' ');
  if regle.action.etat = vrai then
    writeln(fich, 'Vrai')
  else
    writeln(fich, 'Faux');
  close(fich);
end;

procedure imprime_regles;
var
  rang: integer;
  regle: pcell;

begin
  regle := bregles;
  rang := 1;
  writeln('Impression de la base de regles, patientez...');
  while regle <> nil do
  begin
    writeln(lst);
    writeln(lst);
    writeln(lst, 'Regle numero ' , rang, ' :');
    montre_regle(regle^.rval, 'prn');
    regle := regle^.next;
    rang := rang + 1;
  end;
  writeln('Impression terminee.');
end;

(***********************************************************)
(**             Visualiser des regles                     **)
(***********************************************************)
procedure regle_a_visualiser(var regle: pcell; var sortie: boolean);
var
  rep: string[4];
  rang, i, code_erreur: integer;
  c: char;

begin
  sortie := true;
  writeln;
  repeat
    write('Entrez le numero de la regle (ou ESC) : ');
    c := readkey;
    if c = #27 then
      exit;
    write(c);
    readln(rep);
    rep := c + rep;
    val(rep, rang, code_erreur);
  until (code_erreur = 0) and (rang > 0);
  regle := bregles;
  i := 1;
  while (regle <> nil) and (i < rang) do
  begin
    regle := regle^.next;
    i := i + 1;
  end ;
  if regle = nil then
    writeln('La base ne contient que ', i - 1,' regles.')
  else
    montre_regle(regle^.rval, 'con');
  sortie := false;
end;

procedure visualise_regle;
var
  regle: pcell;
  sortie: boolean;

begin
  repeat
    regle_a_visualiser(regle, sortie);
  until sortie;
end;

(********************************************************)
(**             Supprimer des regles                   **)
(********************************************************)
function regle_a_supprimer: boolean;
var
  regle: pcell;
  sortie: boolean;
  c: char;

begin
  regle_a_supprimer := true;
  regle_a_visualiser(regle, sortie);
  if sortie then
  begin
    regle_a_supprimer := false;
    exit;
  end;
  if regle = nil then
    exit;
  writeln;
  write('Confirmez-vous la suppression ? (O/N) : ');
  repeat
    c := ReadKey;
    write(#8, c);
  until upcase(c) in ['O', 'N'];
  writeln;
  if upcase(c) = 'O' then
    supprime_cell(regle, bregles);
end;

procedure supprime_regle;
begin
  while regle_a_supprimer do;
end;

(***********************************************************)
(**               Ajouter des regles                      **)
(***********************************************************)
procedure demande_premisses (var regle: tregle; var fich: text;
                             var premisse: pcell; var sortie: boolean);
var
  c: char;
  libelle: chaine;
  fait: pcell;

begin
  regle.cond := nil;
  sortie := false;
  writeln;
  repeat
    writeln('Entrez la regle (ou ESC) : ');
    writeln;
    writeln;
    rewrite(fich);
    ecrit_premisses(regle, fich);
    close(fich);
    write('Si    ');
    c := readkey;
    if c = #27 then
    begin
      sortie := true;
      exit;
    end;
    if c <> #13 then
    begin
      write(c);
      readln(libelle);
      libelle := c + libelle;
      fait := fait_similaire(libelle);
      if fait = nil then
        creer_fait(fait, libelle);
      new(premisse);
      premisse^.aval.fait := fait;
      write('Vrai ou faux ? (V/F) : ');
      repeat
        c := readkey;
        write(#8, c);
      until upcase (c) in ['V', 'F'];
      writeln;
      if upcase (c) = 'V' then
        premisse^.aval.etat := vrai
      else
        premisse^.aval.etat := faux;
      ajoute_cell(premisse, regle.cond);
    end;
  until c = #13;
end ;

function regle_a_ajouter: boolean;
var
  pregle, p, premisse: pcell;
  regle: tregle;
  c: char;
  fich: text;
  sortie: boolean;

begin
  assign(fich, 'con');
  regle_a_ajouter := true;
  demande_premisses(regle, fich, premisse, sortie);
  if sortie then
  begin
    regle_a_ajouter := false;
    exit;
  end;
  if regle.cond = nil then
    exit;
  p := regle.cond;
  while p^.next <> premisse do
    p := p^.next;
  p^.next := nil;
  regle.action := premisse^.aval;
  montre_regle(regle, 'con');
  writeln;
  write('Validez-vous cette regle ? (O/N) : ');
  repeat
    c := readkey;
    write(#8, c);
  until upcase(c) in ['O', 'N'];
  writeln;
  if upcase(c) = 'O' then
  begin
    new(pregle);
    pregle^.rval := regle;
    ajoute_cell(pregle, bregles);
  end;
end;

procedure ajoute_regle;
begin
  while regle_a_ajouter do;
end;

(************************************************************)
(**                                                        **)
(**                 CHAINAGE AVANT                         **)
(**                                                        **)
(************************************************************)
procedure placer(affirm: taffirmation; regle: pcell);
begin
  affirm.fait^.fval.etat := affirm.etat;
  affirm.fait^.fval.deduit_de := regle;
  if (regle <> nil) and (affirm.fait^.fval.editable) then
  begin
    write('Je deduis ', affirm.fait^.fval.libelle);
    if affirm.etat = vrai then
      writeln('    Vrai.')
    else
      writeln('    Faux.');
  end;
end;

function test(regle: tregle): boolean;
var
  premisse: pcell;

begin
  premisse := regle.cond;
  while premisse <> nil do
    if premisse^.aval.fait^.fval.etat <> premisse^.aval.etat then
    begin
      test := false;
      exit;
    end
    else
      premisse := premisse^.next;
  test := true;
end;

function declenchee(var regle: pcell): boolean;
begin
  declenchee := false;
  if (regle^.rval.active) and (test(regle^.rval))
  then
  begin
    placer(regle^.rval.action, regle);
    regle^.rval.active := false;
    declenchee := true;
  end;
end;


function chainage_avant: boolean;
var
  regle: pcell;

begin
  regle := bregles;
  while regle <> nil do
    if declenchee(regle) then
    begin
      chainage_avant := true;
      exit;
    end
    else
      regle := regle^.next;
  chainage_avant := false;
end;

function fait_en_entree: boolean;
var
  c: char;
  libelle: chaine;
  affirm: taffirmation;
  sortie: boolean;

begin
  while chainage_avant do;
  fait_en_entree := true;
  demande_libelle(libelle, affirm.fait, sortie);
  if sortie then
  begin
    fait_en_entree := false;
    exit;
  end;
  if affirm.fait = nil then
    writeln ('Je ne connais pas ce fait.')
  else
  begin
    write ('Vrai ou faux ? V/F : ');
    repeat
      c := readkey;
      write(#8, c);
    until upcase(c) in ['V', 'F'];
    writeln;
    if upcase(c) = 'V' then
      affirm.etat := vrai
    else
      affirm.etat := faux;
    placer(affirm, nil);
  end;
end;

procedure deduit;
begin
  while fait_en_entree do;
end;

(************************************************************)
(**                                                        **)
(**                   CHAINAGE ARRIERE                     **)
(**                                                        **)
(************************************************************)
function prouver(regle: pcell): boolean; forward;

function verifier(affirm: taffirmation): boolean;
var
  regle: pcell;
  c: char;

begin
  verifier := true;
  if affirm.etat = affirm.fait^.fval.etat then
    exit;
  if (affirm.fait^.fval.etat = inconnu) or
     (affirm.fait^.fval.etat = indetermine) then
  begin
    regle := bregles;
    while regle <> nil do
    begin
      if (affirm.fait^.fval.libelle = regle^.rval.action.fait^.fval.libelle) and
         (regle^.rval.action.etat = affirm.etat) then
        if prouver(regle) then
          exit;
      regle := regle^.next;
    end;
  end;
  if (affirm.fait^.fval.etat <> indetermine) or
     (affirm.fait^.fval.demandable = false) then
  begin
    verifier := false;
    exit;
  end;
  writeln;
  write('Le fait : ', affirm.fait^.fval.libelle, ' est-il vrai?');
  write (' (O/N/?) : ');
  repeat
    c := readkey;
    write(#8, c);
  until upcase(c) in ['O', 'N', '?'];
  writeln;
  case upcase(c) of
    '?' : affirm.fait^.fval.etat := inconnu;
    'O' : begin
            affirm.fait^.fval.etat := vrai;
            affirm.fait^.fval.deduit_de := nil;
          end;
    'N' : begin
            affirm.fait^.fval.etat := faux;
            affirm.fait^.fval.deduit_de := nil;
          end;
  end;
  if affirm.etat <> affirm.fait^.fval.etat then
    verifier := false;
end;

function prouver;
var
  premisse: pcell;

begin
  prouver := false;
  premisse := regle^.rval.cond;
  while premisse <> nil do
  begin
    if not verifier(premisse^.aval) then
      exit;
    premisse := premisse^.next;
  end;
  prouver := true;
  regle^.rval.action.fait^.fval.etat := regle^.rval.action.etat;
  regle^.rval.action.fait^.fval.deduit_de := regle;
end;

function chainage_arriere: boolean;
var
  solution, sortie: boolean;
  libelle: chaine;
  affirm: taffirmation;

begin
  chainage_arriere := true;
  writeln;
  writeln('Chainage arriere : ');
  demande_libelle(libelle, affirm.fait, sortie);
  if sortie then
  begin
    chainage_arriere := false;
    exit;
  end;
  if affirm.fait = nil then
    writeln('Je ne connais pas ce fait.')
  else
  begin
    if affirm.fait^.fval.etat = indetermine then
      affirm.fait^.fval.etat := inconnu;
    affirm.etat := vrai;
    if verifier(affirm) then
    begin
      writeln('Le fait ', affirm.fait^.fval.libelle, ' est vrai.');
      exit;
    end;
    affirm.etat := faux;
    if verifier(affirm) then
      writeln('Le fait ', affirm.fait^.fval.libelle, ' est faux')
    else
      writeln('Desole, je ne peux rien dire sur ce fait.');
  end;
end;

procedure induit;
begin
  while chainage_arriere do;
end;

(************************************************************)
(**                                                        **)
(**                   JUSTIFICATION                        **)
(**                                                        **)
(************************************************************)

procedure justifie_fait(fait: tfait);
begin
  if (fait.etat = indetermine) or (fait.etat = inconnu) then
  begin
    writeln('Ce fait est indetermine.');
    exit;
  end;
  write(fait.libelle, ' est ');
  if fait.etat = vrai then
    writeln('vrai.')
  else
    writeln('faux.');
  if fait.deduit_de = nil then
  begin
    writeln('On me l''a affirme.');
    exit;
  end;
  writeln('deduit de la regle : ');
  montre_regle(fait.deduit_de^.rval, 'con');
end;

function fait_a_justifier: boolean;
var
  libelle: chaine;
  fait: pcell;
  sortie: boolean;

begin
  fait_a_justifier := true;
  demande_libelle(libelle, fait, sortie);
  if sortie then
  begin
    fait_a_justifier := false;
    exit;
  end;
  if fait = nil then
    writeln('Je ne connais pas ce fait.')
  else
    justifie_fait(fait^.fval);
end;

procedure justifie;
begin
  while fait_a_justifier do;
end;

(************************************************************)
(**                                                        **)
(**                    UTILITAIRES                         **)
(**                                                        **)
(************************************************************)

(******************************************************)
(**                Reset des bases                   **)
(******************************************************)

procedure reset_faits;
var 
  fait: pcell;
  
begin
  fait := bfaits;
  while fait <> nil do
  begin
    fait^.fval.deduit_de := nil;
    fait^.fval.etat := indetermine;
    fait := fait^.next;
  end;
end;

procedure reset_regles;
var
  regle: pcell;

begin
  regle := bregles;
  while regle <> nil do
  begin
    regle^.rval.active := true;
    regle := regle^.next;
  end;
end;

procedure reset_bases;
begin
  reset_faits;
  reset_regles;
end;

(*******************************************************)
(**              Sauvegarder les bases                **)
(*******************************************************)

procedure sauve_faits(var fich: tfichier_fait);
var 
  fait: pcell;
  
begin
  rewrite(fich);
  fait := bfaits;
  while fait <> nil do
  begin
    write(fich, fait^.fval);
    fait := fait^.next;
  end;
  close(fich);
end;

procedure ecrit_regle(var fich: tfichier_regle; regle: tregle);
var
  enreg: enreg_regle;
  premisse: pcell;

begin
  premisse := regle.cond;
  while premisse <> nil do
  begin
    enreg.libelle := premisse^.aval.fait^.fval.libelle;
    enreg.etat := premisse^.aval.etat;
    enreg.premisse := true;
    write(fich, enreg);
    premisse := premisse^.next;
  end;
  enreg.libelle := regle.action.fait^.fval.libelle;
  enreg.etat := regle.action.etat;
  enreg.premisse := false;
  write(fich, enreg);
end;

procedure sauve_regles(var fich: tfichier_regle);
var
  regle: pcell;

begin
  rewrite(fich);
  regle := bregles;
  while regle <> nil do
  begin
    ecrit_regle(fich, regle^.rval);
    regle := regle^.next;
  end;
  close(fich);
end;

procedure sauve;
var
  ffaits: tfichier_fait;
  fregles: tfichier_regle;

begin
  writeln;
  writeln('Sauvegarde en cours...');
  assign(ffaits, base_active + '.BF');
  assign(fregles, base_active + '.BR');
  sauve_regles(fregles);
  sauve_faits(ffaits);
  writeln('Sauvegarde terminee.');
end;

(********************************************************)
(**              Charger les bases                     **)
(********************************************************)

function existe(nomfich: chaine): boolean;
var
  fichier: file;

begin
  assign(fichier, nomfich);
  (*$I-*)
  reset(fichier);
  (*$I+*)
  if IOresult = 0 then
  begin
    existe := true;
    close(fichier);
  end
  else
    existe := false;
end;

procedure charge_faits(var fich: tfichier_fait);
var
  fait: tfait;
  p: pcell;

begin
  reset(fich);
  bfaits := nil;
  while not eof(fich) do
  begin
    read(fich, fait);
    new(p);
    p^.fval := fait;
    ajoute_cell(p, bfaits);
  end;
  close(fich);
  reset_faits;
end;

procedure lecture_regle(var fich: tfichier_regle; var regle: tregle);
var
  premisse: pcell;
  enreg: enreg_regle;

begin
  with regle do
  begin
    cond := nil;
    read(fich, enreg);
    while enreg.premisse do
    begin
      new(premisse);
      premisse^.aval.fait := fait_similaire(enreg.libelle);
      premisse^.aval.etat := enreg.etat;
      ajoute_cell(premisse, cond);
      read(fich, enreg);
    end;
    action.fait := fait_similaire(enreg.libelle);
    action.etat := enreg.etat;
  end;
end;

procedure charge_regles(var fich: tfichier_regle);
var
  regle: tregle;
  p: pcell;

begin
  reset(fich);
  bregles := nil;
  while not eof(fich) do
  begin
    new(p);
    lecture_regle(fich, p^.rval);
    ajoute_cell(p, bregles);
  end;
  close(fich);
  reset_regles;
end;

procedure charge;
var
  nom_base: chaine;
  ffaits: tfichier_fait;
  fregles: tfichier_regle;
  c: char;

begin
  writeln;
  write('Nom de la base : ');
  readln(nom_base);
  assign(ffaits, nom_base + '.BF');
  assign(fregles, nom_base + '.BR');
  if (not (existe(nom_base + '.BF'))) or (not (existe(nom_base + '.BR'))) then
  begin
    write('Cette base n''existe pas.');
    write(' Voulez-vous la creer ? (O/N) : ');
    repeat
      c := readkey;
      write(#8, c);
    until upcase(c) in ['O', 'N'];
    writeln;
    if upcase(c) = 'N' then
      exit;
    rewrite(ffaits); close(ffaits);
    rewrite(fregles); close(fregles);
  end;
  charge_faits(ffaits);
  charge_regles(fregles);
  base_active := nom_base;
end;


(************************************************************)
(**                                                        **)
(**                     MENUS                              **)
(**                                                        **)
(************************************************************)

procedure menu_consulte;
var
  c: char;
  fin: boolean;

begin
  fin := false;
  reset_bases;
  repeat
    writeln;
    writeln('***** Consultation de la base *****');
    writeln;
    writeln('   1 --> Deduit ');
    writeln('   2 --> Induit ');
    writeln('   3 --> Justifie ');
    writeln('   4 --> Reset ');
    writeln(' ESC --> Menu principal');
    writeln;
    write('Votre choix : ');
    repeat
      c := readkey;
      write(#8, c);
    until c in [#27, '1'..'4'];
    writeln;
    case c of
      'l': deduit;
      '2': induit;
      '3': justifie;
      '4': reset_bases;
      #27: fin := true;
    end;
  until fin;
end;

procedure menu_modifie;
var
  c: char;
  fin: boolean;

begin
  fin := false;
  repeat
    writeln;
    writeln('****** Operations sur les bases ******');
    writeln;
    writeln('Base de faits :  1 --> Ajoute');
    writeln('                 2 --> Supprime');
    writeln('                 3 --> Visualise');
    writeln('                 4 --> Imprime');
    writeln;
    writeln('Base de regles : 5 --> Ajoute');
    writeln('                 6 --> Supprime');
    writeln('                 7 --> Visualise');
    writeln('                 8 --> Imprime');
    writeln;
    writeln('               ESC --> Menu principal');
    writeln;
    write('Votre choix : ');
    repeat
      c := readkey;
      write(#8, c);
    until c in [#27, '1'..'8'];
    writeln;
    case c of
      '1': ajoute_fait;
      '2': supprime_fait;
      '3': visualise_fait;
      '4': imprime_faits;
      '5': ajoute_regle;
      '6': supprime_regle;
      '7': visualise_regle;
      '8': imprime_regles;
      #27: fin := true;
    end;
  until fin;
end;

procedure menu_principal;
var
  c: char;
  i: integer;
  fin: boolean;

begin
  fin := false;
  repeat
    writeln;
    writeln('***** HENU PRINCIPAL ***** ') ;
    writeln;
    writeln('   1 --> Modifie');
    writeln('   2 --> Consulte');
    writeln('   3 --> Charge');
    writeln('   4 --> Sauve');
    writeln(' ESC --> Quitte');
    writeln;
    write('Votre choix : ');
    repeat
      c := readkey;
      write(#8, c);
    until c in ['1', '2', '3', '4', #27];
    writeln;
    case c of
      '1': menu_modifie;
      '2': menu_consulte;
      '3': charge;
      '4': sauve;
      #27: fin := true;
    end;
  until fin;
end;

(**********************************************************)
(**                                                      **)
(**                PROGRAMME PRINCIPAL                   **)
(**                                                      **)
(**********************************************************)

begin
  base_active := '';
  bregles := nil;
  bfaits := nil;
  charge;
  clrscr;
  menu_principal;
end.