unit KifErtelmezo;

interface

uses Math, SysUtils;

type
    PKfAtom=^TKfAtom;
    TKfAtom=object
      Parent: PKfAtom;
      Op1,Op2: PKfAtom;
      Constructor Create;
      Destructor Destroy; virtual;
      Function GetValue: Single; virtual;
    end;

    PErtek=^TErtek;
    TErtek=object(TKfAtom)
      Value: Single;
      Constructor Create(Valu:single);
      Function GetValue: Single; virtual;
    end;

    PPlusMinus=^TPlusMinus;
    TPlusMinus=object(TKfAtom)
      mode: Boolean;
      Constructor Create(amode: Boolean);
      Function GetValue: Single; virtual;
    end;

    PSzorOszt=^TSzorOszt;
    TSzorOszt=object(TPlusMinus)
      Function GetValue: Single; virtual;
    end;

    PFX=^TFX;
      TFX=object(TKfAtom)
      mode: Byte;
      Constructor Create(amode: Byte);
      Function GetValue: Single; virtual;
    end;

    TRefTable=record
      Count: Byte;
      Data: Array[1..255] of Record
        Name: Char;
        Value: Double;
      end;
     end;

    PKif=^TKif;
    TKif=object
       FirstAtom: PKfAtom;
       Refs: TRefTable;
       Pnt: PKif;
       Constructor Create(PointR:PKif);
       Destructor Destroy;
       Function WhereIs(name:char):byte;
       Function GetValue: Single; virtual;
       Function AssignCV(name:char;value:single):boolean; virtual;
       Function DelCV(name:char;value:single):boolean; virtual;
       Function ChangeValue(name:char;newvalue:single):boolean; virtual;
       Procedure SetExp(s: String; var P: PKfAtom; AParent: PKfAtom); virtual;
    end;

    PRef=^TRef;
    TRef=object(TKfAtom)
      Value: Single;
      Name: Char;
      Kif: PKif;
      Constructor Create(aname: Char; PointR:PKif);
      Function GetValue: Single; virtual;
      Procedure Refresh; virtual;
    end;

Const
    fxSin  = 1;
    fxCos  = 2;
    fxTan  = 3;
    fxSqr  = 4;
    fxSqrt = 5;
    fxLog  = 6;
    fxExp  = 7;
    fxAbs  = 8;
    fxRnd  = 9;
    fxRand = 10;
    fxMod = 11;
    fxDiv = 12;
    fxArcCos = 13;
    fxArcSin = 14;
    fxCotan = 15;
    fxCosh = 16;
    fxSinh = 17;
    fxTanh = 18;
    fxArcCosh = 19;
    fxArcSinh = 20;
    fxArcTanh = 21;
    fxLog10 = 22;
    fxLog2 = 23;
    fxLogN = 24;
    fxPower = 25;

    precedencia:array [1..5] of char = ('+','-','*','/','^');
    fxStrings:array [1..24] of string = ('sin','cos','tan','sqr','sqrt',
                                         'log','exp','abs','rnd','rand',
                                         'mod','div','arccos','arcsin',
                                         'cotan','cosh','sinh','tanh',
                                         'arccosh','arcsinh','arctanh',
                                         'log10','log2','logN');


implementation

{ TKfAtom }

constructor TKfAtom.Create;
begin
    parent:=nil;
    op1:=nil;
    op2:=nil;
end;

destructor TKfAtom.Destroy;
begin
    if op1<>nil then op1^.Destroy;
    if op2<>nil then op2^.Destroy;
end;

function TKfAtom.GetValue: Single;
begin

end;

{ TErtek }

constructor TErtek.Create(valu:single);
begin
   Value:=Valu;
end;

function TErtek.GetValue: Single;
begin
    Getvalue:=Value;
end;

{ TPlusMinus }

constructor TPlusMinus.Create(amode: Boolean);
begin
    mode:=amode;
end;

function TPlusMinus.GetValue: Single;
begin
    if (op1<>nil) and (op2<>nil) then
    begin
      if mode then GetValue:=op1^.GetValue+op2^.GetValue
              else GetValue:=op1^.GetValue-op2^.GetValue;
    end
    else
      if (op1=nil) and (op2<>nil) and (not mode) then Getvalue:=-op2^.GetValue
                                                 else Getvalue:=0;
