unit Form_Calculator;

{$I _crw_sysdef}

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

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

interface

uses
 _crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
 {$IFDEF UNIX} cthreads, dl, {$ENDIF}
 {$IFDEF WINDOWS} windows, {$ENDIF}
 sysutils, classes, math, lclintf, lcltype,
 graphics, controls, forms, dialogs, stdctrls, buttons, extctrls,
 _crw_alloc, _crw_fpu, _crw_str, _crw_fio, _crw_eldraw, _crw_snd,
 _crw_ee, _crw_appforms, _crw_apptools;

type
  TFormCalculator = class(TMasterForm)
    PanelExpression: TPanel;
    GroupBoxExpression: TGroupBox;
    EditExpression: TEdit;
    BitBtnHistory: TBitBtn;
    PanelResult: TPanel;
    GroupBoxResult: TGroupBox;
    MemoResult: TMemo;
    PanelButtons: TPanel;
    ButtonVar: TButton;
    ButtonConst: TButton;
    ButtonFunction: TButton;
    ButtonAction: TButton;
    BitBtnEvaluate: TBitBtn;
    BitBtnClear: TBitBtn;
    BitBtnHelp: TBitBtn;
    BitBtnExit: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure EditExpressionKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure BitBtnEvaluateClick(Sender: TObject);
    procedure ButtonVarClick(Sender: TObject);
    procedure ButtonConstClick(Sender: TObject);
    procedure ButtonFunctionClick(Sender: TObject);
    procedure ButtonActionClick(Sender: TObject);
    procedure BitBtnClearClick(Sender: TObject);
    procedure BitBtnHelpClick(Sender: TObject);
    procedure BitBtnHistoryClick(Sender: TObject);
    procedure BitBtnExitClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure EvaluateNow;
  end;

procedure CreateCalculator(CreateForm:Boolean=false);
procedure KillCalculator;
function  ExecuteCalculator:Integer;
procedure OpenCalculator;
procedure SaveCalculatorParams(const IniFile:LongString);
procedure LoadCalculatorParams(const IniFile:LongString);
function  CalculatorEval(const ExpressionText : LongString;
                           var Answer         : Double;
                           var ResultText     : LongString
                                            ) : Integer;

implementation

uses
 Form_ListBoxSelection;

{$R *.lfm}

const
 FormCalculator      : TFormCalculator      = nil;
 myCalculator        : TExpressionEvaluator = nil;
 myCalculatorHistory : TText                = nil;
 MaxCalculatorHistory                       = 50;
 NumCalculatorDigits                        = 16;

procedure CreateCalculator(CreateForm:Boolean);
begin
 try
  if not Assigned(myCalculator)  then begin
   myCalculator:=NewExpressionEvaluator;
   myCalculator.Master:=@myCalculator;
  end;
  if not Assigned(myCalculatorHistory) then begin
   myCalculatorHistory:=NewText;
   myCalculatorHistory.Master:=@myCalculatorHistory;
  end;
  if CreateForm then
  if not Assigned(FormCalculator) then begin
   Application.CreateForm(TFormCalculator, FormCalculator);
   FormCalculator.Master:=@FormCalculator;
  end;
 except
  on E:Exception do BugReport(E,nil,'CreateCalculator');
 end;
end;

procedure KillCalculator;
begin
 Kill(myCalculatorHistory);
 Kill(myCalculator);
end;

procedure SaveToHistory(const s:LongString);
var i:Integer;
begin
 if not IsEmptyStr(s) then begin
  i:=0;
  with myCalculatorHistory do while i<Count do if s=Line[i] then Delln(i) else inc(i);
  myCalculatorHistory.InsLn(0,s);
 end;
 with myCalculatorHistory do Count:=min(Count,MaxCalculatorHistory);
end;

