program ClipBdCalc;
//{$mode objfpc}{$H+}
{
クリップボードに計算したい文字列をcopyして　実行すれば
結果がクリップボードに帰ります
プログラムを作る時に、この関数の結果はどうなるのと確認する為に作ったものです
何もクリップボードにないか、引数が何かあればコンソールモードになります。
計算は浮動小数点だけで整数や文字列は扱えません
 label=式 か label:=式で  変数を定義出来ます
 式には四則演算やAND OR 等のビット演算が記述可能 ^はべき乗です
sin ,cos ,tan ,log ,ln ,exp ,ArcCos ,ArcSin,ArcTan2 ,Power
FRAC ,ROUND ,TRUNC  ,coTan ,Sinh ,Cosh ,Tanh ,ArcCosh ,ArcSinh ,ArcTanh
LnXP1 ,Log10 ,Log2 ,ArcTanh ,Hypot ,LogN    が組み込まれtいます
}
uses
  Windows,
  SysUtils,
  uAnsiCharTools in 'uAnsiCharTools.pas',
  CalcAnsiScript in 'CalcAnsiScript.pas',
  uSysCol in 'uSysCol.pas',
  Pas2Javasc in 'Pas2Javasc.pas',
  uScrExt in 'uScrExt.pas';

procedure toClip(const s: ansistring);
var
  size: integer;
  dh: THandle;
  dt: pansichar;
begin
  size := Length(s) + 1;
  OpenClipBoard(0);
  EmptyClipboard;
  try
    dh := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, size);
    try
      dt := GlobalLock(dh);
      try
        Move(pansichar(s)^, dt^, size);
        SetClipboardData(CF_TEXT, dh);
      finally
        GlobalUnlock(dh);
      end;
    except
      GlobalFree(dh); //エラー時のみ
    end;
  finally CloseClipboard; end;
end;

procedure clrClip;
begin
  OpenClipBoard(0);
  EmptyClipboard;
  CloseClipboard;
end;

function fromClip: ansistring;
var
  dh: THandle;
  dt: pansichar;
  s: ansistring;
begin
  OpenClipboard(0);
  try
    dH := GetClipboardData(CF_TEXT);
    Result := '';
    if dH = 0 then exit;
    try
      dt := GlobalLock(dH);
      s := dt; //PAnsiChar->string 型変換
        //文字列型はそのまま代入するとポインタだけの複製なので Lock〜Unlockの間にcopyする
      setlength(Result, length(s));
      move(s[1], Result[1], Length(s));
    finally
      GlobalUnlock(dh);
    end;
  finally CloseClipboard; end;
end;

function ConsReadLine(): AnsiString;
var
  rdSize: DWORD;
begin
  SetLength(Result, $4000);
//StdHandleは何度でも Getしてよい
  ReadConsoleA(GetStdHandle(STD_INPUT_HANDLE), @Result[1], length(Result) - 1, rdSize, nil);
  setlength(Result, rdSize);
end;


procedure ConsWtLine(s: string);
var
  rdSize: DWORD;
begin
  //せっかくUTF8にしても s+#13#10 と文字列の加算するだけでUTF8に戻る
  WriteConsole(GetStdHandle(STD_OUTPUT_HANDLE), @s[1], length(s), rdSize, nil);
  s := #13#10;
  WriteConsole(GetStdHandle(STD_OUTPUT_HANDLE), @s[1], length(s), rdSize, nil);
 //rdSizeは見てない。まあ出力出来なかったらどうしろというのか判らないし
end;


procedure ConsWtCvtLn(s: AnsiString);
begin
  ConsWtLine(cvU(s));
end;

// コンソールモード用のスクリプト
type
  TMyConsCalculate = class(TAnsiCalculate)
  public
    procedure ExecInit; override;
    procedure PutLine(add: string); override;
    procedure MsgOutLn(msg: string); override;
  end;

procedure TMyConsCalculate.ExecInit;
begin
  p := PAnsiChar(MyCmd);
//  SetLength(Labels, 0); ラベルを消さないようにするだけ
  OutMsg := '';
  eMsg := '';
end;

procedure TMyConsCalculate.MsgOutLn(msg: string);
begin
  ConsWtLine(msg);
end;

procedure TMyConsCalculate.PutLine(add: string);
begin
  if add <> '' then ConsWtLine(add);
end;

var
  i, filc: Integer;
  p: PChar;
  s, clp: string;
label
  cons;

begin
  if ParamCount < 1 then //クリップボードモード
  begin
    clp := fromClip();
    p := PChar(clp);
    CAnsiSkip(p, [#9, ' ', #13, #10]); //先頭の空白と改行文字だけなら
    if p^ = #0 then begin
      allocConsole; //何もなければコンソールモード
      ConsWtCvtLn('クリップボードに計算したい文字列をcopyして　実行すれば');
      ConsWtCvtLn('結果がクリップボードに帰ります');
      ConsWtCvtLn('何もクリップボードにないか、引数が存在するファイル名でなければコンソールモードになります。');
      ConsWtCvtLn('計算は浮動小数点だけで整数や文字列は扱えません');
      ConsWtCvtLn(' label=式 か label:=式で  変数を定義出来ます');
      ConsWtCvtLn(' 式には四則演算やAND OR 等のビット演算が記述可能 ^はべき乗です');
      ConsWtCvtLn('sin ,cos ,tan ,log ,ln ,exp ,ArcCos ,ArcSin,ArcTan2 ,Power');
      ConsWtCvtLn('FRAC ,ROUND ,TRUNC  ,coTan ,Sinh ,Cosh ,Tanh ,ArcCosh ,ArcSinh ,ArcTanh');
      ConsWtCvtLn('LnXP1 ,Log10 ,Log2 ,ArcTanh ,Hypot ,LogN    が組み込まれtいます');
      ConsWtCvtLn('# のみの行で 説明追加');
      ConsWtCvtLn('exitで帰りますが窓を閉じるのが早いでしょう');
      goto cons;
    end;
    with TAnsiCalculate.Create(clp) do try
      ExecCmd();
      toClip(OutMsg);
    finally
      free;
    end;
    exit;
  end;

/////////////ファイルモード/////////////////////
  clp := ''; filc := 0;
  for i := 1 to ParamCount do
    if FileExists(ParamStr(i)) then begin
      s := readFileStr(cvU(ParamStr(i)));
      with TAnsiCalculate.Create(s) do try
        if FileExec(ParamStr(i)) then inc(filc) else ExecCmd();
        clp := clp + OutMsg;
      finally
        free;
      end;
    end;
  if clp <> '' then begin
    toClip(clp);
    exit;
  end;
  if filc > 0 then exit;
  allocConsole;
  cons:
/////////////コンソールモード/////////////////////
  with TMyConsCalculate.Create('') do try
    while true do begin
      MyCmd := ConsReadLine(); //readln はFPCでコンソールモードでないとエラーになるので
      if sameText(copy(MyCmd, 1, 4), 'exit') then exit;
      ExecCmd();
      toClip(OutMsg);
    end;
  finally
    free;
  end;
end.