unit uAnsiCharTools;
{
 Ansi文字列処理のために裏目小僧が作り貯めたものです
内容はアプリ毎に微調整してるので拾った場所により内容が違うかもしれません。
 バージョン等は管理していませんから。
 
 このファイルについて日本人の方は自由に使って下さい
 日本人ならば原作者の表示も不要です
 翻訳禁止：
　 改変配布は日本人なら自由ですがコメント類の外国語への翻訳はご遠慮下さい
　 作成された実行モジュールについてはご自由に
　 このファイルから学んで作成された場合は翻訳含めて完全にご自由に
}
interface
uses windows, SysUtils;
type
  TCAnsiCalcOpt = set of (
    csSetData_NG, //"label=xx"の代入を無効にする
    csLLRR_NG // シフト演算子<< >> を無効にする
    );
  TGetLabelCmd = (glSetData { "label=xx"の代入時の呼出}
    , glGetData {ラベル値の検索時}
    , glCall { "name(xx)"の1変数関数時の呼出}
    , glPrePP { ++ -- 前置によるラベル値の増減を有効にする});

  TGetLabelProc = function(const lab: AnsiString; var ret: Extended; cmd: TGetLabelCmd): boolean of object;

function CAnsiSkip(var p: pansichar; c: TSysCharSet): integer; //[#9, ' '] で空白ならスキップする
function CAnsiSkipBlank(var p: PAnsiChar; withLF: boolean = false): Integer; //空白ならスキップする(スキップバイト数を返す)
procedure CmtSkipPascal(var p: PChar; c: TSysCharSet); //Pascalスタイル
procedure CmtSkipC(var p: PChar; c: TSysCharSet); //C言語JacaScriptスタイル

function CAnsiGetInteger10(var ptr: PAnsiChar; var retVal: int64): boolean; //10進数のみ
function CAnsiGetInteger(var ptr: PAnsiChar; var retVal: int64): boolean; //16/2/10進数
function CAnsiGetDotNum(var ptr: PAnsiChar; var retVal: Extended): boolean;

function CAnsiGetDotNumExt(var ptr: PAnsiChar; var retVal: Extended): boolean; // K M m u % PI対応
function NumToStr(d: Extended; out ext: string): string; //k M G 等を付けて表現する

function CAnsiGetAccordZenChars(var p: PAnsiChar; c: TSysCharSet): AnsiString; //全角文字または半角の文字セットが連続してる
function CAnsiGetAccordChars(var p: PAnsiChar; c: TSysCharSet): AnsiString; //文字セットが連続してる
function CAnsiGetCSVfield(var p: PAnsiChar): AnsiString; //カンマ区切りの文字を取り出す
function CAnsiCalculateFloat(var p: PAnsiChar; proc: TGetLabelProc = nil; opt: TCAnsiCalcOpt = []): Extended;
function AnsiCalculateFloat(cmd: AnsiString; out remnant: AnsiString): Extended; overload;
function AnsiCalculateFloat(cmd: AnsiString): Extended; overload;



function CAnsiGetHex(var ptr: PAnsiChar; var retVal: int64): boolean; // 1AB3 のような16進数
function CAnsiGetAsmHex(var ptr: PAnsiChar; var retVal: int64): boolean; // 012H のような16進数
function CAnsiGetAsmBin(var ptr: PAnsiChar; var retVal: int64): boolean; //2進数
function AnsiDec2Bin(dec: int64; len: Integer): AnsiString;

function CAnsiGetNextStr(var p: PAnsiChar; c: TSysCharSet): AnsiString; // 文字セットのどれか迄の文字列を返し、ポインタはその位置

function CAnsiGetSplitStr(var p: PAnsiChar; sep: AnsiString): AnsiString; //sepまでの文字列を返し、ポインタはその次を示す
function CAnsiGetSplitStrs(var p: PAnsiChar; sep: array of AnsiString; pno: PINT = nil): AnsiString; //sepまでの文字列を返し、ポインタはsepの次を示す
//複数を渡せばもっとも近いsepの位置。空文字を渡せば例外 文字列があればpno^はsepの0から始まる番号