function ExecuteCalculator:Integer;
begin
 Result:=mrCancel;
 if CanShowModal(FormCalculator) then
 try
  CreateCalculator(true);
  if Assigned(FormCalculator) then begin
   SetStandardFont(FormCalculator);
   FormCalculator.ActiveControl:=FormCalculator.EditExpression;
   LocateFormToCenterOfScreen(FormCalculator);
   Result:=mrVoice(FormCalculator.ShowModal);
  end;
 except
  on E:Exception do BugReport(E,nil,'ExecuteCalculator');
 end;
end;

procedure OpenCalculator;
begin
 try
  CreateCalculator(true);
  if Assigned(FormCalculator) then begin
   SetStandardFont(FormCalculator);
   FormCalculator.ActiveControl:=FormCalculator.EditExpression;
   LocateFormToCenterOfScreen(FormCalculator);
   FormCalculator.Show;
  end; 
 except
  on E:Exception do BugReport(E,nil,'OpenCalculator');
 end;
end;

procedure SaveCalculatorParams(const IniFile:LongString);
begin
 try
  CreateCalculator(false);
  if Assigned(myCalculator) and not IsEmptyStr(IniFile) then begin
   myCalculator.Lock;
   try
    myCalculator.SaveVars(IniFile,'[CalculatorVariableList]');
   finally
    myCalculator.Unlock;
   end;
   myCalculatorHistory.InsLn(0,'[CalculatorHistoryList]');
   myCalculatorHistory.WriteFile(IniFile,true);
   myCalculatorHistory.Delln(0);
  end; 
 except
  on E:Exception do BugReport(E,nil,'SaveCalculatorParams');
 end;
end;

procedure LoadCalculatorParams(const IniFile:LongString);
begin
 try
  CreateCalculator(false);
  if Assigned(myCalculator) then begin
   myCalculator.Lock;
   try
    myCalculator.RestoreVars(IniFile,'[CalculatorVariableList]');
   finally
    myCalculator.Unlock;
   end;
   myCalculatorHistory.Text:=ExtractTextSection(IniFile,'[CalculatorHistoryList]',efAsIs);
  end;
 except
  on E:Exception do BugReport(E,nil,'LoadCalculatorParams');
 end;
end;

function CalculatorEval(const ExpressionText : LongString;
                          var Answer         : Double;
                          var ResultText     : LongString):Integer;
var
 Expression : array[0..255] of char;
begin
 if Assigned(myCalculator) then
 try
  myCalculator.Lock;
  try
   Result:=myCalculator.EvaluateLine(StrPCopy(Expression,ExpressionText));
   if Result=ee_Ok then begin
    if myCalculator.MayPrint then begin
     if (myCalculator.Answer=round(myCalculator.Answer)) and
        not IsNanOrInf(myCalculator.Answer)
     then begin
      ResultText:=ee_ErrorMessage(myCalculator.Status)+'.'+EOL+
                  'Dec : '+Real2Str(myCalculator.Answer,1,0)+EOL+
                  'Hex : '+HexL(Round(myCalculator.Answer))+EOL+
                  'Oct : '+OctL(Round(myCalculator.Answer))+EOL+
                  'Bin : '+BinL(Round(myCalculator.Answer));
     end else begin
      ResultText:=ee_ErrorMessage(myCalculator.Status)+EOL+
                  'Dec : '+FormatG(myCalculator.Answer,0,NumCalculatorDigits)+EOL+
                  'Hex : ?'+EOL+
                  'Oct : ?'+EOL+
                  'Bin : ?';
     end;
    end else begin
     ResultText:=ee_ErrorMessage(myCalculator.Status)+'.';
    end;
    Answer:=myCalculator.Answer;
   end else begin
    ResultText:=ee_ErrorMessage(myCalculator.Status)+'.'+EOL+
                StrPas(myCalculator.Buffer)+EOL+
                CharStr(myCalculator.ErrorPos+1)+'^'+EOL+
                CharStr(myCalculator.ErrorPos+1-Length(myCalculator.ErrorToken))+
                StrPas(myCalculator.ErrorToken);
    Answer:=0;
   end;
  finally
   myCalculator.Unlock;
  end;
 except
  on E:Exception do begin
   Answer:=0;
   Result:=ee_Exception;
   ResultText:=ee_ErrorMessage(Result);
   BugReport(E,nil,'CalculatorEval');
  end;
 end else begin
  Answer:=0;
  Result:=ee_NilRef;
  ResultText:=ee_ErrorMessage(Result);
 end;
