unit Unit1;

interface

uses
  SysUtils, Variants, Classes, QGraphics, QControls, QForms,
  QDialogs, QStdCtrls,CioinaEval,math, QGrids;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button3: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Memo2: TMemo;
    Memo3: TMemo;
    Label3: TLabel;
    Button1: TButton;
    Label4: TLabel;
    Memo4: TMemo;
    Label5: TLabel;
    Label6: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ParseErrorMesssage(Sender: TObject);
    procedure ExecuteErrorMesssage(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ev1,ev2,ev3:TCioinaEval;

implementation

uses Unit2;

{$R *.dfm}

function MyE(Pv:PVectorPTReal;PvCount:Integer):TReal;
begin
 Result:=Exp(1);
end;
//---------------------------------------------------------------------------
function MySum(Pv:PVectorPTReal;PvCount:Integer):TReal;
var i:Integer;
begin
 Result:=0;
 for i:=1 to PvCount do Result:=Result+Pv^[i]^;
end;
//---------------------------------------------------------------------------
function MySqrt(Pv:PVectorPTReal;PvCount:Integer):TReal;
begin
 Result:=Sqrt(Pv^[1]^);
end;
//---------------------------------------------------------------------------
function MyRandom(Pv:PVectorPTReal;PvCount:Integer):TReal;
begin
 Result:=Random;
end;
//---------------------------------------------------------------------------
procedure TForm1.ExecuteErrorMesssage(Sender: TObject);
var s,s1:string;
    i   :Integer;
begin
 with Sender as TCioinaEval do
 begin
  i:=Pos(':',ErrorMessageInfo);
  if i>0 then  s1:=' : '+Copy(ErrorMessageInfo,i+1,Length(ErrorMessageInfo)-i) else s1:='';
  if Length(s1)>256 then s1:=Copy(s1,1,256);
  s1:=LowerCase(s1);

  s:='';
  case MathException of
   EX_NONMATH:s:=' : NONMATH';
   EX_Overflow:s:=' : Overflow';
   EX_Underflow:s:=' : Underflow';
   EX_InvalidArgument:s:=' : InvalidArgument';
   EX_ZeroDivide:s:=' : ZeroDivide';
   EX_InvalidOp:s:=' : InvalidOp';
  end;

  case ErrorNumber of
   ERR_NO_MATH_EXPRESSION_WAS_PARSED:           Memo3.Text:=('No math expression was parsed');
   ERR_VARIABLES_AND_VALUES_ARE_DIFFERENT:      Memo3.Text:=('Variable count and value caunt do not corespond');
   ERR_MATH_EXPRESSIONS_ARRAY:                  Memo3.Text:=('Use ''DoVectorOfMathExpressions'' for calculate a vector of math expression');
   ERR_DEF_FUNCTION_STACK_OVERFLOW:             Memo3.Text:=('Stack overflow'+s1);
   ERR_SYSTEM_STACK_OVERFLOW:                   Memo3.Text:=('Fatal error'+s1);
   ERR_EXECUTE:                                 Memo3.Text:=('Execution error'+s1);
   ERR_MULTIPLY:                                Memo3.Text:=('Invalid value for *'+s1+s);
   ERR_DIVISION:                                if MathException=EX_ZeroDivide
                                                then Memo3.Text:=('Division by 0 ')
                                                else Memo3.Text:=('Invalid value for /'+s1+s);
   ERR_PLUS:                                    Memo3.Text:=('Invalid value for +'+s1+s);
   ERR_MINUS:                                   Memo3.Text:=('Invalid value for -'+s1+s);
   ERR_POWER:                                   Memo3.Text:=('Invalid value for ^'+s1+s);
   ERR_EQUAL:                                   Memo3.Text:=('Invalid value for ='+s1+s);
   1..FunCount:
               if s=''
               then Memo3.Text:=('Invalid number of function arguments for: '+ UpperCase(aStr[ErrorNumber]))
               else Memo3.Text:=('Invalid value for '+ UpperCase(aStr[ErrorNumber])+s1+s);
   else if (ErrorNumber>FunCount)and(ErrorNumber<=FunCount+UserFunctionCount)
        then
         if s=''
         then  Memo3.Text:=('Invalid number of function arguments for: '+UpperCase(UserFunctionName[ErrorNumber-FunCount-1]))
         else  Memo3.Text:=('Invalid value for '+ UpperCase(UserFunctionName[ErrorNumber-FunCount-1])+s1+s)
        else Memo3.Text:=(ErrorMessageInfo);
  end;
 end;
end;
//---------------------------------------------------------------------------
procedure TForm1.ParseErrorMesssage(Sender: TObject);
var s,s1:string;
    i:Integer;
begin
 with Sender as TCioinaEval do
 begin
  i:=Pos(':',ErrorMessageInfo);
  if i>0 then  s1:=' : '+Copy(ErrorMessageInfo,i+1,Length(ErrorMessageInfo)-i) else s1:='';
  if Length(s1)>256 then s1:=Copy(s1,1,256);
  s1:=LowerCase(s1);
  s:='';
  case MathException of
   EX_NONMATH:s:=' : NONMATH';
   EX_Overflow:s:=' : Overflow';
   EX_Underflow:s:=' : Underflow';
   EX_InvalidArgument:s:=' : InvalidArgument';
   EX_ZeroDivide:s:=' : ZeroDivide';
   EX_InvalidOp:s:=' : InvalidOp';
  end;

  case ErrorNumber of
   ERR_PARSE:                                   Memo3.Text:=('Invalid expression'+s1);
   ERR_BAD_SYNTAX:                              Memo3.Text:=('Syntax error'+s1);
   ERR_COMMA_SYNTAX:                            Memo3.Text:=('Comma syntax error'+s1);
   ERR_NO_MATH_EXPRESSION_WAS_PARSED:           Memo3.Text:=('No math expression was parsed');
   ERR_PARANTHESES_SYNTAX_ERROR:                Memo3.Text:=('Mismatched parenthesis');
   ERR_INVALID_DERIVATIVE_VARIABLE_NAME:        Memo3.Text:=('Invalid name of derivative variable'+s1);
   ERR_MATH_EXPRESSION_IS_EMPTY:                Memo3.Text:=('Mathematical expression is empty');
   ERR_IDENTIFIER_CANNOT_BE_EMPTY:              Memo3.Text:=('Identifier cannot be empty');
   ERR_IDENTIFIER_LENGTH:                       Memo3.Text:=('Identifier length is too long'+s1);
   ERR_NOT_PASCAL_IDENTIFIER:                   Memo3.Text:=('Invalid identifier'+s1);
   ERR_IDENTIFIER_CANNOT_BE_RESERVED_NAME:      Memo3.Text:=('Identifier cannot be a reserved name'+s1);
   ERR_IDENTIFIER_ALREADY_EXISTS:               Memo3.Text:=('Identifier already exists'+s1);
   ERR_DUBLICATING_USER_IDENTIFIER:             Memo3.Text:=('Dublicating user identifier'+s1);
   ERR_UNKNOWN_EXPRESSION:                      Memo3.Text:=('Unknown expression'+s1);
   ERR_UNKNOWN_FUNCTION:                        Memo3.Text:=('Undefined function'+s1);
   ERR_UNKNOWN_VARIABLE:                        Memo3.Text:=('Undefined variable'+s1);
   ERR_BAD_EXPONENTIAL_FORMAT:                  Memo3.Text:=('Invalid exponent value'+s1);
   ERR_SET_OriginalMathExpressionString_FALSE:  Memo3.Text:=('Set ''OriginalMathExpressionString'' to FALSE for differentiation or for Mathematica 4.1 export');
   ERR_MATH_EXPRESSION_WAS_ERASED:              Memo3.Text:=('Mathematical expression string was erased');
   ERR_USE_VerifySyntaxSemanticsAndDerivation:  Memo3.Text:=('Use ''VerifySyntaxSemanticsAndDerivation'' for differentiation');
   ERR_DERIVATIVE_EXPRESSION_WAS_ERASED:        Memo3.Text:=('Derivative expression string was erased');
   ERR_VARIABLES_AND_VALUES_ARE_DIFFERENT:      Memo3.Text:=('Variable count and value caunt do not corespond');
   ERR_MATH_EXPRESSIONS_ARRAY:                  Memo3.Text:=('Use ''DoVectorOfMathExpressions'' for calculate a vector of math expression');
   ERR_FUNCTION_NUMBER_MUST_BE_LESS:            Memo3.Text:=('Function number must be less'+s1);
   ERR_FUNCTION_ADDRESS_CANNOT_BE_NIL:          Memo3.Text:=('Function address cannot be nil'+s1);
   ERR_PROTECTED_EXPRESSION:                    Memo3.Text:=('Cannot set value for protected expression'+s1);
   ERR_DEF_FUNC_NAME:                           Memo3.Text:=('Invalid function name'+s1);
   ERR_DEF_FUNC_DUBLICATING:                    Memo3.Text:=('Dublicating defined function'+s1);
   ERR_DEF_FUNC_IMPLEMENTING:                   Memo3.Text:=('Defined function was not implimented'+s1);
   ERR_DEF_FUNC_ARG_COUNT:                      Memo3.Text:=('Invalid arguments number for defined function'+s1);
   ERR_DEF_FUNC_ARG_NAME:                       Memo3.Text:=('Invalid argument name for defined function'+s1);
   ERR_DEF_FUNC_ARG_DUBLICATING:                Memo3.Text:=('Dublicating argument name for defined function'+s1);
   ERR_MULTIPLY:                                Memo3.Text:=('Invalid value for *'+s1+s);
   ERR_DIVISION:                                if MathException=EX_ZeroDivide
                                                then Memo3.Text:=('Division by 0')
                                                else Memo3.Text:=('Invalid value for /'+s1+s);
   ERR_PLUS:                                    Memo3.Text:=('Invalid value for +'+s1+s);
   ERR_MINUS:                                   Memo3.Text:=('Invalid value for -'+s1+s);
   ERR_POWER:                                   Memo3.Text:=('Invalid value for ^'+s1+s);
   ERR_EQUAL:                                   Memo3.Text:=('Invalid value for ='+s1+s);
   1..FunCount:
               if s=''
               then Memo3.Text:=('Invalid number of function arguments for: '+ UpperCase(aStr[ErrorNumber]))
               else Memo3.Text:=('Invalid value for '+ UpperCase(aStr[ErrorNumber])+s1+s);
   else if (ErrorNumber>FunCount)and(ErrorNumber<=FunCount+UserFunctionCount)
        then
         if s=''
         then  Memo3.Text:=('Invalid number of function arguments for: '+UpperCase(UserFunctionName[ErrorNumber-FunCount-1]))
         else  Memo3.Text:=('Invalid value for '+ UpperCase(UserFunctionName[ErrorNumber-FunCount-1])+s1+s)
        else Memo3.Text:=(ErrorMessageInfo);
  end;
 end;
end;
//---------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
var v:TUserFuncArray;
begin
 DecimalSeparator:='.';
 SetLength(v,4);
 v[0].FuncName:='MyE';    v[0].FuncAddress:=MyE;    v[0].VarCount:=0;
 v[1].FuncName:='MySum';  v[1].FuncAddress:=MySum;  v[1].VarCount:=MaxFuncParam;
 v[2].FuncName:='MySqrt'; v[2].FuncAddress:=MySqrt; v[2].VarCount:=1;
 v[3].FuncName:='MyRandom'; v[3].FuncAddress:=MyRandom; v[3].VarCount:=-1;
 ev1:=TCioinaEval.Create(v);
 ev2:=TCioinaEval.Create(v);
 ev3:=TCioinaEval.Create(v);
 ev1.OnVerifySyntaxSemanticsError:=ParseErrorMesssage;
 ev1.OnDoMathExpressionError:=ExecuteErrorMesssage;
 ev2.OnVerifySyntaxSemanticsError:=ParseErrorMesssage;
 ev2.OnDoMathExpressionError:=ExecuteErrorMesssage;
 ev3.OnVerifySyntaxSemanticsError:=ParseErrorMesssage;
 ev3.OnDoMathExpressionError:=ExecuteErrorMesssage;
 SetLength(v,0);
 Form1.Caption:='Simple front end '+TCioinaEval.OwnerInfo;
end;
//---------------------------------------------------------------------------
procedure TForm1.FormDestroy(Sender: TObject);
begin
 ev1.Free;
 ev2.Free;
 ev3.Free;
end;
//---------------------------------------------------------------------------
procedure TForm1.Button4Click(Sender: TObject);
begin
 Memo1.Clear;
end;
//---------------------------------------------------------------------------
procedure TForm1.Button3Click(Sender: TObject);
var i:Integer;
    a:TUserVarArray;
    s:string;
begin

 Memo3.Clear;
 if Trim(Memo1.Text)='' then s:='nan' else s:=Memo1.Text;
 s:=StringReplace(s,''#$D'','',[rfReplaceAll]);
 s:=StringReplace(s,''#$A'','',[rfReplaceAll]);
 ev1.VerifySyntaxSemantics(s,'',true);
 if not(ev1.ErrorFlag)
 then
 begin
  ev1.DoVectorOfMathExpressions;
  if not(ev1.ErrorFlag)
  then
  begin
   SetLength(a,ev1.VariableCount);
   for i:=0 to High(a) do
   begin
    a[i].Value:=ev1.VariableArray[i+1].Value;
    a[i].StrExpr:=ev1.VariableArray[i+1].StrExpr;
   end;
   if Trim(Memo4.Text)='' then s:='nan' else s:=Memo4.Text;
   s:=StringReplace(s,''#$D'','',[rfReplaceAll]);
   s:=StringReplace(s,''#$A'','',[rfReplaceAll]);
   ev3.VerifySyntaxSemantics(s,a,false);
   if not(ev3.ErrorFlag)
   then
   begin
    if Trim(Memo2.Text)='' then s:='' else s:=s+','+Memo2.Text;
    s:=StringReplace(s,''#$D'','',[rfReplaceAll]);
    s:=StringReplace(s,''#$A'','',[rfReplaceAll]);
    ev2.VerifySyntaxSemantics(s,a,false);
    if not(ev2.ErrorFlag)
    then
    begin
     ev2.DoVectorOfMathExpressions;
     if not(ev2.ErrorFlag)
     then
      for i:=0 to High(a) do Memo3.Lines.Add(a[i].StrExpr+' = '+FloatToStr(a[i].Value^))
    end;
   end;
  end;
 end;
 if ev1.ErrorFlag
 then Memo3.Text:='DEFINE VARIABLES-> '+Memo3.Text
 else
   if ev3.ErrorFlag
   then Memo3.Text:='DEFINE FUNCTIONS-> '+Memo3.Text
   else
    if ev2.ErrorFlag
    then Memo3.Text:='DEFINE EXPRESSIONS-> '+Memo3.Text;
 Label6.Caption:='CioinaEval allocated virtual memory = '+
  IntToStr(ev1.AllocDynamicMemoryInfo+
           ev2.AllocDynamicMemoryInfo+
           ev3.AllocDynamicMemoryInfo)+' bytes';
end;
//---------------------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
var i:Integer;
begin
 Form2.Memo1.Clear;
 Form2.Memo1.Lines.Add('BUILT-IN FUNCTIONS');
 Form2.Memo1.Lines.Add('====================================================');
 for i:=0 to ev3.TotalFunctionCount do
 Form2.Memo1.Lines.Add(IntToStr(i)+'.  '+ev3.BuiltInFunctionInfo[i]);
 Form2.Memo1.Lines.Add('====================================================');
 Form2.Memo1.Lines.Add('OwnerInfo = '+TCioinaEval.OwnerInfo);
 Form2.Memo1.Lines.Add('VersionInfo = '+TCioinaEval.VersionInfo);
 Form2.Memo1.Lines.Add('TypeInfo = '+TCioinaEval.TypeInfo);
 Form2.Show;
end;
end.
