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; //読込のみラベル
  TAnsiCalculate = class;
  TCalcuAddition = class(TObject) //追加機能
  protected
    owner: TAnsiCalculate; //TAnsiCalculate. AddTCalcuAdditionで親が必ず設定してくれる
  public
    function FileExec(const fname: AnsiString; p: PChar): boolean; virtual; //fileを処理したらtrue
    function LineCmd(const lab: AnsiString; var p: PChar): boolean; virtual; //#で始まる行コマンド
    function CallFunc(const lab: AnsiString; Labels: TAMyCalLabel): boolean; virtual; //func()形式の関数
    function ExeLabel(const lab: AnsiString; var ret: Extended; cmd: TGetLabelCmd): boolean; virtual; //ラベルへの読書
    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:代入文式でも最後の値を出力する
    ErrCount: Integer;
    MyCmd: AnsiString; //Createで渡された文字列
    emsg: AnsiString; //putMsg エラーや結果出力
    OutMsg: AnsiString;
    num: Extended; //結果値
    CallParam: TAMyCalLabel;
    procedure addsub; //拡張機能がpの数値を得る為に呼び numを得る
    function EndCheck(p: PChar): boolean; //pが最初の終端を超えていないかチェック
    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; //ファイルモードで特別な処理がある場合
    procedure ExecCmd; //これで実行する
  end;
function cvU(s: string): Ansistring; //文字コード変換
function addS(s: array of Ansistring): Ansistring; //文字コード連結

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: 'オイラー数'; )
    , (d: 299792458; n: '_c'; h: '光速 m/s'; )
    , (d: 9.80665; n: '_g'; h: '重力加速度 m/s^2'; )
    , (d: 6.62607015E-34; n: '_h'; h: 'プランク定数 J*s'; )
    , (d: 1.380649E23; n: '_k'; h: 'ボルツマン定数 J/K'; )
    , (d: 6.02214076E23; n: '_NA'; h: 'アボガドロ数 /mol'; )
    , (d: 5.6703744191844E-8; n: 'σ'; h: 'シュテファンボルツマン定数'; )
    );


implementation
uses math;

//Lazarusの為に UTF8をコンソール出力可能な文字に変換

function cvU(s: string): Ansistring; //文字コード変換
begin
{$IFDEF FPC}
  Result := UTF8ToConsole(s);
{$ELSE}
  Result := s;
{$ENDIF}
end;

function addS(s: array of Ansistring): Ansistring; //文字コード連結
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のビット反転
      'N': num := not round(num); //ビット反転
    end;

  end;

  if (p^ in ['+', '-']) then
  begin //+か-が前置されたら
    if p[0] = p[1] then begin //++ --演算子
      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; //数値で終わっていたら true 代入だけならfalse
var
  lab: string;
  oldp: PAnsiChar;
begin
  Result := false;
  oldp := p; //ラベルの後に=が無い場合に備えて保存
  while True do begin
    if p^ in LabelTopCharSet + MyLeadBytes then
    begin
      oldp := p; //ラベルの後に=が無い場合に備えて保存
      lab := CAnsiGetAccordZenChars(p, LabelCharSet);
      CAnsiSkipBlank(p);
      if ((p[0] = '=') and (p[1] <> '='))
        or (pA2(p)^ = ':=') then
      begin {比較演算子でないなら}
        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; //連続代入処理
        CAnsiSkipBlank(p);
        if (p^ in [#0, #13, #10]) then break;
      end else begin {name = でないなら }
        p := oldp;
        break;
      end;
    end else break; //ラベルで始まっていない場合
  end;
  CAnsiSkipBlank(p);
  if (pA2(p)^ = '//') then begin
    CAnsiGetNextStr(p, [#0, #13, #10]); //コメントなので改行まで読み捨て
  end else
    if not (p^ in [#0, #13, #10]) then begin
      addsub;
      Result := True;
      CAnsiSkipBlank(p);
    end;
end;

//
//関数内等で文字列の数式を処理させるためのもの

function TAnsiCalculate.formulaLine(cmd: string): boolean; //最後が数値で終わっていたら 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]); //先頭の空白は除く 改行文字も
    eMsg := '';
    LineSt := p;
    if p^ = '#' then begin //先頭#は何か特殊処理に使う予定
      while true do begin //Breakを使う為で無限ループではない
        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 // 書式を付けられるようにしようかと思ったが反映させていない
          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 ビット反転  ~ 24bitビット反転'));
        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; //行先頭に戻る
      CAnsiGetNextStr(p, [#0, #13, #10]); //行の残りを読み飛ばす
      continue;
    end; //'#'処理終了
    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(''); //行をそのまま出力する
      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;
        //++/--の時は初期値が0の新規ラベルとして処理
        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の呪いから逃げるには文字列加算をしてはいけない

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); //外部関数がみつかるなら終了
    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 + '(?)'); //文字列を渡されたエラー
    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 + '(?,)'); //文字列を渡されたエラー
    if CallParam[1].nm <> '' then Err(lab + '(,?)'); //文字列を渡されたエラー
    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; //既に登録されていたら登録しない
  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; //既に登録されていたら登録しない
  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;

 //継承しなかった時はラベルが無いとする

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.