////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// System calculator - interpreter for system calculations.                   //
// That is thread safe and robust wrapper for TExpressionEvaluator.           //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20060303 - Creation                                                        //
// 20060325 - Add Fifo                                                        //
// 20160927 - SystemCalculatorFifoPutText                                     //
// 20170228 - SystemCalculatorFifoLimit,SystemCalculatorFifoFactor            //
// 20230601 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_syscal; // SYStem CALculator.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes,
 _crw_alloc, _crw_fpu, _crw_str, _crw_fio, _crw_ee, _crw_fifo;

type
 TSystemCalculator = class(TMasterObject)
 private
  myEe   : TExpressionEvaluator;
  myFifo : TFifo;
  function GetFifo:TFifo;
 public
  constructor Create;
  destructor  Destroy; override;
  function    Eval(const Expression:LongString):Double;
  function    Evaluate(const Expression : LongString;
                         var Answer     : Double;
                         var Comment    : LongString) : Integer;
  function    SetAction(const aName:LongString; aAction:TeeAction; const aNote:LongString):Boolean;
  function    SetConst(const aName:LongString; aValue:Double):Boolean;
  function    SetFunc(const aName:LongString; aArgs:Integer; aFunc:TeeFunction; const aNote:LongString):Boolean;
  procedure   SaveVars(const IniFile,Section:LongString);
  procedure   RestoreVars(const IniFile,Section:LongString);
  property    Fifo : TFifo read GetFifo;
 end;

procedure Kill(var TheObject:TSystemCalculator); overload;

function SystemCalculator:TSystemCalculator;

function SystemCalculatorFifoPutText(const Msg:LongString):Integer;

const
 SystemCalculatorFifoSize   = 1024*64;
 SystemCalculatorFifoLimit  = 1024*1024*64;
 SystemCalculatorFifoFactor = 2;

implementation

 {
 *****************
 TSystemCalculator
 *****************
 }
constructor TSystemCalculator.Create;
begin
 inherited Create;
 myEe:=NewExpressionEvaluator(neem_LMath);
 myEe.Master:=@myEe;
 myFifo:=NewFifo(SystemCalculatorFifoSize);
 myFifo.Master:=@myFifo;
 myFifo.GrowLimit:=SystemCalculatorFifoLimit;
 myFifo.GrowFactor:=SystemCalculatorFifoFactor;
end;

destructor TSystemCalculator.Destroy;
begin
 Kill(myEe);
 Kill(myFifo);
 inherited Destroy;
end;

function TSystemCalculator.GetFifo:TFifo;
begin
 if Assigned(Self) then Result:=myFifo else Result:=nil;
end;

function  TSystemCalculator.Eval(const Expression:LongString):Double;
begin
 Result:=_Nan;
 if Assigned(Self) then
 try
  myEe.Lock;
  try
   if (myEe.EvaluateLine(PChar(Expression))=ee_Ok) then Result:=myEe.Answer;
  finally
   myEe.Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Eval');
 end;
end;

function  TSystemCalculator.Evaluate(const Expression : LongString;
                                       var Answer     : Double;
                                       var Comment    : LongString) : Integer;
begin
 Answer:=0;
 Comment:='';
 if Assigned(Self) then
 try
  myEe.Lock;
  try
   Result:=myEe.EvaluateLine(PChar(Expression));
   if (Result=ee_Ok) then begin
    if myEe.MayPrint then Comment:=Format('%g',[myEe.Answer]);
    Answer:=myEe.Answer;
   end else begin
    Comment:=ee_ErrorMessage(myEe.Status)+'.'+EOL+
             StrPas(myEe.Buffer)+EOL+
             CharStr(myEe.ErrorPos+1)+'^'+EOL+
             CharStr(myEe.ErrorPos+1-Length(myEe.ErrorToken))+StrPas(myEe.ErrorToken);
   end;
  finally
   myEe.Unlock;
  end;
 except
  on E:Exception do begin
   Result:=ee_Exception;
   BugReport(E,Self,'Evaluate');
   Comment:=ee_ErrorMessage(Result);
  end;
 end else begin
  Result:=ee_NilRef;
  Comment:=ee_ErrorMessage(Result);
 end;
end;

function TSystemCalculator.SetAction(const aName:LongString; aAction:TeeAction; const aNote:LongString):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  myEe.Lock;
  try
   if Assigned(aAction)
   then Result:=myEe.SetAction(aName,aAction,aNote)
   else Result:=myEe.ActionList.ClearAction(PChar(aName));
  finally
   myEe.Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetAction');
 end;
end;

function TSystemCalculator.SetConst(const aName:LongString; aValue:Double):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  myEe.Lock;
  try
   Result:=myEe.SetConst(aName,aValue);
  finally
   myEe.Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetConst');
 end;
end;

function TSystemCalculator.SetFunc(const aName:LongString; aArgs:Integer; aFunc:TeeFunction; const aNote:LongString):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  myEe.Lock;
  try
   if Assigned(aFunc)
   then myEe.SetFunc(aName,aArgs,aFunc,aNote)
   else myEe.FuncList.ClearFunc(PChar(aName));
  finally
   myEe.Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetFunc');
 end;
end;

procedure TSystemCalculator.RestoreVars(const IniFile,Section:LongString);
begin
 if Assigned(Self) then
 try
  myEe.Lock;
  try
   myEe.RestoreVars(IniFile,Section);
  finally
   myEe.UnLock;
  end;
 except
  on E:Exception do BugReport(E,Self,'RestoreVars');
 end;
end;

procedure TSystemCalculator.SaveVars(const IniFile,Section:LongString);
begin
 if Assigned(Self) then
 try
  myEe.Lock;
  try
   myEe.SaveVars(IniFile,Section);
  finally
   myEe.UnLock;
  end;
 except
  on E:Exception do BugReport(E,Self,'SaveVars');
 end;
end;

procedure Kill(var TheObject:TSystemCalculator); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

function SystemCalculatorFifoPutText(const Msg:LongString):Integer;
begin
 if SystemCalculator.Fifo.PutText(Msg)
 then Result:=Length(Msg)
 else Result:=0;
end;

 {
 *******************************************************************************
 SystemCalculator
 *******************************************************************************
 }
const
 mySystemCalculator : TSystemCalculator = nil;

function SystemCalculator:TSystemCalculator;
begin
 if not Assigned(mySystemCalculator) then begin
  mySystemCalculator:=TSystemCalculator.Create;
  mySystemCalculator.Master:=@mySystemCalculator;
  SystemSendToMainConsoleFunction:=SystemCalculatorFifoPutText;
 end;
 Result:=mySystemCalculator;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_syscal;
begin
 //SystemCalculator.Ok;
end;

procedure Free_crw_syscal;
begin
 Kill(mySystemCalculator);
end;

initialization

 Init_crw_syscal;

finalization

 Free_crw_syscal;

end.

//////////////
// END OF FILE
//////////////