end;

procedure TFormCalculator.FormCreate(Sender: TObject);
begin
 SetStandardFont(Self);
 SetAllButtonsCursor(Self,crHandPoint);
 Caption:=RusEng('Калькулятор','Calculator');
 GroupBoxExpression.Caption:=RusEng('Введите вычисляемое выражение:','Expression to evaluate is:');
 GroupBoxResult.Caption:=RusEng('Результат:','Result is:');
 ButtonFunction.Caption:=RusEng('Функция','Function');
 ButtonAction.Caption:=RusEng('Акция','Action');
 BitBtnHistory.Hint:=RusEng('Вызвать историю ввода','Call history of input');
 BitBtnClear.Hint:=RusEng('Очистить переменные','Clear variables');
 BitBtnHelp.Hint:=RusEng('Вызвать справку','Call help');
 BitBtnEvaluate.Hint:=RusEng('Вычислить выражение','Evaluate expression now');
 BitBtnExit.Hint:=RusEng('Закрыть калькулятор','Close calculator');
 CreateCalculator(false);
end;

procedure TFormCalculator.EvaluateNow;
var
 Answer     : Double;
 ResultText : LongString;
begin
 try
  CreateCalculator(false);
  if IsEmptyStr(EditExpression.Text) then begin
   MemoResult.Text:=RusEng('Пустое выражение.','Empty expression.');
  end else begin
   ResultText:=''; Answer:=0;
   CalculatorEval(EditExpression.Text,Answer,ResultText);
   MemoResult.Text:=ResultText;
   ResultText:='';
  end;
  SaveToHistory(EditExpression.Text);
  EditExpression.Text:='';
  ActiveControl:=EditExpression;
 except
  on E:Exception do BugReport(E,Self,'EvaluateNow');
 end;
end;

procedure TFormCalculator.EditExpressionKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
 case Key of
  VK_RETURN : EvaluateNow;
  VK_DOWN   : BitBtnHistoryClick(Sender);
  VK_UP     : BitBtnHistoryClick(Sender);
 end;
end;

procedure TFormCalculator.BitBtnEvaluateClick(Sender: TObject);
begin
 EvaluateNow;
end;

procedure TFormCalculator.ButtonVarClick(Sender: TObject);
var
 p : TText;
begin
 try
  myCalculator.Lock;
  try
   p:=myCalculator.VarList.GetText(NewText);
  finally
   myCalculator.Unlock;
  end;
  if p.Count=0
  then MemoResult.Text:=RusEng('Список переменных пуст.','Variable list empty.')
  else MemoResult.Text:=RusEng('Список переменных:','Variable list:')+EOL+p.Text;
  Kill(p);
  ActiveControl:=EditExpression;
 except
  on E:Exception do BugReport(E,Self,'ButtonVarClick');
 end;
end;

procedure TFormCalculator.ButtonConstClick(Sender: TObject);
var
 p : TText;
begin
 try
  myCalculator.Lock;
  try
   p:=myCalculator.ConstList.GetText(NewText);
  finally
   myCalculator.Unlock;
  end;
  if p.Count=0
  then MemoResult.Text:=RusEng('Список констант пуст.','Constant list empty.')
  else MemoResult.Text:=RusEng('Список констант:','Constant list:')+EOL+p.Text;
  Kill(p);
  ActiveControl:=EditExpression;
 except
  on E:Exception do BugReport(E,Self,'ButtonConstClick');
 end;
end;

procedure TFormCalculator.ButtonFunctionClick(Sender: TObject);
var
 p : TText;