end;

{ TSzorOszt }

function TSzorOszt.GetValue: Single;
begin
    if (op1<>nil) and (op2<>nil) then
    begin
      if mode then GetValue:=op1^.GetValue*op2^.GetValue
              else GetValue:=op1^.GetValue/op2^.GetValue;
    end
    else Getvalue:=0;
end;

{ TFX }

constructor TFX.Create(amode: Byte);
begin
    mode:=amode;
end;

function TFX.GetValue: Single;
begin
    if op1<>nil then
    begin
      case mode of
         fxSin: Getvalue:=sin(op1^.GetValue);
         fxCos: Getvalue:=cos(op1^.GetValue);
         fxTan: Getvalue:=tan(op1^.Getvalue);
         fxSqr: Getvalue:=sqr(op1^.GetValue);
         fxSqrt: Getvalue:=sqrt(op1.GetValue);
         fxExp: Getvalue:=exp(op1^.GetValue);
         fxAbs: Getvalue:=abs(op1^.GetValue);
         fxRnd: Getvalue:=round(op1^.GetValue);
         fxArcCos: Getvalue:=arccos(op1^.GetValue);
         fxArcSin: Getvalue:=arcsin(op1^.GetValue);
         fxCotan: Getvalue:=cotan(op1^.GetValue);
         fxCosh: Getvalue:=cosh(op1^.GetValue);
         fxSinh: Getvalue:=sinh(op1^.GetValue);
         fxTanh: Getvalue:=tanh(op1^.GetValue);
         fxArcCosh: Getvalue:=arccosh(op1^.GetValue);
         fxArcSinh: Getvalue:=arcsinh(op1^.GetValue);
         fxArcTanh: Getvalue:=arctanh(op1^.GetValue);
         fxLog10: Getvalue:=log10(op1^.GetValue);
         fxLog2: Getvalue:=log2(op1^.GetValue);
         fxPower: Getvalue:=power(op1^.GetValue,op2^.GetValue);
      end;
    end
    else Getvalue:=0;
end;

{ ... }

function DelSpcPlusMinus(s:string):string;
begin
   s:=trim(s);
   While pos('+-',s)<>0 do s:=Copy(s,1,pos('+-',s)-1)+'-'+Copy(s,pos('+-',s)+2,255);
   While pos('-+',s)<>0 do s:=Copy(s,1,pos('-+',s)-1)+'-'+Copy(s,pos('+-',s)+2,255);
   While pos('--',s)<>0 do s:=Copy(s,1,pos('--',s)-1)+'+'+Copy(s,pos('--',s)+2,255);
   While pos('++',s)<>0 do s:=Copy(s,1,pos('++',s)-1)+'+'+Copy(s,pos('++',s)+2,255);
   DelSpcPlusMinus:=s;
end;

function DelZarojel(s:string):string;
var i,count:integer;
begin
   while (s[1]='(') and (s[length(s)]=')') do
   begin
     i:=1;
     count:=0;
     while i<>length(s) do
     begin
       case s[i] of
          '(':inc(count);
          ')':dec(count);
       end;
       if (count=0) and (i<>length(s)) then break;
       inc(i);
     end;
     if (i=length(s)) and (count=0) then s:=copy(s,2,length(s)-2);
   end;
   DelZarojel:=s;
end;

