{$Define Delphi}

unit USE;
{ unidade de sistema especialista }
{ Joao Paulo Schwarz Schuler      }

                                  INTERFACE
uses UIntStr;
const MaxFatos=1000;

Const csFail = MaxFatos+1;

type TFato=1..MaxFatos+1;


type TRegra = object
               Num:byte;
               Fato:array[1..8] of TFato;

               procedure Limpa;
               { Limpa regra }
               procedure AddFato(F:TFato);
               { adiciona fato}
               function Conclui:TFato;
               { o que a regra conclui }
              end;

const MaxRegras=100;

type TBaseRegras = object
                    Num:Longint;
                    Reg:array[1..MaxRegras] of TRegra;

                    procedure Limpa;
                    {Limpa Base de regras}

                    procedure Add(R:TRegra);
                    { adiciona uma regra }
                   end;

type TBaseFatos = object
                    Fatos:array[TFato] of boolean;

                    procedure Limpa;
                    {Limpa Base de fatos}
                    procedure Seta(F:TFato);
                    {Seta fato}
                    function TestaRegra(R:TRegra): boolean;
                    {retorna se Regra retorna true}
                    function AplicaRegra(R:TRegra):boolean;
                    { testa a regra, se valido aplica
                     resultado a base de fatos, retorna true se
                     aplica novo fato a base de fatos }
                  end;

{$ifndef DELPHI}
type TOnFindFact = procedure (var R:TRegra);
{$ELSE}
type TOnFindFact = procedure (var R:TRegra) of object;
{$ENDIF}

type TMotor = object  { motor que trabalha com words }
               BRegras:TBaseRegras;
               BFatos:TBaseFatos;
               OnFindFact:TOnFindFact;

               constructor Init(POnFindFact:TOnFindFact);
               procedure SetaFato(F:TFato);
               function EFato(F:TFato):boolean;
               procedure Run;
               procedure AddRegra(R:TRegra);
               { adiciona uma regra }
               destructor Done;
              end;

type TMotorStr = object (TMotor)  { motor com casca para strings }
                   SW:TIntStr; { converte strings em words }

                   constructor Init(POnFindFact:TOnFindFact);
                   procedure SetaFatoStr(FS:string);
                   function EFatoStr(FS:string):boolean;
                   procedure AddRegraStr(RS:string);
                   function GetRegraStr(R:TRegra):string;
                   { transforma TRegra em String }
                   destructor Done;

                 end;


type TMotorCmd = object (TMotorStr) { motor por linha de comando }
                   function ExecCmd(S:string):boolean; { executa um comando }
                   function LoadFromFile(FileName:string):boolean;
                   { le um arquivo de comandos }
                 end;

                                IMPLEMENTATION
{$ifDef DELPHI}
uses SysUtils;
{$ELSE}
uses UMEM;
{$Endif}

procedure TRegra.Limpa;
{ Limpa regra }
begin
Num:=0;
end;

procedure TRegra.AddFato(F:TFato);
{ adiciona fato}
begin
Inc(NUM);
Fato[NUM]:=F;
end;

function TRegra.Conclui:TFato;
{ o que a regra conclui }
begin
if NUM<>0
   then Conclui:=Fato[NUM]
   else Conclui:=csFail;   { nenhuma regra}
end;

procedure TBaseRegras.Limpa;
{Limpa Base de regras}
begin
NUM:=0;
end;

procedure TBaseRegras.Add(R:TRegra);
{ adiciona uma regra }
begin
Inc(NUM);
Reg[NUM]:=R;
end;


procedure TBaseFatos.Limpa;
{Limpa Base de fatos}
var C:TFato;
begin
for C:=1 to MaxFatos
    do Fatos[C]:=false;
end;

procedure TBaseFatos.Seta(F:TFato);
{Seta fato}
begin
Fatos[F]:=true;
end;

function TBaseFatos.TestaRegra(R:TRegra): boolean;
{Testa Regra}
var Resul:boolean;
    C:integer;
begin
Resul:=false;
if R.NUM<>0
   then begin
        if R.NUM=1 { se soh tem conclusao eh sempre verdade }
           then Resul:=true
           else begin
                Resul:=true;
                for C:=1 to pred(R.NUM)
                    do Resul:=(Resul and Fatos[R.Fato[C]]);
                end;
        end;
TestaRegra:=Resul;
end; { of testaregra}

function TBaseFatos.AplicaRegra(R:TRegra):boolean;
{ testa a regra, se valido aplica resultado a base de fatos }
var Resul:boolean;
begin
Resul:=false;
if not(Fatos[R.Conclui]) and TestaRegra(R)
   then begin
        Resul:=true;
        Seta(R.Conclui);
        end;