begin
 try
  myCalculator.Lock;
  try
   p:=myCalculator.FuncList.GetText(NewText);
  finally
   myCalculator.Unlock;
  end;
  if p.Count=0
  then MemoResult.Text:=RusEng('Список функций пуст.','Function list empty.')
  else MemoResult.Text:=RusEng('Список функций:','Function list:')+EOL+p.Text;
  Kill(p);
  ActiveControl:=EditExpression;
 except
  on E:Exception do BugReport(E,Self,'ButtonFunctionClick');
 end;
end;

procedure TFormCalculator.ButtonActionClick(Sender: TObject);
var
 p : TText;
begin
 try
  myCalculator.Lock;
  try
   p:=myCalculator.ActionList.GetText(NewText);
  finally
   myCalculator.Unlock;
  end;
  if p.Count=0
  then MemoResult.Text:=RusEng('Список акций пуст.','Action list empty.')
  else MemoResult.Text:=RusEng('Список акций:','Action list:')+EOL+p.Text;
  Kill(p);
  ActiveControl:=EditExpression;
 except
  on E:Exception do BugReport(E,Self,'ButtonActionClick');
 end;
end;

procedure TFormCalculator.BitBtnClearClick(Sender: TObject);
begin
 try
  SaveToHistory(EditExpression.Text);
  EditExpression.Text:='';
  if YesNo(RusEng('Вы уверены, что надо удалить все переменные?',
                  'You really want to delete all variables?'))=mrYes
  then begin
   myCalculator.Lock;
   try
    myCalculator.VarList.Clear;
   finally
    myCalculator.Unlock;
   end;
   ButtonVarClick(Sender);
  end;
  ActiveControl:=EditExpression;
 except
  on E:Exception do BugReport(E,Self,'BitBtnClearClick');
 end;
end;

procedure TFormCalculator.BitBtnHelpClick(Sender: TObject);
begin
 try
  MemoResult.Text:=RusEng(
           ' Калькулятор позволяет вычислять математические выражения.'+EOL+
           ' Выражения могут содержать такие операторы:'+EOL+
           ' +, -, *, /, %, скобки ( ), константы,'+EOL+
           '  переменные, встроенные функции, акции.'+EOL+
           ' ПРИМЕРЫ:'+EOL+
           ' ********'+EOL+
           '  t=pi/6'+EOL+
           '  y1=sin(t)'+EOL+
           '  y2=cos(t)'+EOL+
           '  z=y1^2+y2^2'+EOL+
           '  f=gamma(6)'+EOL+
           '  @voice %f',
           ' Calculator is mathematic expression evaluator.'+EOL+
           ' You may use next operations:'+EOL+
           '  +, -, *, /, %, parentheses ( ), constants,'+EOL+
           ' variables, intrinsic functions, actions.'+EOL+
           ' EXAMPLE:'+EOL+
           ' ********'+EOL+
           '  t=pi/6'+EOL+
           '  y1=sin(t)'+EOL+
           '  y2=cos(t)'+EOL+
           '  z=y1^2+y2^2'+EOL+
           '  f=gamma(6)'+EOL+
           '  @voice %f');
  ActiveControl:=EditExpression;
 except
  on E:Exception do BugReport(E,Self,'BitBtnHelpClick');
 end;
end;

procedure TFormCalculator.BitBtnHistoryClick(Sender: TObject);
var i:Integer;
begin
 try
  SaveToHistory(EditExpression.Text);
  i:=ListBoxMenu(RusEng('История ввода калькулятора','Calculator history'),
                 RusEng('Выбрать строку истории:','Select history line:'),
                 myCalculatorHistory.Text);
  if i>=0 then EditExpression.Text:=myCalculatorHistory[i];
  ActiveControl:=EditExpression;
 except
  on E:Exception do BugReport(E,Self,'BitBtnHistoryClick');
 end;
end;

procedure TFormCalculator.BitBtnExitClick(Sender: TObject);
begin
 ModalResult:=mrOk;
end;

initialization

finalization

 KillCalculator;

end.