{ //.... }

{ TRef }

constructor TRef.Create(aname: Char; PointR:PKif);
begin
   Kif:=PointR;
   name:=aname;
end;

procedure TRef.Refresh;
var i:byte;
    megvan:boolean;
begin
   megvan:=false;
   i:=1;
   while (not megvan) and (i<Kif^.Refs.Count+1) do
   begin
     if Kif^.Refs.Data[i].Name=name then
     begin
        megvan:=true;
        value:=Kif^.Refs.Data[i].value;
        break;
     end;
     inc(i);
   end;
end;

function TRef.GetValue: Single;
begin
   Refresh;
   GetValue:=Value;
end;

{ TKif }

function TKif.WhereIs(name: char): byte;
var megvan:boolean;
    i:byte;
begin
   while (not megvan) and (i<Refs.Count+1) do
   begin
      if Refs.Data[i].Name=name then
      begin
         megvan:=true;
         break;
      end;
      inc(i);
   end;
   if megvan then WhereIs:=i-1 else WhereIs:=0;
end;

function TKif.AssignCV(name: char; value: single): boolean;
begin

end;

function TKif.ChangeValue(name: char; newvalue: single): boolean;
begin

end;

constructor TKif.Create(PointR:PKif);
begin
   FirstAtom:=nil;
   Pnt:=PointR;
   Refs.Count:=0;
end;

function TKif.DelCV(name: char; value: single): boolean;
begin

end;

destructor TKif.Destroy;
begin
   if FirstAtom<>nil then FirstAtom^.Destroy;
end;

function TKif.GetValue: Single;
begin
   if FirstAtom<>nil then GetValue:=FirstAtom^.GetValue else GetValue:=0;
end;

procedure TKif.SetExp(s: String; var P: PKfAtom; AParent: PKfAtom);
var i,j,zjel:integer;
    prec:byte;
    megvan:boolean;
begin
   s:=DelZarojel(DelSpcPlusMinus(s));
   j:=0;
   prec:=1;
   megvan:=false;

   while (prec<6) and (not megvan) do
   begin
      zjel:=0;
      i:=1;
      while (not megvan) and (i<length(s)+1) do
      begin
          case s[i] of
             '(': inc(zjel);
             ')': dec(zjel);
          end;
          if (s[i]=precedencia[prec]) and (zjel=0) then
          begin
              megvan:=true;
              break;
          end;
          inc(i);
      end;
      inc(prec);
   end;

   if megvan then
   begin
      case prec-1 of
        1: p:=New(PPlusMinus, Create(false));
        2: p:=New(PPlusMinus, Create(true));
        3: p:=New(PSzorOszt, Create(false));
        4: p:=New(PSzorOszt, Create(true));
        5: p:=New(PFX, Create(fxPower));
      end;
      p^.parent:=aparent;
      SetExp(copy(s,1,i-1),p^.op1,p);
      SetExp(copy(s,i-1,length(s)-i-1),p^.op2,p);
   end else
   begin
      if length(s)=1 then
        for i:=1 to Refs.Count do
           If Refs.Data[i].Name=s then
           begin
              p:=New(PRef, Create(Refs.Data[i].Name,Pnt));
              p^.parent:=aparent;
              megvan:=true;
              break;
           end;
       if not megvan then
       begin
          val(s,i,j);
          if j=0 then
          begin
            p:=New(PErtek, Create(i));
            p^.parent:=aparent;
            megvan:=true;
          end else
          begin
            i:=1;
            while (not megvan) and (i<25) do
            begin
                if pos(lowercase(fxStrings[i]),lowercase(s))=1 then
                begin
                   case i of
                        fxSin,fxCos,fxTan,fxSqr,
                        fxLog,fxExp,fxAbs,fxRnd:
                           begin
                              s:=copy(s,4,length(s)-5);
                              p:=New(PFX, Create(i));
                              p^.parent:=aparent;
                              p^.Op2:=nil;
                              SetExp(s,p^.op1,p);
                           end;
                        fxSqrt, fxRand, fxCosh, fxSinh,
                        fxTanh, fxLog2:
                           begin
                              s:=copy(s,5,length(s)-6);
                              p:=New(PFX, Create(i));
                              p^.parent:=aparent;
                              p^.Op2:=nil;
                              SetExp(s,p^.op1,p);
                           end;
                        fxArcCos, fxArcSin:
                           begin
                              s:=copy(s,7,length(s)-8);
                              p:=New(PFX, Create(i));
                              p^.parent:=aparent;
                              p^.Op2:=nil;
                              SetExp(s,p^.op1,p);
                           end;
                        fxCotan, fxLog10:
                           begin
                              s:=copy(s,6,length(s)-7);
                              p:=New(PFX, Create(i));
                              p^.parent:=aparent;
                              p^.Op2:=nil;
                              SetExp(s,p^.op1,p);
                           end;
                        fxArcCosh, fxArcSinh, fxArcTanh:
                           begin
                              s:=copy(s,8,length(s)-9);
                              p:=New(PFX, Create(i));
                              p^.parent:=aparent;
                              p^.Op2:=nil;
                              SetExp(s,p^.op1,p);
                           end;
                        fxLogN:;
                   end;

                   break;
                end;
                inc(i);
            end;
          end;
       end;
   end;


end;

end.