AplicaRegra:=Resul;
end;

constructor TMotor.Init(POnFindFact:TOnFindFact);
begin
OnFindFact:=POnFindFact;
BRegras.Limpa;
BFatos.Limpa;
end;

procedure TMotor.SetaFato(F:TFato);
begin
BFatos.Seta(F);
end;


function TMotor.EFato(F:TFato):boolean;
begin
EFato:=BFatos.Fatos[F];
end;

procedure TMotor.AddRegra(R:TRegra);
{ adiciona uma regra }
begin
BRegras.Add(R);
end;

procedure TMotor.Run;
var Alteracao:boolean;
    C:Longint;
begin
if BRegras.Num>0
   then begin
        Alteracao:=true;
        while Alteracao do
              begin
              Alteracao:=false;
              for C:=1 to BRegras.Num do
                  begin
                  if BFatos.AplicaRegra(BRegras.Reg[C]) then
                     begin
                     Alteracao:=true;
                     OnFindFact(BRegras.Reg[C]);
                     end; { of if}
                  end; { of for }
              end; { of while }
        end; { of external if }

end;


destructor TMotor.Done;
begin
end;

constructor TMotorStr.Init(POnFindFact:TOnFindFact);
begin
SW.Init;
inherited Init(POnFindFact);
end;


destructor TMotorStr.Done;
begin
inherited Done;
SW.Done;
end;

procedure TMotorStr.SetaFatoStr(FS:string);
begin
SetaFato(SW.GetAdd(FS));
end;

function TMotorStr.EFatoStr(FS:string):boolean;
begin
EFatoStr:=EFato(SW.GetAdd(FS));
end;

procedure TMotorStr.AddRegraStr(RS:string);
var SEP:TSeparador;
    Counter:word;
    R:TRegra;
begin
if length(RS)<>0 then
   begin
   Sep.Sepal(RS);
   R.Limpa;
   for Counter:=1 to Sep.GetNP do
       R.AddFato(SW.GetAdd(Sep.GetP(Counter)));
   AddRegra(R);
   end;

end;

function TMotorStr.GetRegraStr(R:TRegra):string;
{ transforma TRegra em String }
var Counter:word;
    RS:string;
begin
RS:='';
if R.Num>0 then
   begin
   if R.Num>1
      then begin
           for Counter := 1 to pred(R.Num) do
               RS:=RS+' '+SW.GetStr(R.Fato[Counter]);
           end;
   RS:=RS+' --> '+SW.GetStr(R.Conclui);
   end;
GetRegraStr:=RS;
end;

function TMotorCMD.ExecCmd(S:string):boolean; { executa um comando }
var R:boolean;
    Sep:TSeparador;
    Counter:word;
    RE:TRegra;
    AUX:string;
begin
R:=false;
if length(S)>0
   then begin
        Sep.Sepal(S);
        if Sep.GetP(1)='regra' then
           begin
           RE.Limpa;
           for Counter:=2 to Sep.GetNP do
               RE.AddFato(SW.GetAdd(Sep.GetP(Counter)));
           AddRegra(RE);
           R:=true;
           end;

        if Sep.GetP(1)='fato' then
           begin
           for Counter:=2 to Sep.GetNP do
               SetaFatoStr(Sep.GetP(Counter));
           R:=true;
           end;

        if Sep.GetP(1)='*'  { comentario }
           then R:=true;

        if Sep.GetP(1)='limpafatos'
           then begin
                BFatos.Limpa;
                R:=true;
                end;

        if Sep.GetP(1)='limparegras'
           then begin
                BRegras.Limpa;
                R:=true;
                end;


        if Sep.GetP(1)='limpa'
           then begin
                BRegras.Limpa;
                BFatos.Limpa;
                SW.Limpa;
                R:=true;
                end;

        if Sep.GetP(1)='le'
           then begin
                AUX:=Sep.GetP(2);
                R:=LoadFromFile(AUX);
                end;

        if R
           then Run;

        end
   else begin
        R:=true;
        end;
ExecCmd:=R;
end;

function TMotorCMD.LoadFromFile(FileName:string):boolean;
{ le um arquivo de comandos }
var F:text;
    CMD:string;
begin
if FileExists(FileName) then
   begin
   Assign(F,FileName);
   Reset(F);
   while not(eof(F)) do
         begin
         ReadLn(F,CMD);
         ExecCmd(CMD);
         end;
   close(F);
   LoadFromFile:=true;
   end
   else LoadFromFile:=false;
end;


end. { of UNIT USE }