unit CalcAnsiScript;

interface
uses SysUtils
  , uAnsiCharTools
{$IFDEF FPC}
  , LazUTF8
{$ENDIF}
  ;
type
  TMyCalLabel = record nm: AnsiString; dt: Extended; end;
  TAMyCalLabel = array of TMyCalLabel;
  TCallFunc = function(const lab: string; const Labels: TAMyCalLabel): boolean of object;
  TExeLabel = function(const lab: string; var ret: Extended; cmd: TGetLabelCmd): boolean of object;
  TGetConst = function(const lab: string; out ret: Extended): boolean of object; //“Çž‚Ì‚Ýƒ‰ƒxƒ‹
  TAnsiCalculate = class;
  TCalcuAddition = class(TObject) //’Ç‰Á‹@”\
  protected
    owner: TAnsiCalculate; //TAnsiCalculate. AddTCalcuAddition‚Åe‚ª•K‚¸Ý’è‚µ‚Ä‚­‚ê‚é
  public
    function FileExec(const fname: AnsiString; p: PChar): boolean; virtual; //file‚ðˆ—‚µ‚½‚çtrue
    function LineCmd(const lab: AnsiString; var p: PChar): boolean; virtual; //#‚ÅŽn‚Ü‚ésƒRƒ}ƒ“ƒh
    function CallFunc(const lab: AnsiString; Labels: TAMyCalLabel): boolean; virtual; //func()Œ`Ž®‚ÌŠÖ”
    function ExeLabel(const lab: AnsiString; var ret: Extended; cmd: TGetLabelCmd): boolean; virtual; //ƒ‰ƒxƒ‹‚Ö‚Ì“Ç‘
    procedure StartEndScript(n: Integer); virtual; //0:start 1:end;
  end;
  TCalcuAdditionClass = class of TCalcuAddition;

  TAnsiCalculate = class(TObject)
  private
    function formulaLineIn: boolean;
  protected
    Ext: array of TCalcuAddition;
    Labels: TAMyCalLabel;
    OutFmt: AnsiString; //
    opt: TCAnsiCalcOpt;
    p
      , LineSt, endp: PAnsiChar;
    procedure comp;
    procedure factor;
    procedure muldiv;
    procedure next;
    procedure Vshift;
    function CallFunc(const lab: AnsiString): boolean; virtual;
    function ExeLabel(const lab: AnsiString; var ret: Extended; cmd: TGetLabelCmd): boolean; virtual;
    function constLabel(const lab: AnsiString; var ret: Extended; cmd: TGetLabelCmd): boolean; virtual;
    procedure ConstPrint;
    procedure ExecInit; virtual;
  public
    OnCallFunc: TCallFunc;
    OnExeLabel: TExeLabel;
    OnGetConst: TGetConst;
    calcMode: Integer; //b0:‘ã“ü•¶Ž®‚Å‚àÅŒã‚Ì’l‚ðo—Í‚·‚é
    ErrCount: Integer;
    MyCmd: AnsiString; //Create‚Å“n‚³‚ê‚½•¶Žš—ñ
    emsg: AnsiString; //putMsg ƒGƒ‰[‚âŒ‹‰Êo—Í
    OutMsg: AnsiString;
    num: Extended; //Œ‹‰Ê’l
    CallParam: TAMyCalLabel;
    procedure addsub; //Šg’£‹@”\‚ªp‚Ì”’l‚ð“¾‚éˆ×‚ÉŒÄ‚Ñ num‚ð“¾‚é
    function EndCheck(p: PChar): boolean; //p‚ªÅ‰‚ÌI’[‚ð’´‚¦‚Ä‚¢‚È‚¢‚©ƒ`ƒFƒbƒN
    procedure Err(msg: AnsiString); virtual;
    procedure AddTCalcuAddition(add: TCalcuAdditionClass);
    procedure PutLine(add: string); virtual;
    procedure putMsg(msg: AnsiString); virtual;
    procedure MsgOut(msg: AnsiString); virtual;
    procedure MsgOutLn(msg: AnsiString); virtual;
    function formulaLine(cmd: string): boolean;
    constructor Create(cmd: AnsiString);
    destructor Destroy; override;
    function FileExec(const fname: AnsiString): boolean; virtual; //ƒtƒ@ƒCƒ‹ƒ‚[ƒh‚Å“Á•Ê‚Èˆ—‚ª‚ ‚éê‡
    procedure ExecCmd; //‚±‚ê‚ÅŽÀs‚·‚é
  end;