function CAnsiFindStrs(var p: PAnsiChar; sep: array of ansistring; pno: PINT = nil): boolean; //sepがあればTrue ポインタはsep文字列の次
//複数を渡せばもっとも近いsepの位置。空文字を渡せばtrueが帰りポインタは最終地点 true時 pno^はsepの0から始まる番号

function CAnsiCmpStrs(p: PAnsiChar; str: array of ansistring; pno: PINT = nil): boolean; //pからstr迄が等しいならTrueでpnoは一致したstrの番号

function CAnsiGetByte(var p: PAnsiChar; size: Integer): AnsiString;
function CAnsiGetPrtChar(var p: PAnsiChar; c: AnsiChar): AnsiString; //文字までの位置を返す ただし cが%の場合 %%のように連続していれば無視する
procedure CAnsiCheckChar(var p: PAnsiChar; c: AnsiChar); //cがあれば p++ 無ければ例外
function CAnsiCheck(var p: PAnsiChar; c: AnsiChar): boolean; //p[0]がcであれば p++しtrue  違うならfalse

function CAnsiGetChar(var p: PAnsiChar): AnsiChar; //１文字読む 終了なら例外

var
  CAnsiAsterisk1: Extended = $8000;
  CAnsiAsterisk2: Extended = $800000;
     //81-9FならびにE0-FC  は ShiftJISの最初文字
  MyLeadBytes: TSysCharSet = [#$81..#$9F, #$E0..#$FC];
  MyLeadBytes2: TSysCharSet = [#$81..#$9F, #$E0..#$FC];
  MyLeadBytes3: TSysCharSet = [];
  MyLeadBytes4: TSysCharSet = [];

const
  cSpace = [' ', #9, #10, #13];
  LabelTopCharSet = ['_', '@'..'Z', 'a'..'z'];
  LabelCharSet = ['_', '@'..'Z', 'a'..'z', '0'..'9'];



implementation
uses Math;
const
  //  1byte [00..7F]
  //  2byte [C2..DF]110y-yyyx  10xx-xxxx
  //  3byte [E0..EF]1110-yyyy  10yx-xxxx  10xx-xxxx
  //  4byte [F0..F4]1111-0yyy  10yy-xxxx  10xx-xxxx  10xx-xxxx
  UTF8LeadBytes = [#$C2..#$DF, #$E0..#$EF, #$F0..#$F4];
  UTF8LeadBytes2 = [#$C2..#$DF];
  UTF8LeadBytes3 = [#$E0..#$EF];
  UTF8LeadBytes4 = [#$F0..#$F4];

  //ShiftJIS 81-9FならびにE0-FC  は OEM ShiftJisの最初文字  最大２バイト文字
  OEMLeadBytes = [#$81..#$9F, #$E0..#$FC];

  //A1-FE  は OEM EUCの最初文字   8Eは  半角カナ
  EUCLeadBytes = [#$8E, #$8F, #$A1..#$FE];
  EUCLeadBytes2 = [#$8E, #$A1..#$FE];
  EUCLeadBytes3 = [#$8F]; //先頭文字が8Fなら合計3byte

type
  TAChar = array[0..9999] of AnsiChar;

function ZenSkip(var p: PAnsiChar): boolean;
begin
  Result := p^ in MyLeadBytes;
  if Result then
    if p^ in MyLeadBytes2 then Inc(p, 2)
    else
      if p^ in MyLeadBytes3 then Inc(p, 3)
      else
        if p^ in MyLeadBytes4 then Inc(p, 4) else Inc(p);
end;


function CAnsiGetChar(var p: PAnsiChar): AnsiChar; //１文字読む
begin
  Result := p^;
  if p^ <> #0 then inc(p);
end;

function CAnsiCheck(var p: PAnsiChar; c: AnsiChar): boolean; //p[0]がcであれば p++しtrue  違うならfalse
begin
  Result := (p^ = c);
  if Result then inc(p);
end;

procedure CAnsiCheckChar(var p: PAnsiChar; c: AnsiChar);
begin
  if (p^ <> c) then EAbort.Create(c + ' not found');
  inc(p);
end;

function CAnsiGetByte(var p: PAnsiChar; size: Integer): AnsiString;
var
  i: Integer;
begin
  setlength(Result, size);
  for i := 1 to size do begin
    Result[i] := p^;
    inc(p);
  end;
end;

function CAnsiSkip(var p: pansichar; c: TSysCharSet): integer; //[#9, ' '] で空白ならスキップする
begin
  Result := 0;
  while p^ in c do
  begin
    Inc(p);
    Inc(Result);
  end;
end;

function CAnsiSkipBlank(var p: PAnsiChar; withLF: boolean): Integer; //空白ならスキップする
begin
  if withLF then
    Result := CAnsiSkip(p, cSpace)
  else
    Result := CAnsiSkip(p, [#9, ' ']);
end;

function CAnsiGetInteger10(var ptr: PAnsiChar; var retVal: int64): boolean;
var
  c: Integer;
  dt: Int64;
  p: PAnsiChar;
begin
  Result := false;
  p := ptr;
  CAnsiSkipBlank(p);
  c := 0;
  dt := 0;
  while p^ in ['0'..'9'] do
  begin
    dt := dt * 10 + ord(p^) - ord('0');
    inc(c);
    inc(p);
  end;
  if c > 0 then
  begin
    ptr := p;
    retVal := dt;
    result := True;
  end;
end;
/////////////////////////////////
//10進数 +123 - 123  123
//16進数  $100  0x2              pascal/cの１６進数を読める
// 2進数  0b0110    0b0110_1100  2進数を読める

function CAnsiGetInteger(var ptr: PAnsiChar; var retVal: int64): boolean;
var
  Minus: boolean;
  c: Integer;
  dt: Int64;
  p: PAnsiChar;
label
  hex, anser, setdata;
begin
  Result := false;
  p := ptr;
  CAnsiSkipBlank(p);
  minus := false;
  if p^ in ['+', '-'] then
  begin
    minus := p^ = '-';
    inc(p);
    CAnsiSkipBlank(p);
  end;
  dt := 0;
  if p^ = '$' then
  begin //Pascal式の16進ヘッダなら
    hex:
    inc(p);
    dt := 0;
    c := 0;
    while p^ in ['0'..'9', 'A'..'F', 'a'..'f'] do
    begin
      dt := dt * 16 + StrToInt('$' + p^);
      inc(p);
      inc(c);
    end;
    goto anser;
  end;

  if p^ = '0' then
  begin
    if p[1] in ['x', 'X'] then begin
      inc(p);
      goto hex; //16進数
    end;
    if p[1] in ['b'] then //2進数は
    begin
      inc(p);
      inc(p);
      dt := 0;
      c := 0;
      while p^ in ['0', '1', '_'] do //２進の時は 桁が判るように_を無視する
      begin
        if p^ in ['0', '1'] then
        begin
          dt := dt * 2 + ord(p^) - ord('0');
          inc(c);
        end;
        inc(p);
      end;
      anser:
      if c > 0 then goto setdata;
      exit;
    end;
  end;
  if CAnsiGetInteger10(p, dt) then
  begin
    setdata:
    ptr := p;
    retVal := dt;
    if minus then retVal := -retVal;
    result := True;
  end;
end;
//////////////////////
// 12AB のような１６進数

function CAnsiGetHex(var ptr: PAnsiChar; var retVal: int64): boolean;
type
  TAChar = array[0..9999] of AnsiChar;
var
  p: PAnsiChar;
  pA: ^TAChar absolute p;
  c: Integer;
  s: AnsiString;
begin
  setlength(s, 100);
  result := false;
  p := ptr;
  if not (p^ in ['0'..'9', 'A'..'F', 'a'..'f']) then exit;
  c := 1;
  s[c] := p^;
  inc(p);
  while p^ in ['0'..'9', 'A'..'F', 'a'..'f'] do begin
    inc(c);
    if c > 16 then exit;
    s[c] := p^;
    inc(p);
  end;
  setlength(s, c);
  retVal := StrToInt('$' + s);
  result := True;
  ptr := p;
end;

//////////////////////
// 0123h のような１６進数

function CAnsiGetAsmHex(var ptr: PAnsiChar; var retVal: int64): boolean;
type
  TAChar = array[0..9999] of AnsiChar;
var
  p: PAnsiChar;
  pA: ^TAChar absolute p;
  c: Integer;
  s: AnsiString;
begin
  setlength(s, 100);
  result := false;
  p := ptr;
  if not (p^ in ['0'..'9']) then exit;
  c := 1;
  s[c] := p^;
  inc(p);
  while p^ in ['0'..'9', 'A'..'F', 'a'..'f'] do begin
    inc(c);
    if c > 16 then exit;
    s[c] := p^;
    inc(p);
  end;
  if not (p^ in ['h', 'H']) then exit;
  setlength(s, c);
  retVal := StrToInt('$' + s);
  result := True;
  inc(p);
  ptr := p;
end;

//////////////////////
// 0101b のような2進数

function AnsiDec2Bin(dec: int64; len: Integer): AnsiString;
var
  i: Integer;
  bit: Int64;
begin
  SetLength(Result, len);
  bit := 1;
  for i := 0 to len - 1 do begin
    if (dec and bit) = 0 then Result[len - i] := '0'
    else Result[len - i] := '1';
    bit := bit shl 1;
  end;
  Result := Result + 'B';

end;

function CAnsiGetAsmBin(var ptr: PAnsiChar; var retVal: int64): boolean;
type
  TAChar = array[0..9999] of AnsiChar;
var
  p: PAnsiChar;
  pA: ^TAChar absolute p;
  c: Integer;
  dt: Int64;
begin
  result := false;
  p := ptr;
  if not (p^ in ['0', '1']) then exit;
  c := 1;
  if p^ = '1' then dt := 1 else dt := 0;
  inc(p);
  while p^ in ['0', '1', '_'] do begin
    if p^ <> '_' then begin
      inc(c);
      if c > 64 then exit;
      dt := dt + dt;
      if p^ = '1' then dt := dt or 1;
    end;
    inc(p);
  end;
  if not (p^ in ['b', 'B']) then exit;
  if (p[1] in ['0'..'9', '_', 'A'..'Z', 'a'..'z']) then exit;
  retVal := dt;
  result := True;
  inc(p);
  ptr := p;
end;

function CAnsiGetDotNum(var ptr: PAnsiChar; var retVal: Extended): boolean;
var
  s: AnsiString;
  DotCnt: Integer;
  EnumCnt: Integer;
  numCnt: Integer;
  iret: int64;
  Minus: boolean;
  p: PAnsiChar;
  pA: ^TAChar absolute p;
begin
  Result := false;
  p := ptr;
  CAnsiSkipBlank(p);
  if p^ = #0 then exit;
  numCnt := 0;
  DotCnt := 0;
  EnumCnt := 0;
  Minus := false;

  if p^ in ['+', '-'] then
  begin
    minus := p^ = '-';
    inc(p);
    CAnsiSkipBlank(p);
  end;
  if (p^ = '$')
    or ((pA[0] = '0') and (pA[1] in ['b', 'B', 'x', 'X'])) then
  begin //Pascal式の16進ヘッダなら
    if CAnsiGetInteger(p, iret) then
    begin
      ptr := p;
      retVal := iret;
      Result := True;
      if minus then retVal := -retVal;
      exit;
    end;
  end;
  while true do
    case p^ of
      '0'..'9':
        begin
          s := s + p^; inc(p);
          inc(numCnt);
        end;
      '.':
        begin
          inc(DotCnt);
          if DotCnt >= 2 then break;
          s := s + p^; inc(p);
        end;
      'E', 'e':
        begin
          if numCnt = 0 then break;
          inc(EnumCnt);
          if EnumCnt >= 2 then break;
          s := s + p^; inc(p);
        end;
      '-':
        begin
          if EnumCnt <> 1 then break;
          s := s + p^; inc(p);
        end;

    else break;
    end;
  if s <> '' then
  begin
    ptr := p;
    retVal := StrToFloat(s);
    Result := True;
    if minus then retVal := -retVal;
  end;
end;

function CAnsiGetDotNumExt(var ptr: PAnsiChar; var retVal: Extended): boolean; // K M m u % PI対応
type
  TAChar2 = array[0..1] of AnsiChar;
  pA2 = ^TAChar2;

begin
  Result := CAnsiGetDotNum(ptr, retVal);
  if Result then
  begin
    if pA2(ptr)^ = 'μ' then begin
      retVal := retVal / 1000000; inc(ptr, 2);
      exit;
    end;
    if pA2(ptr)^ = 'π' then begin
      retVal := retVal * PI; inc(ptr, 2);
      exit;
    end;
    if pA2(ptr)^ = 'PI' then begin
      retVal := retVal * PI; inc(ptr, 2);
      exit;
    end;

    case ptr[0] of
      'k': begin retVal := retVal * 1000; inc(ptr); end;
      'M': begin retVal := retVal * 1000000; inc(ptr); end;
      'T': begin retVal := retVal * 1000000000; inc(ptr); end;
      'P': begin retVal := retVal * 1000000000000; inc(ptr); end;
      'm': begin retVal := retVal / 1000; inc(ptr); end;
      'u': begin retVal := retVal / 1000000; inc(ptr); end;
      'p': begin retVal := retVal / 1000000000; inc(ptr); end;
      'f': begin retVal := retVal / 1000000000000; inc(ptr); end;


      '%': begin retVal := retVal / 100; inc(ptr); end;
    end;
  end;
end;

function NumToStr(d: Extended; out ext: string): string;
var
  c: string;
  v, w: Extended;
  i, n, m: Integer;
begin
  w := d;
  if d < 0 then d := -d;
 {(*}
 while true do begin
     c :='P'; v:= d/ 1000000000000; if v>1 then break;
     c :='T'; v:= d/ 1000000000; if v>1 then break;
     c :='M'; v:= d/ 1000000; if v>1 then break;
     c :='k'; v:= d/ 1000; if v>100 then break;
     c :='' ; v:= d      ; if v>0.01 then break;
     if v=0 then break;
     c :='m'; v:= d* 1000; if v>1    then break;
     c :='u'; v:= d* 1000000; if v>1 then break;
     c :='p'; v:= d* 1000000000; if v>1 then break;
     c :='f'; v:= d* 1000000000000; break;
 end;
  {*)}
  if w < 0 then begin v := -v; d := -d; end;
  m := 1;
  n := 0;
  for i := 0 to 9 do begin
    n := i;
    if (Round(v * m) - v * m) = 0 then break;
    m := m * 10;
  end;
  Result := format('%3.*f', [n, v]) + c;
  ext := c;

end;

function comp(q: pansichar; sep: ansistring): boolean;
var
  i: integer;
begin
  Result := True;
  for i := 1 to length(sep) do if q[i - 1] <> sep[i] then
    begin
      Result := False;
      exit;
    end;
end;

////////////////////////////////////////////////////////////
// 文字セットのどれか迄の文字列を返し、ポインタはその位置

function CAnsiGetNextStr(var p: PAnsiChar; c: TSysCharSet): AnsiString;
var
  len: Integer;
  pstart: PAnsiChar;
begin
  pstart := p;
  while p^ <> #0 do begin
    if not ZenSkip(p) then //全角文字は無条件に外す
    begin
      if p^ in c then break;
      inc(p);
    end;
  end;
  len := p - pstart;
  SetLength(Result, len);
  move(pstart^, Result[1], len);
  exit;
end;

function CAnsiGetSplitStr(var p: PAnsiChar; sep: ansistring): ansistring;
var
  len: integer;
  pstart: pAnsichar;

begin
  if length(sep) = 0 then raise EAbort.Create(' not find separator ');
  pstart := p;
  while p^ <> #0 do
  begin
    if comp(p, sep) then
    begin
      len := p - pstart;
      SetLength(Result, len);
      move(pstart^, Result[1], len);
      Inc(p, length(sep));
      exit;
    end;

    if not ZenSkip(p) then //全角文字なら
      Inc(p);
  end;
  p := pstart;
  SetLength(Result, 0);
end;

function CAnsiGetSplitStrs(var p: PAnsiChar; sep: array of AnsiString; pno: PINT): AnsiString; //sepまでの文字列を返し、ポインタはsepを示す
var
  i, len: integer;
  pstart: pAnsichar;
begin
  if length(sep) = 0 then raise EAbort.Create(' not find separator ');
  pstart := p;
  while p^ <> #0 do
  begin
    for i := 0 to High(sep) do
    begin
      if comp(p, sep[i]) then raise EAbort.Create(' not find separator ');
      begin
        if sep[i] = '' then continue;
        len := p - pstart;
        SetLength(Result, len);
        move(pstart^, Result[1], len);
        Inc(p, length(sep[i]));
        if pno <> nil then pno^ := i;
        exit;
      end;
    end;
    if not ZenSkip(p) then //全角文字なら
      Inc(p);
  end;
  p := pstart;
  SetLength(Result, 0);
end;


function CAnsiCmpStrs(p: PAnsiChar; str: array of ansistring; pno: PINT): boolean; //pからstr迄が等しいならTrueでpnoは一致したstrの番号
var
  i: Integer;
begin
  for i := 0 to High(str) do
  begin
    if comp(p, str[i]) then begin
      Inc(p, length(str[i]));
      if pno <> nil then pno^ := i;
      Result := True;
      exit;
    end;
  end;
  Result := False;
end;

function CAnsiFindStrs(var p: PAnsiChar; sep: array of ansistring; pno: PINT): boolean; //sepがあればTrue ポインタはsep文字列位置
var
  i: Integer;
  pstart: pansichar;
begin
  if length(sep) = 0 then raise EAbort.Create(' not find separator ');
  Result := True;
  pstart := p;
  while p^ <> #0 do
  begin
    for i := 0 to High(sep) do
    begin
      if sep[i] = '' then continue;
      if comp(p, sep[i]) then begin
        Inc(p, length(sep[i]));
        if pno <> nil then pno^ := i;
        exit;
      end;
    end;
    if not ZenSkip(p) then //全角文字はその文字分　
      Inc(p);
  end;
  for i := 0 to High(sep) do
  begin
    if sep[i] = '' then exit;
  end;
  p := pstart;
  Result := False;
end;

function CAnsiGetAccordChars(var p: PAnsiChar; c: TSysCharSet): AnsiString; //文字セットが連続してる
var
  len: Integer;
  pstart: PAnsiChar;
begin
  pstart := p;
  while p^ <> #0 do
    if p^ in c then inc(p) else break;
  len := p - pstart;
  SetLength(Result, len);
  move(pstart^, Result[1], len);
end;

function OldCAnsiGetNextStr(var p: PAnsiChar; c: TSysCharSet): AnsiString;
var
  len: Integer;
begin
  len := 0;
  SetLength(Result, 1000);
  try
    while p^ <> #0 do begin
      if (p^ in MyLeadBytes) then begin //全角文字は無条件に外す
        if Length(Result) < len - 1 then SetLength(Result, len * 2);
        inc(len); Result[len] := p^; inc(p);
        inc(len); Result[len] := p^;
      end else
        if (not (p^ in c)) then begin
          if Length(Result) < len then SetLength(Result, len * 2);
          inc(len); Result[len] := p^;
        end else exit;
      inc(p);
    end;
  finally SetLength(Result, len); end;
end;


function CAnsiGetPrtChar(var p: PAnsiChar; c: AnsiChar): AnsiString;
var
  len: Integer;
begin
  len := 0;
  SetLength(Result, 1000);
  try
    while p^ <> #0 do begin
      if (p^ in MyLeadBytes) then begin //全角文字は無条件に外す
        if Length(Result) < len - 1 then SetLength(Result, len * 2);
        inc(len); Result[len] := p^; inc(p);
        inc(len); Result[len] := p^;
      end else
        if (p^ <> c) or (p[1] = c) then begin
          if Length(Result) < len then SetLength(Result, len * 2);
          inc(len); Result[len] := p^;
        end else exit;
      inc(p);
    end;
  finally SetLength(Result, len); end;
end;

///////////////////////////////////////////////////////
//全角文字または半角の文字セットが連続してる

function CAnsiGetAccordZenChars(var p: PAnsiChar; c: TSysCharSet): AnsiString;
var
  len: Integer;
  procedure setChar;
  begin
    if Length(Result) < len then SetLength(Result, len * 2);
    inc(len);
    Result[len] := p^;
  end;
begin
  len := 0;
  SetLength(Result, 1000);
  try
    while p^ <> #0 do
    begin
      if p^ in MyLeadBytes then
      begin //全角文字なら２バイト読む
        setChar; // if p^=#0 then Abort('全角なのに次バイトがない');
        inc(p);
        setChar;
      end
      else if p^ in c then setChar else exit;
      inc(p);
    end;
  finally SetLength(Result, len); end;
end;

//カンマ区切りの文字を取り出す

function CAnsiGetCSVfield(var p: PAnsiChar): AnsiString;
  function nextChar: AnsiChar; begin inc(p); result := p^; end;
  procedure CRLF;
  begin //CRの後のLFチェック
    if NextChar = #10 then inc(p);
  end;
label
  MOJI1, MOJI2;
begin
  Result := '';
  if p^ = #0 then exit;
  if p^ = '"' then
  begin
    MOJI1:
    inc(p); //'"'を捨てる
    Result := Result + CAnsiGetNextStr(p, ['"', #13, #10]); //〜"か改行迄
    if p^ = #13 then CRLF //0d0a 読み飛ばし
    else if p^ = '"' then
    begin
      case NextChar of
        ',', #10:
          begin
            inc(p); exit; end;
        #13:
          begin
            CRLF; exit; end;
        '"':
          begin
            Result := Result + p^; goto MOJI1; end;
        #0: exit;
      else
        begin
          Result := Result + p^; goto MOJI2; end;
      end;
    end;
  end else
  begin
    MOJI2:
    Result := Result + CAnsiGetNextStr(p, [',', #13, #10]); //〜"か改行迄
    if p^ = #13 then CRLF //0d0a 読み飛ばし
    else if p^ <> #0 then inc(p);
  end;
end;



type
  TCalculateFloatFunc = class
    class function GetLab(const lab: AnsiString; var ret: Extended; cmd: TGetLabelCmd): boolean;
  end;

class function TCalculateFloatFunc.GetLab(const lab: AnsiString;
  var ret: Extended; cmd: TGetLabelCmd): boolean;
begin
  Result := True;
  case cmd of
    glGetData: begin
      //  if AnsiSameText(lab, 'fs') then begin
      //    ret := SampleRate;
      //    exit;
      //  end else
        if AnsiSameText(lab, 'PI') then begin
          ret := PI;
          exit;
        end;
      end;
    glCall: begin
        if lab = 'sin(' then begin ret := sin(ret); exit; end;
        if lab = 'cos(' then begin ret := cos(ret); exit; end;
        if lab = 'tan(' then begin ret := tan(ret); exit; end;
        if lab = 'log(' then begin ret := log10(ret); exit; end;
        if lab = 'ln(' then begin ret := ln(ret); exit; end;

      end;
//  else Result := false;
  end;
  Result := False;
end;

function CAnsiCalculateFloat(var p: PAnsiChar; proc: TGetLabelProc; opt: TCAnsiCalcOpt): Extended;
type
  TAChar3 = array[0..2] of AnsiChar;
  TAChar2 = array[0..1] of AnsiChar;
var
  pA3: ^TAChar3 absolute p;
  pA2: ^TAChar2 absolute p;
  num: Extended;
  procedure next;
  begin
    inc(p); end;
  procedure addsub; forward;
  procedure factor;
  var
    lab: AnsiString;
    i64: Int64;
  begin
    CAnsiSkipBlank(p);
    if (p^ = '(') then
    begin
      next;
      addsub;
      CAnsiSkipBlank(p);
      if (p^ <> ')') then raise EAbort.Create('):' + p^ + ' is NG');
      next;
    end else
    begin
        {// 16進数だけ特殊ラベルとした時の
      if (p[0] = '$')
        and (not (p[1] in ['0'..'9', 'a'..'f', 'A'..'F'])) then begin
        if Assigned(proc) then begin
          inc(p);
          lab := '$' + CAnsiGetAccordZenChars(p, LabelCharSet);
          CAnsiSkipBlank(p);
          if not proc(lab, num, glGetData) then raise EAbort.Create(lab + ' undefined');
        end else Exception.Create(p + ' is not numeric ');
        CAnsiSkipBlank(p);
        exit;
      end;
        }
      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 Assigned(proc) and (p^ in LabelTopCharSet + MyLeadBytes)
          then
        begin
          lab := CAnsiGetAccordZenChars(p, LabelCharSet);
          CAnsiSkipBlank(p);
          if (p^ = '(') then
          begin
            next;
            addsub;
            CAnsiSkipBlank(p);
            if (p^ <> ')') then raise EAbort.Create('need ")" but  "' + p^ + '" defined');
            next;
            if not proc(lab + '(', num, glCall) then raise EAbort.Create(lab + ' is not function ');
          end else
          begin
            if not proc(lab, num, glGetData) then raise EAbort.Create(lab + ' undefined labels');
          end;
        end else Exception.Create(p + ' is not numeric ')
    end;
    CAnsiSkipBlank(p);
  end;
  procedure 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^ = 'SHL')
      or (pA3^ = '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^ = 'SHR')
        or (pA3^ = '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 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 muldiv;
  var
    savenum: Extended;
  var
    oldsym: AnsiChar;
  begin
    comp;
    while (p^ in ['*', '/', '^']) do
    begin
      savenum := num; oldsym := p^; next;
      comp;
      case oldsym of
        '^': num := power(savenum, num);
        '*': num := savenum * num;
        '/': num := savenum / num;
      end;
    end;
  end;

  procedure addsub;
  var
    savenum: Extended;
    oldsym: AnsiChar;
    lab: AnsiString;
  begin
    CAnsiSkipBlank(p);
    {--------- ここから--------}

    if (p^ in ['+', '-']) then
    begin //+か-が前置されたら
      if p[0] = p[1] then begin //++ --演算子
        oldsym := p^;
        CAnsiSkipBlank(p);
        if Assigned(proc) and (p^ in {['$'] +} LabelTopCharSet + MyLeadBytes) then
        begin
          lab := CAnsiGetAccordZenChars(p, LabelCharSet);
          case oldsym of
            '+': num := 1;
            '-': num := -1;
          end;
          if not proc(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^ = 'AND')
      or (pA3^ = '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^ = 'OR')
        or (pA2^ = '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^ = 'XOR')
          or (pA3^ = '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;
var
  lab: string;
  oldp: PAnsiChar;
begin
  if Assigned(proc) and (not (csSetData_NG in opt)) then
    while True do
    begin
      CAnsiSkipBlank(p);
      oldp := p; //ラベルの後に=が無い場合に備えて保存
      if p^ in LabelTopCharSet + MyLeadBytes then
      begin
        lab := CAnsiGetAccordZenChars(p, LabelCharSet);
        CAnsiSkipBlank(p);
        if ((p[0] = '=') and (p[1] <> '='))
          or ((p[0] = ':') and (p[1] = '=')) then
        begin {比較演算子でないなら}
          if p[0] = ':' then Next;
          Next;

          addsub;
          CAnsiSkipBlank(p);
          if not proc(lab, num, glSetData) then raise EAbort.Create(lab + ' undefined labels');
          if not (p^ in [',', ';', ':']) then
          begin //最後の代入値が帰り値になる
            Result := num;
            exit;
          end;
          Next; //連続代入処理
        end
        else
        begin {name= でないなら }
          p := oldp;
          break;
        end;
      end;
    end;
  addsub;
  Result := num;
end;


function AnsiCalculateFloat(cmd: AnsiString; out remnant: AnsiString): Extended;
var
  p: PAnsiChar;
begin
  p := PAnsiChar(cmd);
  Result := CAnsiCalculateFloat(p);
  if @remnant <> nil then remnant := p;
end;

function AnsiCalculateFloat(cmd: AnsiString): Extended; overload;
var
  p: PAnsiChar;
begin
  p := PAnsiChar(cmd);
  Result := CAnsiCalculateFloat(p);
end;

procedure CmtSkipPascal(var p: PChar; c: TSysCharSet); //Pascalスタイル
begin
  repeat
    CAnsiSkip(p, c);
    case p^ of
      '/': if p[1] = '/' then begin CAnsiGetNextStr(p, [#0, #13, #10]); continue; end;
      '{': begin CAnsiGetSplitStr(p, '}'); continue; end;
      '(': if p[1] = '*' then begin CAnsiGetSplitStr(p, '*)'); continue; end;
    else break;
    end;
    break;
  until false;
end;

procedure CmtSkipC(var p: PChar; c: TSysCharSet); //C言語JacaScriptスタイル
begin
  repeat
    CAnsiSkip(p, c);
    if p[0] = '/' then
      if p[1] = '/' then begin CAnsiGetNextStr(p, [#0, #13, #10]); continue; end
      else
        if p[1] = '*' then begin CAnsiGetSplitStr(p, '*/'); continue; end;
    break;
  until false;
end;
end.