unit ParserDemo;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, Basic2, StdCtrls, ComCtrls, ExtCtrls, MtxParseExpr,
  Menus, Math387, MtxParseClass;

const
  Nundo = 41;

type
  TfrmParser = class(TBasicForm2)
    Label2: TLabel;
    Label3: TLabel;
    Label1: TLabel;
    Label4: TLabel;
    helplabel: TLabel;
    Label5: TLabel;
    NEvalLabel: TLabel;
    ResultEdit: TEdit;
    Evaluate: TButton;
    XEdit: TEdit;
    GroupBox1: TGroupBox;
    PointButton: TButton;
    ExpressionEdit: TEdit;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    Button14: TButton;
    Button15: TButton;
    Button16: TButton;
    Button17: TButton;
    Button18: TButton;
    Button19: TButton;
    Button24: TButton;
    Button25: TButton;
    Button26: TButton;
    Button27: TButton;
    Button28: TButton;
    Button29: TButton;
    Button31: TButton;
    Button35: TButton;
    Button38: TButton;
    Button39: TButton;
    Button40: TButton;
    Button12: TButton;
    Button13: TButton;
    Button21: TButton;
    Button22: TButton;
    Button23: TButton;
    Button30: TButton;
    Button33: TButton;
    Button34: TButton;
    FunctionsCombo: TComboBox;
    Button32: TButton;
    yEdit: TEdit;
    ZEdit: TEdit;
    Button1: TButton;
    Button36: TButton;
    Button37: TButton;
    Button42: TButton;
    OptimizeCheck: TCheckBox;
    HexCheck: TCheckBox;
    PopupMenu1: TPopupMenu;
    Undo1: TMenuItem;
    Redo1: TMenuItem;
    Label6: TLabel;
    ConstantsCombo: TComboBox;
    Button2: TButton;
    CheckBox1: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure EvaluateClick(Sender: TObject);
    procedure Button24Click(Sender: TObject);
    procedure Button24KeyPress(Sender: TObject; var Key: Char);
    procedure FormDestroy(Sender: TObject);
    procedure FunctionsComboChange(Sender: TObject);
    procedure Button32Click(Sender: TObject);
    procedure Undo1Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure Redo1Click(Sender: TObject);
    procedure XEditChange(Sender: TObject);
    procedure yEditChange(Sender: TObject);
    procedure ZEditChange(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ExpressionEditKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ExpressionEditChange(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private declarations }
    X, Y, Z: TCplx;
    PrevText: array[0..Nundo - 1] of string;
    Iprevtext: Integer;
    istartundo: Integer;
    MyParser: TMtxExpression;
    procedure AddToEdit(S: string);
    procedure UpdateUndo;
    procedure SetUndoText;
  public
    { Public declarations }
  end;

var
  frmParser: TfrmParser;

implementation

{$R *.dfm}

const
  Maxstrings = 27;
  Helpstrings: array[0..Maxstrings - 1] of string = (
    '() = brackets',
    'abs(x) = absolute value',
    'arccos(x) = inverse cosine of x in rad',
    'arccosh(x) = inverse hyperbolic cosine in rad',
    'arcsin(x) = inverse sine of x in rad',
    'arcsinh(x) = inverse hyperbolic sine in rad',
    'cos(x) = cosine of an angle in rad',
    'cosh(x) = hyperbolic cosine of an angle in rad',
    'degtorad(x) = conversion from degrees to radians',
    'exp(x) = the value of e raised to the power of x',
    'if(x1,x2,x3) = if x1=True(or 1) then x2 else x3',
    'ln(x) = natural logarithm of x',
    'log10(x) = logarithm base 10 of x',
    'logn(x1,x2) = logarithm base x1 of x2',
    'max(x1,x2) = the maximum of both arguments',
    'min(x1,x2) = the minimum of both arguments',
    'pi = 3.1415926535897932385',
    'radtodeg(x) = conversion from degrees to radians',
    'randg(x1,x2) = Draw from normal distrib. (mean=x1, sd =x2',
    'random = random number between 0 and 1',
    'round(x) = round to the nearest integer',
    'sin(x) = sine of an angle in rad',
    'sinh(x) = hyperbolic sine of an angle in rad',
    'sqr(x) = the square of a number (x*x)',
    'sqrt(x) = the square root of a number',
    'tanh(x) = the hyperbolic tangent of an angle (rad)',
    'trunc(x) = truncates a real number to an integer');
  FunctionStrings: array[0..Maxstrings - 1] of string = (
    '()', 'abs()', 'arccos()', 'arccosh()', 'arcsin()', 'arcsinh()',
    'cos()', 'cosh()', 'degtorad()', 'exp()', 'if(,,)', 'ln()', 'log10()',
    'logn(,)', 'max(,)', 'min(,)', 'pi', 'radtodeg()', 'randg(,)', 'random',
    'round()', 'sin()', 'sinh()', 'sqr()', 'sqrt()', 'tanh()', 'trunc()');



{ TfrmParser }

procedure TfrmParser.AddToEdit(S: string);
var
  Len: Integer;
  IsFunction: Boolean;
begin
  if S = '' then S := ' ';
  with ExpressionEdit do
  begin
    IsFunction := Pos('(', S) > 0;
    Len := Sellength;
    if IsFunction and (Len > 0) then
    begin
      Sellength := 0;
      SelText := Copy(S, 1, Pos('(', S));
      SelStart := SelStart + Len;
      SelText := Copy(S, Pos('(', S) + 1, Len); ;
      SelStart := SelStart - 1;
    end
    else
    begin
      SelText := S;
      if IsFunction then SelStart := SelStart - 1;
    end;
  end;
end;

procedure TfrmParser.SetUndoText;
begin
  with ExpressionEdit do
  begin
    OnChange := nil;
    Text := PrevText[Iprevtext];
    SelStart := SelStart + Length(Text);
    Sellength := 0;
    OnChange := ExpressionEditChange;
  end;
end;

procedure TfrmParser.UpdateUndo;
begin
  istartundo := -1;
  if (Iprevtext <= 0) or (PrevText[Iprevtext - 1] <> ExpressionEdit.Text) then
  begin
    Inc(Iprevtext);
    if Iprevtext >= Nundo then
      Iprevtext := 0;
    PrevText[Iprevtext] := ExpressionEdit.Text;
  end;
end;

procedure TfrmParser.FormCreate(Sender: TObject);
var
  S: string;
  I, J: Integer;
begin
  inherited;
  With RichEdit1.Lines do
  begin
    Clear;
    Add('New in MtxVec 1.5 - the  TMtxExpression and '
      + 'TMtxFunctionEvaluator componets can be used '
      + 'for parsing math formulas. Complex numbers are '
      + 'fully supported!');
  end;  { assign function }
  PointButton.Caption := SysUtils.DecimalSeparator;
  MyParser := TMtxExpression.Create;
  MyParser.DefineVariableCplx('x', @X);
  MyParser.DefineVariableCplx('y', @Y);
  MyParser.DefineVariableCplx('z', @Z);
  MyParser.AlwaysAssumeComplex := true;
  X := StrToCplx(XEdit.Text);
  Y := StrToCplx(yEdit.Text);
  Z := StrToCplx(ZEdit.Text);
  FunctionsCombo.ItemIndex := 0;
  Iprevtext := -1;
  istartundo := -1;
  FunctionsCombo.Clear;
  for I := 0 to Maxstrings - 1 do
  begin
    S := Functionstrings[I];
    if MyParser.Separator <> ',' then
    repeat
        J := Pos(',', S);
        if J > 0 then S[J] := MyParser.Separator;
    until J = 0;
//    FunctionsCombo.Items.Add(S);
  end;
  for i := 0 to MyParser.WordsCount-1 do
  begin
        if (MyParser.Word(i) is TDoubleConstant) then ConstantsCombo.Items.Add(MyParser.Word(i).Name) else
        if ((MyParser.Word(i) is TFunction) or
           (MyParser.Word(i) is TBooleanFunction) or
           (MyParser.Word(i) is TVaryingFunction)) then FunctionsCombo.Items.Add(MyParser.Word(i).Name);
  end;
  MyParser.OnChange := ExpressionEditChange;
end;

procedure TfrmParser.EvaluateClick(Sender: TObject);

  procedure SetEditText(Edit: TEdit; X: TCplx);
  var
    OnCh: TNotifyEvent;
  begin
    OnCh := Edit.OnChange;
    Edit.OnChange := nil;
    Edit.Text := CplxToStr(X);
    Edit.OnChange := OnCh;
  end;
begin
  MyParser.Optimize := OptimizeCheck.Checked;
  MyParser.Add(ExpressionEdit.Text);
  if HexCheck.Checked then ResultEdit.Text := MyParser.EvaluateHex
                      else ResultEdit.Text := CplxToStr(MyParser.EvaluateCplx);
  NEvalLabel.Caption := IntToStr(MyParser.ExpressionSize);
  SetEditText(XEdit, X);
  SetEditText(yEdit, Y);
  SetEditText(ZEdit, Z);
end;

procedure TfrmParser.Button24Click(Sender: TObject);
begin
  AddToEdit((Sender as TButton).Caption);
end;

procedure TfrmParser.Button24KeyPress(Sender: TObject; var Key: Char);
begin
  ActiveControl := ExpressionEdit;
  with ExpressionEdit do
  begin
    SelStart := SelStart + Sellength;
    Sellength := 0;
  end;
end;

procedure TfrmParser.FormDestroy(Sender: TObject);
begin
  MyParser.Free;
  inherited;
end;

procedure TfrmParser.FunctionsComboChange(Sender: TObject);
var
  S: string;
  I: Integer;
begin
  if (FunctionsCombo.ItemIndex >= 0) and (FunctionsCombo.ItemIndex < Maxstrings) then
  begin
    S := Helpstrings[FunctionsCombo.ItemIndex];
    if MyParser.Separator <> ',' then
      repeat
        I := Pos(',', S);
        if I > 0 then S[I] := MyParser.Separator;
      until I = 0;
    Helplabel.Caption := S;
  end;
end;

procedure TfrmParser.Button32Click(Sender: TObject);
begin
  AddToEdit(FunctionsCombo.Text);
end;

procedure TfrmParser.Undo1Click(Sender: TObject);
begin
  if istartundo = -1 then istartundo := Iprevtext;
  Dec(Iprevtext);
  if Iprevtext < 0 then
    Iprevtext := Nundo - 1;
  SetUndoText;
end;

procedure TfrmParser.PopupMenu1Popup(Sender: TObject);
begin
  Undo1.Enabled := (Iprevtext <> -1);
  Redo1.Enabled := (istartundo <> -1) and (istartundo <> Iprevtext);
end;

procedure TfrmParser.Redo1Click(Sender: TObject);
begin
  if Iprevtext <> istartundo then
  begin
    Inc(Iprevtext);
    if Iprevtext = Nundo then
      Iprevtext := 0;
  end;
  SetUndoText;
end;

procedure TfrmParser.XEditChange(Sender: TObject);
begin
  if XEdit.Text <> '' then
  begin
    X := StrToCplx(XEdit.Text);
  end;
end;

procedure TfrmParser.yEditChange(Sender: TObject);
begin
  if YEdit.Text <> '' then
  begin
    Y := StrToCplx(YEdit.Text);
  end;
end;

procedure TfrmParser.ZEditChange(Sender: TObject);
begin
  if ZEdit.Text <> '' then
  begin
    Z := StrToCplx(ZEdit.Text);
  end;
end;

procedure TfrmParser.Button2Click(Sender: TObject);
begin
  AddToEdit(ConstantsCombo.Text)
end;

procedure TfrmParser.ExpressionEditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  inherited;
  if Key = 13 then EvaluateClick(Sender);
end;

procedure TfrmParser.ExpressionEditChange(Sender: TObject);
begin
  UpdateUndo;
end;

procedure TfrmParser.CheckBox1Click(Sender: TObject);
begin
  MyParser.AlwaysAssumeComplex := CheckBox1.Checked;
end;

initialization
  RegisterClass(TfrmParser);

end.