function cvU(s: string): Ansistring; //•¶ŽšƒR[ƒh•ÏŠ·
function addS(s: array of Ansistring): Ansistring; //•¶ŽšƒR[ƒh˜AŒ‹

var
  CalcuAdditions: array of TCalcuAdditionClass = nil;
procedure CalcAddTCalcuAddition(add: TCalcuAdditionClass);

const
  ConstTable: array[0..7] of record d: Extended; n, h: AnsiString end =
  ((d: 3.1415926535897932384626433; n: 'PI'; h: '‰~Žü—¦'; )
    , (d: 2.7182818284590452353602874; n: '_e'; h: 'ƒIƒCƒ‰[”'; )
    , (d: 299792458; n: '_c'; h: 'Œõ‘¬ m/s'; )
    , (d: 9.80665; n: '_g'; h: 'd—Í‰Á‘¬“x m/s^2'; )
    , (d: 6.62607015E-34; n: '_h'; h: 'ƒvƒ‰ƒ“ƒN’è” J*s'; )
    , (d: 1.380649E23; n: '_k'; h: 'ƒ{ƒ‹ƒcƒ}ƒ“’è” J/K'; )
    , (d: 6.02214076E23; n: '_NA'; h: 'ƒAƒ{ƒKƒhƒ” /mol'; )
    , (d: 5.6703744191844E-8; n: 'ƒÐ'; h: 'ƒVƒ…ƒeƒtƒ@ƒ“ƒ{ƒ‹ƒcƒ}ƒ“’è”'; )
    );


implementation
uses math;

//Lazarus‚Ìˆ×‚É UTF8‚ðƒRƒ“ƒ\[ƒ‹o—Í‰Â”\‚È•¶Žš‚É•ÏŠ·

function cvU(s: string): Ansistring; //•¶ŽšƒR[ƒh•ÏŠ·
begin
{$IFDEF FPC}
  Result := UTF8ToConsole(s);
{$ELSE}
  Result := s;
{$ENDIF}
end;

function addS(s: array of Ansistring): Ansistring; //•¶ŽšƒR[ƒh˜AŒ‹
var
  len, i, n: integer;
begin
  len := 0;
  for i := 0 to High(s) do len := len + length(s[i]);
  Setlength(result, len);
  n := 1;
  for i := 0 to High(s) do begin
    move(s[i][1], result[n], length(s[i]));
    inc(n, length(s[i]));
  end;
end;

{ TAnsiCalculate }
type
  TAChar3 = array[0..2] of AnsiChar;
  TAChar2 = array[0..1] of AnsiChar;
  pA3 = ^TAChar3;
  pA2 = ^TAChar2;



procedure TAnsiCalculate.ConstPrint;
var
  i: Integer;
begin
  for i := 0 to High(ConstTable) do
    with ConstTable[i] do begin
      MsgOutLn(addS(['// ', n, ' #', cvU(h)]));
    end;
end;

procedure TAnsiCalculate.next;
begin
  inc(p); end;

