(*************************************************************)
(**                                                         **)
(**                 PROGRAMME  MICRO-SE                     **)
(**                                                         **)
(*************************************************************)

program micro_se;

uses
  crt;

(******************************************************)
(**         Declarations des constantes              **)
(******************************************************)

const
  maxcond   =   5; (* nb maxi de faits conditions *)
  maxaction =   5; (* nb maxi de faits actions *)
  maxfaits  = 100; (* nb maxi de faits dans la base *)
  maxregles =  50; (* nb maxi de regles dans la base *)

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

type
  tfait = string[60];

  tregle = record
    cond  : array[1..maxcond] of tfait;
    action: array[1..maxaction] of tfait;
    active: boolean;
  end;

  tbase_regles = array[1..maxregles] of tregle;

  tbase_faits = array[1..maxfaits] of tfait;

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

var
  bfaits  : tbase_faits;
  bregles : tbase_regles;
  nbfaits : integer; (* nb de faits reellement presents *)
  nbregles: integer; (* nb de regles reellement presentes *)

(*******************************************************)
(**          Charger la base de regles                **)
(*******************************************************)

procedure lit_regle(var fregles: text; var regle: tregle);
var
  i, j  : integer;
  fait  : tfait;
  f_cond: boolean;

begin
  i := 0;
  f_cond := true;
  repeat
    readln(fregles, fait);
    if copy(fait, 1, 2) = 'Si' then
    begin
      i := i + 1;
      regle.cond[i] := copy(fait, 4, length(fait) - 3);
    end
    else
      f_cond := false;
  until not (f_cond);
  if (i + 1) <> maxcond then
    for j := (i + 1) to maxcond do
      regle.cond[j] := 'nil';
  i := 0;
  repeat
    i := i + 1;
    regle.action[i] := copy(fait, 7, length(fait) - 6);
    readln(fregles, fait);
  until fait = '';
  if (i + 1) <> maxaction then
    for j := (i + 1) to maxaction do
      regle.action[j] := 'nil';
  regle.active := true;
end;

procedure lit_base(var bregles: tbase_regles);
var
  fregles: text;
  base   : string[20];
  regle  : tregle;

begin
  write('Entrez le nom de la base: ');
  readln(base);
  base := base + '.BR';
  assign(fregles, base);
  reset(fregles);
  nbregles := 0;
  while not eof(fregles) do
  begin
    lit_regle(fregles, regle);
    nbregles := nbregles + 1;
    bregles[nbregles] := regle;
  end;
end;

(*****************************************************)
(**                Chainage avant                   **)
(*****************************************************)

function present(fait: tfait): boolean;
var
  i: integer;

begin
  present := false;
  if nbfaits = 0 then
    exit;
  for i := 1 to nbfaits do
    if fait = bfaits[i] then
    begin
      present := true;
      exit;
    end;
end;


procedure placer(fait: tfait; var bfait: tbase_faits);
var
  i: integer;

begin
  if present(fait) then
  begin
    writeln('Je le savais deja !');
    exit;
  end;
  nbfaits := nbfaits + 1;
  bfaits[nbfaits] := fait;
end;

function test(regle: tregle): boolean;
var
  i: integer;

begin
  i := 1;
  while (regle.cond[i] <> 'nil') and (i <= maxcond) do
    if not (present(regle.cond[i])) then
    begin
      test := false;
      exit;
    end
    else
      i := i + 1;
  test := true;
end;

function declenchee(var regle: tregle): boolean;
var
  i: integer;

begin
  declenchee := false;
  if not (regle.active) then
    exit;
  i := 1;
  if test(regle) then
    while (regle.action[i] <> 'nil') and (i <= maxaction) do
    begin
      writeln('Je deduis : ', regle.action[i]);
      placer(regle.action[i], bfaits);
      regle.active := false;
      declenchee := true;
      i := i + 1;
    end;
end;

function chainage_avant: boolean;
var
  regle: tregle;
  i    : integer;

begin
  chainage_avant := false;
  if nbregles = 0 then
    exit;
  for i := 1 to nbregles do
  begin
    if declenchee(bregles[i]) then
    begin
      chainage_avant := true;
      writeln('J''ai utilise la regle : ', i);
      writeln;
      exit;
    end;
  end;
end;

function fait_en_entree: boolean;
var
  fait: tfait;
  i   : integer;

begin
  fait_en_entree := false;
  write('Quoi de neuf : ');
  readln(fait);
  if fait = '' then
    exit;
  placer(fait, bfaits);
  while chainage_avant do;
  fait_en_entree := true;
end;

procedure deduit;
begin
  while fait_en_entree do;
end;

(*****************************************************)
(**          Reset de la base de regles             **)
(*****************************************************)

procedure reset_base;
var
  i: integer;

begin
  nbfaits := 0;
  for i := 1 to nbregles do
    bregles[i].active := true;
end;

(*****************************************************)
(**              programme principal                **)
(*****************************************************)

begin
  clrscr;
  reset_base;
  lit_base(bregles);
  deduit;
end.