{**********************************************************************}
{                                                                      }
{    "The contents of this file are subject to the Mozilla Public      }
{    License Version 1.1 (the "License"); you may not use this         }
{    file except in compliance with the License. You may obtain        }
{    a copy of the License at http://www.mozilla.org/MPL/              }
{                                                                      }
{    Software distributed under the License is distributed on an       }
{    "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express       }
{    or implied. See the License for the specific language             }
{    governing rights and limitations under the License.               }
{                                                                      }
{    Copyright Creative IT.                                            }
{    Current maintainer: Eric Grange                                   }
{                                                                      }
{**********************************************************************}
unit dwsMathComplexFunctions;

{$I dws.inc}

interface

uses
   SysUtils,
   dwsUtils, dwsXPlatform, dwsCompilerContext,
   dwsFunctions, dwsSymbols, dwsExprs, dwsStrings, dwsOperators, dwsExprList,
   dwsTokenizer,dwsMagicExprs, dwsUnitSymbols, dwsDataContext;

type
   TComplexMakeExpr = class(TInternalMagicDataFunction)
      public
         procedure DoEval(const args : TExprBaseListExec; var result : IDataContext); override;
   end;

   TComplexToStrExpr = class(TInternalMagicStringFunction)
      public
         procedure DoEvalAsString(const args : TExprBaseListExec; var result : String); override;
   end;

   TAbsComplexExpr = class(TUnaryOpFloatExpr)
      function  EvalAsFloat(exec : TdwsExecution) : Double; override;
   end;

   TComplexOpExpr = class(TInternalMagicDataFunction);

   TComplexNegOpExpr = class(TComplexOpExpr)
      public
         procedure DoEval(const args : TExprBaseListExec; var result : IDataContext); override;
   end;

   TComplexAddOpExpr = class(TComplexOpExpr)
      public
         procedure DoEval(const args : TExprBaseListExec; var result : IDataContext); override;
   end;

   TComplexSubOpExpr = class(TComplexOpExpr)
      public
         procedure DoEval(const args : TExprBaseListExec; var result : IDataContext); override;
   end;

   TComplexMultOpExpr = class(TComplexOpExpr)
      public
         procedure DoEval(const args : TExprBaseListExec; var result : IDataContext); override;
   end;

   TComplexDivOpExpr = class(TComplexOpExpr)
      public
         procedure DoEval(const args : TExprBaseListExec; var result : IDataContext); override;
   end;

const
   SYS_COMPLEX = 'TComplex';

// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------
implementation
// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------

// RegisterComplexType
//
procedure RegisterComplexType(systemTable : TSystemSymbolTable; unitSyms : TUnitMainSymbols;
                              unitTable : TSymbolTable);
var
   typComplex : TRecordSymbol;
begin
   if systemTable.FindLocal(SYS_COMPLEX)<>nil then exit;

   typComplex:=TRecordSymbol.Create(SYS_COMPLEX, nil);
   typComplex.AddField(TFieldSymbol.Create('Re', systemTable.TypFloat, cvPublic));
   typComplex.AddField(TFieldSymbol.Create('Im', systemTable.TypFloat, cvPublic));

   systemTable.AddSymbol(typComplex);
end;

// RegisterComplexOperators
//
procedure RegisterComplexOperators(systemTable : TSystemSymbolTable;
                                   unitTable : TSymbolTable; operators : TOperators);
var
   typComplex : TRecordSymbol;
begin
   typComplex:=systemTable.FindTypeSymbol(SYS_COMPLEX, cvMagic) as TRecordSymbol;

   if operators.HasOperatorFor(ttPROPERTY, typComplex, typComplex) then Exit;

   operators.RegisterOperator(ttPLUS, unitTable.FindSymbol('ComplexAdd', cvMagic) as TFuncSymbol, typComplex, typComplex);
   operators.RegisterOperator(ttMINUS, unitTable.FindSymbol('ComplexSub', cvMagic) as TFuncSymbol, typComplex, typComplex);
   operators.RegisterOperator(ttTIMES, unitTable.FindSymbol('ComplexMult', cvMagic) as TFuncSymbol, typComplex, typComplex);
   operators.RegisterOperator(ttDIVIDE, unitTable.FindSymbol('ComplexDiv', cvMagic) as TFuncSymbol, typComplex, typComplex);
end;

// HandleComplexAbs
//
function HandleComplexAbs(context : TdwsCompilerContext; argExpr : TTypedExpr) : TTypedExpr;
var
   typComplex : TRecordSymbol;
begin
   typComplex:=context.SystemTable.FindTypeSymbol(SYS_COMPLEX, cvMagic) as TRecordSymbol;
   if argExpr.Typ.IsOfType(typComplex) then
      Result:=TAbsComplexExpr.Create(context, argExpr)
   else Result:=nil;
end;

// ------------------
// ------------------ TComplexMakeExpr ------------------
// ------------------

// DoEval
//
procedure TComplexMakeExpr.DoEval(const args : TExprBaseListExec; var result : IDataContext);
begin
   result.AsFloat[0]:=args.AsFloat[0];
   result.AsFloat[1]:=args.AsFloat[1];
end;

// ------------------
// ------------------ TComplexToStrExpr ------------------
// ------------------

// DoEvalAsString
//
procedure TComplexToStrExpr.DoEvalAsString(const args : TExprBaseListExec; var result : String);
var
   cmplxData : IDataContext;
   r, i : Double;
begin
   cmplxData:=TDataExpr(args.ExprBase[0]).DataPtr[args.Exec];
   r:=cmplxData.AsFloat[0];
   i:=cmplxData.AsFloat[1];
   if i>0 then
      Result := Format('%f + %fi', [r, i])
   else if i<0 then
      Result := Format('%f - %fi', [r, Abs(i)])
   else Result := Format('%f', [r]);
end;

// ------------------
// ------------------ TAbsComplexExpr ------------------
// ------------------

// EvalAsFloat
//
function TAbsComplexExpr.EvalAsFloat(exec : TdwsExecution) : Double;
var
   cmplxData : IDataContext;
begin
   cmplxData:=TDataExpr(Expr).DataPtr[exec];
   Result:=Sqrt(Sqr(cmplxData.AsFloat[0])+Sqr(cmplxData.AsFloat[1]));
end;

// ------------------
// ------------------ TComplexNegOpExpr ------------------
// ------------------

// DoEval
//
procedure TComplexNegOpExpr.DoEval(const args : TExprBaseListExec; var result : IDataContext);
var
   v : IDataContext;
begin
   v:=TDataExpr(args.ExprBase[0]).DataPtr[args.Exec];

   result.AsFloat[0]:=-v.AsFloat[0];
   result.AsFloat[1]:=-v.AsFloat[1];
end;

// ------------------
// ------------------ TComplexAddOpExpr ------------------
// ------------------

// DoEval
//
procedure TComplexAddOpExpr.DoEval(const args : TExprBaseListExec; var result : IDataContext);
var
   leftData, rightData : IDataContext;
begin
   leftData:=TDataExpr(args.ExprBase[0]).DataPtr[args.Exec];
   rightData:=TDataExpr(args.ExprBase[1]).DataPtr[args.Exec];

   result[0]:=leftData[0]+rightData[0];
   result[1]:=leftData[1]+rightData[1];
end;

// ------------------
// ------------------ TComplexSubOpExpr ------------------
// ------------------

// DoEval
//
procedure TComplexSubOpExpr.DoEval(const args : TExprBaseListExec; var result : IDataContext);
var
   leftData, rightData : IDataContext;
begin
   leftData:=TDataExpr(args.ExprBase[0]).DataPtr[args.Exec];
   rightData:=TDataExpr(args.ExprBase[1]).DataPtr[args.Exec];

   result[0]:=leftData[0]-rightData[0];
   result[1]:=leftData[1]-rightData[1];
end;

// ------------------
// ------------------ TComplexMultOpExpr ------------------
// ------------------

// DoEval
//
procedure TComplexMultOpExpr.DoEval(const args : TExprBaseListExec; var result : IDataContext);
var
   leftData, rightData : IDataContext;
begin
   leftData:=TDataExpr(args.ExprBase[0]).DataPtr[args.Exec];
   rightData:=TDataExpr(args.ExprBase[1]).DataPtr[args.Exec];

   result[0]:=leftData[0]*rightData[0]-leftData[1]*rightData[1];
   result[1]:=leftData[1]*rightData[0]+leftData[0]*rightData[1];
end;

// ------------------
// ------------------ TComplexDivOpExpr ------------------
// ------------------

// DoEval
//
procedure TComplexDivOpExpr.DoEval(const args : TExprBaseListExec; var result : IDataContext);
var
   leftData, rightData : IDataContext;
   d : Double;
begin
   leftData:=TDataExpr(args.ExprBase[0]).DataPtr[args.Exec];
   rightData:=TDataExpr(args.ExprBase[1]).DataPtr[args.Exec];

   d:=Sqr(rightData[0])+Sqr(rightData[1]);
   result[0]:=(leftData[0]*rightData[0]+leftData[1]*rightData[1])/d;
   result[1]:=(leftData[1]*rightData[0]-leftData[0]*rightData[1])/d;
end;

// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------
initialization
// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------

   dwsInternalUnit.AddSymbolsRegistrationProc(RegisterComplexType);
   dwsInternalUnit.AddOperatorsRegistrationProc(RegisterComplexOperators);
   dwsInternalUnit.AddAbsHandler(HandleComplexAbs);

   RegisterInternalFunction(TComplexMakeExpr, 'Complex', ['real', SYS_FLOAT, 'imaginary', SYS_FLOAT], SYS_COMPLEX, [iffStateLess]);
   RegisterInternalStringFunction(TComplexToStrExpr, 'ComplexToStr', ['&c', SYS_COMPLEX], [iffStateLess]);

   RegisterInternalFunction(TComplexNegOpExpr,  'ComplexNeg',  ['&v', SYS_COMPLEX], SYS_COMPLEX, [iffStateLess]);
   RegisterInternalFunction(TComplexAddOpExpr,  'ComplexAdd',  ['&left', SYS_COMPLEX, '&right', SYS_COMPLEX], SYS_COMPLEX, [iffStateLess]);
   RegisterInternalFunction(TComplexSubOpExpr,  'ComplexSub',  ['&left', SYS_COMPLEX, '&right', SYS_COMPLEX], SYS_COMPLEX, [iffStateLess]);
   RegisterInternalFunction(TComplexMultOpExpr, 'ComplexMult', ['&left', SYS_COMPLEX, '&right', SYS_COMPLEX], SYS_COMPLEX, [iffStateLess]);
   RegisterInternalFunction(TComplexDivOpExpr,  'ComplexDiv',  ['&left', SYS_COMPLEX, '&right', SYS_COMPLEX], SYS_COMPLEX, [iffStateLess]);

end.