procedure TAnsiCalculate.factor;
var
  lab, s: AnsiString;
  i64: Int64;
  n: Integer;
  oldp: PAnsiChar;
  procedure inFuncParam();
  begin
    SetLength(CallParam, n + 1);
    next;
    if p^ in ['''', '"'] then begin
      oldp := p;
      inc(p);
      s := CAnsiGetNextStr(p, [oldp^, #13, #10, #0]);
      if p^ <> oldp^ then Err(s + '?');
      CallParam[n].nm := copy(s, 1, p - oldp - 1);
    end else addsub;
    CAnsiSkipBlank(p);
    CallParam[n].nm := '';
    CallParam[n].dt := num;
  end;
begin
  CAnsiSkipBlank(p);
  if (p^ = '(') then
  begin
    next;
    addsub;
    CAnsiSkipBlank(p);
    if (p^ <> ')') then raise EAbort.Create('):' + p^ + ' is NG');
    next;
  end else
  begin
    if CAnsiGetAsmHex(p, i64) then begin
      num := i64;
      CAnsiSkipBlank(p);
      exit;
    end;
    if CAnsiGetAsmBin(p, i64) then begin
      num := i64;
      CAnsiSkipBlank(p);
      exit;
    end;
    if not CAnsiGetDotNumExt(p, num) then
      if (p^ in LabelTopCharSet + MyLeadBytes)
        then
      begin
        lab := CAnsiGetAccordZenChars(p, LabelCharSet);
        CAnsiSkipBlank(p);
        if p^ = '(' then
        begin
          n := 0;
          inFuncParam();
          while p^ = ',' do begin
            inc(n);
            inFuncParam();
          end;
          if (p^ <> ')') then Err(lab + '(... ")"?');
          next;
          if not CallFunc(lab) then Err(lab + ' is not function ');
        end else
        begin
          if not ExeLabel(lab, num, glGetData) then Err(lab + ' undefined labels');
        end;
      end else Exception.Create(p + ' is not numeric ')
  end;
  CAnsiSkipBlank(p);
end;

procedure TAnsiCalculate.Vshift;
var
  savenum: Extended;
  oldsym: AnsiChar;
begin
  factor;

  if (p^ in ['>', '<'])
    and (p^ = p[1])
    and (not (csLLRR_NG in opt)) then begin
    savenum := num; oldsym := p^; inc(p, 2);
    factor;
    case oldsym of
      '>': num := ord(trunc(savenum) shr trunc(num)); //>>
      '<': num := ord(trunc(savenum) shl trunc(num)); //<<
    end;
    exit;
  end;

  if ((pA3(p)^ = 'SHL')
    or (pA3(p)^ = 'shl'))
    and (p[3] in [#9, ' ', '(', '$', '0'..'9']) then begin
    savenum := num; inc(p, 3);
    factor;
    num := round(savenum) shl round(num);
    exit;
  end else
    if ((pA3(p)^ = 'SHR')
      or (pA3(p)^ = 'shr')
      ) and (p[3] in [#9, ' ', '(', '$', '0'..'9']) then begin
      savenum := num; inc(p, 3);
      factor;
      num := round(savenum) shr round(num);
      exit;
    end;

  while (p^ in ['^']) do
  begin
    savenum := num; oldsym := p^; next;
    factor;
    case oldsym of
      '^': num := power(savenum, num);
    end;
  end;
end;

  //==	“™‚µ‚¢
  //!=	“™‚µ‚­‚È‚¢
  //<	‚æ‚è¬‚³‚¢
  //>	‚æ‚è‘å‚«‚¢
  //<=	ˆÈ‰º
  //>=	ˆÈã

procedure TAnsiCalculate.comp;
var
  savenum: Extended;
  oldsym: AnsiChar;
begin
  Vshift;

  if (p^ in ['!', '='])
    and (p[1] = '=') then begin
    savenum := num; oldsym := p^; inc(p, 2);
    Vshift;
    case oldsym of
      '!': num := ord(round(savenum) <> round(num));
      '=': num := ord(round(savenum) = round(num));
    end;
  end else
    if (p^ in ['>', '<'])
      and (not (p[1] in ['>', '<'])) then
    begin
      if p[1] = '=' then begin
        savenum := num; oldsym := p^; inc(p, 2);
        Vshift;
        case oldsym of
          '>': num := ord(savenum >= num);
          '<': num := ord(savenum <= num);
        end;

      end else begin
        savenum := num; oldsym := p^; inc(p);
        Vshift;
        case oldsym of
          '>': num := ord(savenum > num);
          '<': num := ord(savenum < num);
        end;
      end;
    end;
end;

procedure TAnsiCalculate.muldiv;
var
  savenum: Extended;
  oldsym: AnsiChar;
begin
  comp;
  while (p^ in ['*', '/', '^']) do
  begin

    if pA2(p)^ = '//' then exit;

    savenum := num; oldsym := p^; next;
    comp;
    try
      case oldsym of
        '^': num := power(savenum, num);
        '*': num := savenum * num;
        '/': num := savenum / num;
      end;
    except num := 0; end;
  end;
end;

procedure TAnsiCalculate.addsub;
var
  savenum: Extended;
  oldsym: AnsiChar;
  lab: AnsiString;
begin
  CAnsiSkipBlank(p);
  if pA2(p)^ = '//' then exit;
  if (p^ in ['!', '~']) or (pA3(p)^ = 'NOT') then begin
    oldsym := p^; inc(p);
    if oldsym = 'N' then inc(p, 2);
    addsub;
    case oldsym of
      '!': if num > 0.5 then num := ord(false) else num := ord(True);
      '~': num := $FFFFFF xor round(num); //24bit‚Ìƒrƒbƒg”½“]
      'N': num := not round(num); //ƒrƒbƒg”½“]
    end;

  end;

  if (p^ in ['+', '-']) then
  begin //+‚©-‚ª‘O’u‚³‚ê‚½‚ç
    if p[0] = p[1] then begin //++ --‰‰ŽZŽq
      oldsym := p^;
      CAnsiSkipBlank(p);

      if (p^ in ['$'] + LabelTopCharSet + MyLeadBytes) then
      begin
        lab := CAnsiGetAccordZenChars(p, LabelCharSet);
        case oldsym of
          '+': num := 1;
          '-': num := -1;
        end;
        if not ExeLabel(lab, num, glPrePP) then raise EAbort.Create(lab + ' undefined labels');
      end else raise EAbort.Create('++/-- >label?');
    end else begin
      oldsym := p^; next;
      case oldsym of
        '+': MulDiv;
        '-': begin MulDiv; num := -num; end;
      end
    end;
  end else muldiv;
  if ((pA3(p)^ = 'AND')
    or (pA3(p)^ = 'and')
    ) and (p[3] in [#9, ' ', '(', '$', '0'..'9']) then begin
    savenum := num; inc(p, 3);
    addsub;
    num := round(savenum) and round(num);
    exit;
  end else
    if ((pA2(p)^ = 'OR')
      or (pA2(p)^ = 'or')
      ) and (p[2] in [#9, ' ', '(', '$', '0'..'9']) then begin
      savenum := num; inc(p, 2);
      addsub;
      num := round(savenum) or round(num);
      exit;
    end else
      if (pA3(p)^ = 'XOR')
        or (pA3(p)^ = 'xor') then begin
        savenum := num; inc(p, 3);
        addsub;
        num := round(savenum) xor round(num);
        exit;
      end;
  while (p^ in ['+', '-', '&', '|']) do
  begin
    savenum := num; oldsym := p^; next;
    muldiv;
    case oldsym of
      '&': num := round(savenum) and round(num);
      '|': num := round(savenum) or round(num);
      '+': num := savenum + num;
      '-': num := savenum - num;
    end;
  end;
end;


function MyNumToStr(d: Extended): string;
var
  c: string;
begin
  Result := NumToStr(d, c);
  if c <> '' then Result := Result + format('(%g)', [d]);
end;

procedure TAnsiCalculate.ExecInit;
begin
  p := PAnsiChar(MyCmd);
  SetLength(Labels, 0);
  OutMsg := '';
  eMsg := '';
end;

function TAnsiCalculate.formulaLineIn(): boolean; //”’l‚ÅI‚í‚Á‚Ä‚¢‚½‚ç true ‘ã“ü‚¾‚¯‚È‚çfalse
var
  lab: string;
  oldp: PAnsiChar;
begin
  Result := false;
  oldp := p; //ƒ‰ƒxƒ‹‚ÌŒã‚É=‚ª–³‚¢ê‡‚É”õ‚¦‚Ä•Û‘¶
  while True do begin
    if p^ in LabelTopCharSet + MyLeadBytes then
    begin
      oldp := p; //ƒ‰ƒxƒ‹‚ÌŒã‚É=‚ª–³‚¢ê‡‚É”õ‚¦‚Ä•Û‘¶
      lab := CAnsiGetAccordZenChars(p, LabelCharSet);
      CAnsiSkipBlank(p);
      if ((p[0] = '=') and (p[1] <> '='))
        or (pA2(p)^ = ':=') then
      begin {”äŠr‰‰ŽZŽq‚Å‚È‚¢‚È‚ç}
        if p[0] = ':' then Inc(p);
        Inc(p);
        addsub;
        CAnsiSkipBlank(p);
        if not ExeLabel(lab, num, glSetData) then Err(lab + '?');
        if not (p^ in [',', ';', ':']) then
        begin
          break;
        end;
        Next; //˜A‘±‘ã“üˆ—
        CAnsiSkipBlank(p);
        if (p^ in [#0, #13, #10]) then break;
      end else begin {name = ‚Å‚È‚¢‚È‚ç }
        p := oldp;
        break;
      end;
    end else break; //ƒ‰ƒxƒ‹‚ÅŽn‚Ü‚Á‚Ä‚¢‚È‚¢ê‡
  end;
  CAnsiSkipBlank(p);
  if (pA2(p)^ = '//') then begin
    CAnsiGetNextStr(p, [#0, #13, #10]); //ƒRƒƒ“ƒg‚È‚Ì‚Å‰üs‚Ü‚Å“Ç‚ÝŽÌ‚Ä
  end else
    if not (p^ in [#0, #13, #10]) then begin
      addsub;
      Result := True;
      CAnsiSkipBlank(p);
    end;
end;

//
//ŠÖ”“à“™‚Å•¶Žš—ñ‚Ì”Ž®‚ðˆ—‚³‚¹‚é‚½‚ß‚Ì‚à‚Ì

function TAnsiCalculate.formulaLine(cmd: string): boolean; //ÅŒã‚ª”’l‚ÅI‚í‚Á‚Ä‚¢‚½‚ç true ‘ã“ü‚¾‚¯‚È‚çfalse
var
  oldp: PAnsiChar;
begin
  oldp := p;
  try
    p := PAnsiChar(cmd);
    while p^ <> #0 do begin
      Result := formulaLineIn();
      CAnsiSkip(p, [#9, ' ', #13, #10])
    end;
  finally
    p := oldp;
  end;
end;

procedure TAnsiCalculate.ExecCmd;
var
  lab: string;
  oldp: PAnsiChar;
  i: Integer;
begin
  ErrCount := 0;
  ExecInit;
  for i := 0 to High(Ext) do
    Ext[i].StartEndScript(0);
  while p^ <> #0 do
  begin
    CAnsiSkip(p, [#9, ' ', #13, #10]); //æ“ª‚Ì‹ó”’‚Íœ‚­ ‰üs•¶Žš‚à
    eMsg := '';
    LineSt := p;
    if p^ = '#' then begin //æ“ª#‚Í‰½‚©“ÁŽêˆ—‚ÉŽg‚¤—\’è
      while true do begin //Break‚ðŽg‚¤ˆ×‚Å–³ŒÀƒ‹[ƒv‚Å‚Í‚È‚¢
        inc(p);
        lab := CAnsiGetAccordZenChars(p, LabelCharSet);
        CAnsiSkipBlank(p);
        if lab = 'ScriptFile' then begin
          if p[0] <> '=' then Err('ScriptFile‚ÌŒã‚É=‚ª–³‚¢');
          PutLine(cvU('// –¢ŽÀ‘•'));
          break;
        end;
        if lab = 'fmt' then begin // ‘Ž®‚ð•t‚¯‚ç‚ê‚é‚æ‚¤‚É‚µ‚æ‚¤‚©‚ÆŽv‚Á‚½‚ª”½‰f‚³‚¹‚Ä‚¢‚È‚¢
          if p[0] <> '=' then Err(cvU('fmt‚ÌŒã‚É=‚ª–³‚¢'));
          OutFmt := CAnsiGetNextStr(p, [#0, #13, #10]);
          PutLine(cvU('// –¢ŽÀ‘•'));
          break;
        end;
        if AnsiSameText(lab, cvU('’è”')) then begin
          PutLine('');
          ConstPrint;
          break;
        end;
        if AnsiSameText(lab, 'm') then begin
          CAnsiSkipBlank(p);
          addsub;
          calcMode := Round(num);
          break;
        end;
        if SameText(lab, 'h') or (lab = '') then //help
        begin
          PutLine('');
          MsgOutLn(cvU('#’è” ‚Å “à•”’è”ˆê——'#13#10' !˜_—”½“](0Ì1)@NOT ƒrƒbƒg”½“]  ~ 24bitƒrƒbƒg”½“]'));
        end;
        for i := 0 to High(Ext) do if Ext[i].LineCmd(lab, p) then break;
        break;
      end;
      if p^ in [#0, #13, #10] then continue; //sæ“ª‚É–ß‚é
      CAnsiGetNextStr(p, [#0, #13, #10]); //s‚ÌŽc‚è‚ð“Ç‚Ý”ò‚Î‚·
      continue;
    end; //'#'ˆ—I—¹
    try
      if formulaLineIn() then begin
        if eMsg <> '' then PutLine(eMsg)
        else PutLine(MyNumToStr(num));
        if not (p^ in [#0, #13, #10]) then CAnsiGetNextStr(p, [#0, #13, #10]);
      end else begin
        CAnsiGetNextStr(p, [#0, #13, #10]);
        if (calcMode and 1) <> 0 then PutLine(MyNumToStr(num))
        else PutLine(''); //s‚ð‚»‚Ì‚Ü‚Üo—Í‚·‚é
      end;
    except
      PutLine(eMsg); //
      CAnsiGetNextStr(p, [#0, #13, #10]);
    end;
  end;
  for i := 0 to High(Ext) do
    Ext[i].StartEndScript(1);

end;

procedure TAnsiCalculate.PutLine(add: string);
var
  lin: string;
  sz: Integer;
begin
  sz := p - LineSt;
  if sz > 0 then begin
    SetLength(lin, sz);
    move(LineSt^, lin[1], sz);
  end else lin := '';
  if add <> '' then lin := lin + '//' + add;
  MsgOutLn(lin);

end;

procedure TAnsiCalculate.Err(msg: AnsiString);
begin
  inc(ErrCount);
  putMsg('!Err:' + msg);
  raise EAbort.Create(msg);
end;


function TAnsiCalculate.constLabel(const lab: AnsiString; var ret: Extended; cmd: TGetLabelCmd): boolean;
var
  i: Integer;
begin
  Result := false;
  if cmd <> glGetData then exit;
  for i := 0 to High(ConstTable) do
    if ConstTable[i].n = lab then
    begin
      Result := True;
      ret := ConstTable[i].d;
    end;
end;

function TAnsiCalculate.ExeLabel(const lab: AnsiString; var ret: Extended; cmd: TGetLabelCmd): boolean;
var
  i: Integer;
begin
  if (glGetData = cmd) and Assigned(OnGetConst) then begin
    Result := OnGetConst(lab, ret);
    if Result then exit;
  end;
  Result := true;
  for i := 0 to High(Ext) do
    if Ext[i].ExeLabel(lab, ret, cmd) then exit;
  Result := True;
  case cmd of
    glSetData: begin
        for i := 0 to High(Labels) do if Labels[i].nm = lab then begin
            Labels[i].dt := ret;
            exit;
          end;
        i := length(labels);
        setlength(Labels, i + 1);
        Labels[i].nm := lab;
        Labels[i].dt := ret;
        exit;
      end;
    glGetData: begin
        for i := 0 to High(Labels) do if Labels[i].nm = lab then begin
            ret := Labels[i].dt;
            exit;
          end;
        Result := constLabel(lab, ret, cmd);
        exit;
      end;
    glPrePP: begin
        for i := 0 to High(Labels) do if Labels[i].nm = lab then begin
            Labels[i].dt := Labels[i].dt + ret;
            ret := Labels[i].dt;
            exit;
          end;
        //++/--‚ÌŽž‚Í‰Šú’l‚ª0‚ÌV‹Kƒ‰ƒxƒ‹‚Æ‚µ‚Äˆ—
        i := length(labels);
        setlength(Labels, i + 1);
        Labels[i].nm := lab;
        Labels[i].dt := ret;
        exit;
      end;
  end;
end;



procedure TAnsiCalculate.putMsg(msg: AnsiString);
var
  w, sz: integer;
begin
  w := length(eMsg);
  sz := length(msg);
  SetLength(eMsg, w + sz);
  move(msg[1], eMsg[w + 1], sz);
end;

//FPC‚ÌUTF8‚ÌŽô‚¢‚©‚ç“¦‚°‚é‚É‚Í•¶Žš—ñ‰ÁŽZ‚ð‚µ‚Ä‚Í‚¢‚¯‚È‚¢

procedure TAnsiCalculate.MsgOut(msg: AnsiString);
var
  w, sz: integer;
begin
  w := length(OutMsg);
  sz := length(msg);
  SetLength(OutMsg, w + sz);
  move(msg[1], OutMsg[w + 1], sz);
end;

procedure TAnsiCalculate.MsgOutLn(msg: AnsiString);
var
  w, sz: integer;
begin
  MsgOut(msg); MsgOut(#13#10);
end;
// CallParam:array of: Extended

function TAnsiCalculate.CallFunc(const lab: AnsiString): boolean;
var
  pmCnt, i: Integer;
  s: string;
begin
  if Assigned(OnCallFunc) then begin
    Result := OnCallFunc(lab, CallParam); //ŠO•”ŠÖ”‚ª‚Ý‚Â‚©‚é‚È‚çI—¹
    if Result then exit;
  end;
  Result := true;
  for i := 0 to High(Ext) do
    if Ext[i].CallFunc(lab, CallParam) then exit;

  pmCnt := length(CallParam);
  num := 0;
  Result := true;

  if sameText(lab, 'pr') then begin
    if pmCnt = 0 then Err('pr(?)');
    case pmCnt of
      2: s := format(CallParam[0].nm, [CallParam[1].dt]);
      3: s := format(CallParam[0].nm, [CallParam[1].dt, CallParam[2].dt]);
      4: s := format(CallParam[0].nm, [CallParam[1].dt, CallParam[2].dt, CallParam[3].dt]);
      5: s := format(CallParam[0].nm, [CallParam[1].dt, CallParam[2].dt, CallParam[3].dt, CallParam[4].dt]);
    else Err('pr("",... over)');
    end;
  end;
  if pmCnt = 1 then begin
    if CallParam[0].nm <> '' then Err(lab + '(?)'); //•¶Žš—ñ‚ð“n‚³‚ê‚½ƒGƒ‰[
    if sameText(lab, 'sin') then begin num := sin(CallParam[0].dt); exit; end;
    if sameText(lab, 'cos') then begin num := cos(CallParam[0].dt); exit; end;
    if sameText(lab, 'tan') then begin num := tan(CallParam[0].dt); exit; end;
    if sameText(lab, 'log') then begin num := ln(CallParam[0].dt); exit; end;
    if sameText(lab, 'ln') then begin num := ln(CallParam[0].dt); exit; end;
    if sameText(lab, 'exp') then begin num := exp(CallParam[0].dt); exit; end;
    if sameText(lab, 'FRAC') then begin num := FRAC(CallParam[0].dt); exit; end;
    if sameText(lab, 'ROUND') then begin num := ROUND(CallParam[0].dt); exit; end;
    if sameText(lab, 'TRUNC') then begin num := TRUNC(CallParam[0].dt); exit; end;
    if sameText(lab, 'ArcCos') then begin num := ArcCos(CallParam[0].dt); exit; end;
    if sameText(lab, 'ArcSin') then begin num := ArcSin(CallParam[0].dt); exit; end;
    if sameText(lab, 'coTan') then begin num := coTan(CallParam[0].dt); exit; end;
    if sameText(lab, 'Sinh') then begin num := Sinh(CallParam[0].dt); exit; end;
    if sameText(lab, 'Cosh') then begin num := Cosh(CallParam[0].dt); exit; end;
    if sameText(lab, 'Tanh') then begin num := Tanh(CallParam[0].dt); exit; end;
    if sameText(lab, 'ArcCosh') then begin num := ArcCosh(CallParam[0].dt); exit; end;
    if sameText(lab, 'ArcSinh') then begin num := ArcSinh(CallParam[0].dt); exit; end;
    if sameText(lab, 'ArcTanh') then begin num := ArcTanh(CallParam[0].dt); exit; end;
    if sameText(lab, 'LnXP1') then begin num := LnXP1(CallParam[0].dt); exit; end;
    if sameText(lab, 'Log10') then begin num := Log10(CallParam[0].dt); exit; end;
    if sameText(lab, 'Log2') then begin num := Log2(CallParam[0].dt); exit; end;
    if sameText(lab, 'ArcTanh') then begin num := ArcTanh(CallParam[0].dt); exit; end;
    Result := false;
  end;
  if pmCnt = 2 then begin
    if CallParam[0].nm <> '' then Err(lab + '(?,)'); //•¶Žš—ñ‚ð“n‚³‚ê‚½ƒGƒ‰[
    if CallParam[1].nm <> '' then Err(lab + '(,?)'); //•¶Žš—ñ‚ð“n‚³‚ê‚½ƒGƒ‰[
    if sameText(lab, 'ArcTan2') then begin num := ArcTan2(CallParam[0].dt, CallParam[1].dt); exit; end;
    if sameText(lab, 'Hypot') then begin num := Hypot(CallParam[0].dt, CallParam[1].dt); exit; end;
    if sameText(lab, 'LogN') then begin num := LogN(CallParam[0].dt, CallParam[1].dt); exit; end;
    if sameText(lab, 'Power') then begin num := Power(CallParam[0].dt, CallParam[1].dt); exit; end;
    Result := false;
  end;
end;

procedure TAnsiCalculate.AddTCalcuAddition(add: TCalcuAdditionClass);
var
  i, sz: Integer;
begin
  sz := length(Ext);
  for i := 0 to sz - 1 do if Ext[i].ClassName = add.ClassName then exit; //Šù‚É“o˜^‚³‚ê‚Ä‚¢‚½‚ç“o˜^‚µ‚È‚¢
  SetLength(Ext, sz + 1);
  Ext[sz] := add.Create;
  Ext[sz].owner := Self;
end;

function TAnsiCalculate.FileExec(const fname: AnsiString): boolean;
var
  i: Integer;
begin
  p := PAnsiChar(MyCmd);
  Result := false;
  for i := 0 to High(ext) do begin
    Result := Ext[i].FileExec(fname, p);
    if Result then exit;
  end;
end;

procedure CalcAddTCalcuAddition(add: TCalcuAdditionClass);
var
  i, sz: Integer;
begin
  sz := length(CalcuAdditions);
  for i := 0 to sz - 1 do if CalcuAdditions[i].ClassName = add.ClassName then exit; //Šù‚É“o˜^‚³‚ê‚Ä‚¢‚½‚ç“o˜^‚µ‚È‚¢
  SetLength(CalcuAdditions, sz + 1);
  CalcuAdditions[sz] := add;
end;

function TAnsiCalculate.EndCheck(p: PChar): boolean;
begin
  endp := PChar(MyCmd) + length(MyCmd);
  Result := p >= endp;
end;

constructor TAnsiCalculate.Create(cmd: AnsiString);
var
  i: Integer;
begin
  setlength(ext, 0);
  OutFmt := '';
  MyCmd := cmd;

  OutMsg := '';
  SetLength(Labels, 0);
  for i := 0 to High(CalcuAdditions) do
    AddTCalcuAddition(CalcuAdditions[i]);

end;


destructor TAnsiCalculate.Destroy;
var
  i, sz: Integer;
begin
  sz := length(Ext);
  for i := 0 to sz - 1 do Ext[i].Free;
  SetLength(Ext, 0);
  inherited;
end;


{ TCalcuAddition }

function TCalcuAddition.CallFunc(const lab: AnsiString; Labels: TAMyCalLabel): boolean;
begin
  Result := false;
end;

 //Œp³‚µ‚È‚©‚Á‚½Žž‚Íƒ‰ƒxƒ‹‚ª–³‚¢‚Æ‚·‚é

function TCalcuAddition.ExeLabel(const lab: AnsiString; var ret: Extended;
  cmd: TGetLabelCmd): boolean;
begin
  Result := false;
end;

function TCalcuAddition.FileExec(const fname: AnsiString; p: PChar): boolean;
begin
  Result := false;
end;

function TCalcuAddition.LineCmd(const lab: AnsiString; var p: PChar): boolean;
begin
  Result := false;
end;



procedure TCalcuAddition.StartEndScript(n: Integer);
begin
  case n of //0:start 1:end;
    0: begin
      end;
    1: begin
      end;
  end;
end;

end.

