unit baslibc;
{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}
{$INLINE ON}
(***************************************)
(* Copyright (C) 2014, SHIRAISHI Kazuo *)
(***************************************)

interface
uses
  Classes, SysUtils,
  base,textfile,baslib,mathc;


function FloatVal( const s:ansistring):complex;overload;
{*****************}
{Numeric functions}
{*****************}
 function CSQRT( x:complex):complex;

 function SIN(x:double):double;inline;   overload;
 function COS(x:double):double;inline;   overload;
 function SINDEG(x:double):double;inline;   overload;
 function COSDEG(x:double):double;inline;   overload;

 function SIN( x:Complex):double;inline;   overload;
 function COS( x:Complex):double;inline;   overload;
 function SINDEG( x:Complex):double;inline;   overload;
 function COSDEG( x:Complex):double;inline;   overload;

 function deg(x:double):double;     overload;
 function rad(x:double):double;     overload;
 function deg(x:complex):double;    overload;
 function rad(x:complex):double;    overload;


 function SGN( x:Complex):double;inline;   overload;
 function ATN( x:Complex):double;inline;   overload;
 function ATNDEG( x:Complex):double;inline;overload;
 function EPS(x:Complex):double;inline;             overload;
 function BINT( x:Complex):double;inline;           overload;
 function BCEIL(x:Complex):double;inline;           overload;
 function ROUND( x:Complex):double; inline;         overload;
 function ROUND( x,y:Complex):double;               overload;
 function ROUND( x:double; y:Complex):double;               overload;
 function ROUND( x:Complex; y:double):double;               overload;
 function BMOD( x,y:Complex):double;inline;         overload;
 function BMOD( x:double; y:Complex):double;inline;         overload;
 function BMOD( x:Complex; y:double):double;inline;         overload;
 function TRUNCATE(  x,y:Complex):double;inline;    overload;
 function TRUNCATE(  x:double; y:Complex):double;inline;    overload;
 function TRUNCATE( x:Complex; y:double):double;inline;    overload;
 function BMIN( x,y:Complex):double;inline;    overload;
 function BMIN(x:double;  y:Complex):double;inline;    overload;
 function BMIN( x:Complex; y:double):double;inline;    overload;
 function BMAX( x,y:Complex):double;inline;    overload;
 function BMAX(x:double;  y:Complex):double;inline;    overload;
 function BMAX( x:Complex; y:double):double;inline;    overload;

 function FRAC(x:complex):double; inline; overload;
 function INT(x:complex):double;  inline; overload;

 function PERM( n,r:Complex):double;                overload;
 function PERM( n:double; r:Complex):double;                overload;
 function PERM( n:Complex; r:double):double;                overload;
 function COMB( n,r:Complex):double;                overload;
 function COMB( n:double; r:Complex):double;                overload;
 function COMB( n:Complex; r:double):double;                overload;
 function FACT( x:Complex):double;             overload;


{****************}
{STRING Functions}
{****************}
 function SubString(s:string; i1,i2:Complex):string;         overload;
 function SubString(s:string; i1:double; i2:Complex):string;         overload;
 function SubString(s:string; i1:complex; i2:double):string;         overload;
 function SubStringByte(s:string; i1,i2:Complex):string;     overload;
 function SubStringByte(s:string; i1:double; i2:Complex):string;     overload;
 function SubStringByte(s:string; i1:complex; i2:double):string;     overload;
 function STR_s(x:Complex):string;                           overload;
 function CHR_s(x:Complex):string;                           overload;
 function CHRbyte(x:Complex):string;                         overload;
 function USING_s(const s:string; x:Complex):string;         overload;
 function USING_ss(const s:string; x:Complex):string;        overload;
 function REPEAT_s(const s:string; x:Complex):string;        overload;
 function BSTR_s(x:Complex; n:integer):string;               overload;

 function Mid_s(s:string; i1,i2:Complex):string;             overload;
 function Mid_s(s:string; i1:double; i2:Complex):string;             overload;
 function Mid_s(s:string; i1:complex; i2:double):string;             overload;
 function Mid_sByte(s:string; i1,i2:Complex):string;         overload;
 function Mid_sByte(s:string; i1:double; i2:Complex):string;         overload;
 function Mid_sByte(s:string; i1:complex; i2:double):string;         overload;
 function Left_sByte(s:string; i:Complex):string;            overload;
 function Left_s(s:string;i:Complex):string;                 overload;
 function Right_sByte(s:string; i:Complex):string;           overload;
 function Right_s(s:string;i:Complex):string;                overload;



{String Variable}
procedure SubstSubstringByte(var v:AnsiString; i,j:Complex; const s:ansistring); overload;
procedure SubstSubstringByte(var v:AnsiString; i:double; j:Complex; const s:ansistring); overload;
procedure SubstSubstringByte(var v:AnsiString; i:Complex; j:double; const s:ansistring); overload;
procedure SubstSubstring(var v:AnsiString; i,j:Complex; const s:ansistring);     overload;
procedure SubstSubstring(var v:AnsiString; i:double; j:Complex; const s:ansistring);     overload;
procedure SubstSubstring(var v:AnsiString; i:Complex; j:double; const s:ansistring);     overload;

{Let Statements}
procedure LETC(const p:Array of PComplex; x:Complex);

{ Ask Statement}
procedure AskFile(ch:TTextDEvice;
                  expAccess,expDatum,expErasable,expFileType,expName,
                  expOrganization,expPointer,expRecsize1,expRecType,
                  expSetter,expCharin,expTypeahead,expEchoControl,expEcho:TStrVar;
                  expMargin,expRecSize2,expZonewidth,expCharacterPending,expFilesize:PComplex);


{Misc.}
procedure Wait(n:Complex);         overload;
procedure swap(var x,y:Complex);overload;

{TComplex}
type
   TComplex = class
      value:Complex;
     constructor create(x:complex);overload;
     //constructor create(x:double);overload;
     function str:ansistring;
   end;



implementation
uses math2sub;

 {$MAXFPUREGISTERS Default}
{*****************}
{Numeric functions}
{*****************}
function CSQRT( x:complex):complex;
begin
  if x.x>=0.0 then
    if x.y=0.0 then
       begin
        result.y:=0;
        result.x:=sqrt(x.x)
       end
    else
    begin
       result.x:=sqrt((sqrt(sqr(x.x)+sqr(x.y))+x.x)/2.0);
       result.y:=x.y/(2.0*result.x);
    end
  else
  begin
       result.y:=sqrt((sqrt(sqr(x.x)+sqr(x.y))-x.x)/2.0);
       if x.y<0 then result.y:=-result.y;
       result.x:=x.y/(2.0*result.y);
  end;
end;

  function SIN(x:double):double;inline;   overload;
 begin
    result:=system.sin(x)
 end;

 function COS(x:double):double;inline;   overload;
 begin
    result:=system.cos(x)
 end;

 function SINDEG(x:double):double;inline;   overload;
 begin
   result:=math2sub.SINDeg(x)
 end;

 function COSDEG(x:double):double;inline;   overload;
 begin
   result:=math2sub.COSDeg(x)
 end;

 function SIN( x:Complex):double;inline;   overload;
 begin
     result:=system.SIN(testreal(x))
 end;

 function COS( x:Complex):double;inline;   overload;
 begin
     result:=system.COS(testreal(x))
 end;

 function SINDEG( x:Complex):double;inline;   overload;
 begin
     result:=math2sub.SINDeg(testreal(x))
 end;

 function COSDEG( x:Complex):double;inline;   overload;
 begin
     result:=math2sub.COSDeg(testreal(x))
 end;

 function deg(x:double):double;
 begin
   result:=math2sub.deg(x);
 end;

 function rad(x:double):double;
 begin
   result:=math2sub.rad(x);
 end;

 function deg(x:complex):double;
 begin
   result:=math2sub.deg(testreal(x))
 end;

 function rad(x:complex):double;
 begin
   result:=math2sub.rad(testreal(x))
 end;



 function SGN( x:Complex):double;inline;   overload;
 begin
     result:=baslib.SGN(testreal(x))
 end;


 function ATN( x:Complex):double;inline;   overload;
 begin
     result:=baslib.ATN(testreal(x))
 end;


 function ATNDEG( x:Complex):double;inline;overload;
 begin
     result:=baslib.ATNDEG(testreal(x))
 end;


constructor TComplex.create(x:complex);
begin
  inherited create;
  value:=x;
end;

function TComplex.str:ansistring;
begin
  str:=CStr(value) + ' '
end;



 function EPS(x:Complex):double;inline;             overload;
 begin
     result:=baslib.EPS(testreal(x))
 end;

 function BINT( x:Complex):double;inline;           overload;
 begin
     result:=baslib.BINT(testreal(x))
 end;

 function BCEIL(x:Complex):double;inline;           overload;
 begin
     result:=baslib.BCEIL(testreal(x))
 end;

 function BMOD( x,y:Complex):double;inline;         overload;
 begin
    result:=baslib.BMOD(testreal(x), testreal(y))
 end;
 function BMOD( x:double; y:Complex):double;inline;         overload;
 begin
    result:=baslib.BMOD(testreal(x), testreal(y))
 end;
 function BMOD( x:Complex; y:double):double;inline;         overload;
 begin
    result:=baslib.BMOD(testreal(x), testreal(y))
 end;

 function ROUND( x:Complex):double;overload; inline;overload;
 begin
    result:=baslib.ROUND(testreal(x))
 end;

 function ROUND( x,y:Complex):double; overload;     overload;
 begin
    result:=baslib.ROUND(testreal(x), testreal(y))
 end;
 function ROUND( x:double; y:Complex):double;               overload;
 begin
    result:=baslib.ROUND(testreal(x), testreal(y))
 end;
 function ROUND( x:Complex; y:double):double;               overload;
 begin
    result:=baslib.ROUND(testreal(x), testreal(y))
 end;

 function TRUNCATE(  x,y:Complex):double;inline;    overload;
 begin
    result:=baslib.TRUNCATE(testreal(x), testreal(y))
 end;
 function TRUNCATE(  x:double; y:Complex):double;inline;    overload;
 begin
    result:=baslib.TRUNCATE(testreal(x), testreal(y))
 end;
 function TRUNCATE( x:Complex; y:double):double;inline;    overload;
 begin
    result:=baslib.TRUNCATE(testreal(x), testreal(y))
 end;

 function BMIN( x,y:Complex):double;inline;    overload;
 begin
    result:=baslib.BMIN(testreal(x), testreal(y))
 end;
 function BMIN(x:double;  y:Complex):double;inline;    overload;
 begin
    result:=baslib.BMIN(testreal(x), testreal(y))
 end;
 function BMIN( x:Complex; y:double):double;inline;    overload;
 begin
    result:=baslib.BMIN(testreal(x), testreal(y))
 end;

 function BMAX( x,y:Complex):double;inline;    overload;
begin
    result:=baslib.BMAX(testreal(x), testreal(y))
 end;
 function BMAX(x:double;  y:Complex):double;inline;    overload;
begin
    result:=baslib.BMAX(testreal(x), testreal(y))
 end;
 function BMAX( x:Complex; y:double):double;inline;    overload;
begin
    result:=baslib.BMAX(testreal(x), testreal(y))
 end;

 function FRAC(x:complex):double; inline; overload;
begin
   result:=system.frac(testreal(x))
end;

 function INT(x:complex):double;  inline; overload;
begin
   result:=system.int(testreal(x))
end;


 function PERM( n,r:Complex):double;                overload;
 begin
    result:=baslib.PERM(testreal(n), testreal(r))
 end;
 function PERM( n:double; r:Complex):double;                overload;
 begin
    result:=baslib.PERM(testreal(n), testreal(r))
 end;
 function PERM( n:Complex; r:double):double;                overload;
 begin
    result:=baslib.PERM(testreal(n), testreal(r))
 end;

 function COMB( n,r:Complex):double;                overload;
 begin
    result:=baslib.COMB(testreal(n), testreal(r))
 end;
 function COMB( n:double; r:Complex):double;                overload;
 begin
    result:=baslib.COMB(testreal(n), testreal(r))
 end;
 function COMB( n:Complex; r:double):double;                overload;
 begin
    result:=baslib.COMB(testreal(n), testreal(r))
 end;

 function FACT( x:Complex):double;             overload;
 begin
     result:=baslib.FACT(testreal(x))
 end;



{****************}
{STRING Functions}
{****************}
 function SubString(s:string; i1,i2:Complex):string;         overload;
 begin
   result:=SubString(s, testreal(i1),testreal(i2))
 end;
 function SubString(s:string; i1:double; i2:Complex):string;         overload;
 begin
   result:=SubString(s, testreal(i1),testreal(i2))
 end;
 function SubString(s:string; i1:complex; i2:double):string;         overload;
 begin
   result:=SubString(s, testreal(i1),testreal(i2))
 end;

 function SubStringByte(s:string; i1,i2:Complex):string;     overload;
 begin
   result:=SubStringByte(s, testreal(i1),testreal(i2))
 end;
 function SubStringByte(s:string; i1:double; i2:Complex):string;     overload;
 begin
   result:=SubStringByte(s, testreal(i1),testreal(i2))
 end;
 function SubStringByte(s:string; i1:complex; i2:double):string;     overload;
 begin
   result:=SubStringByte(s, testreal(i1),testreal(i2))
 end;

 function STR_s(x:Complex):string;                           overload;
 begin
   if x.y=0 then
      result:=STR_s(testreal(x))
    else
      result:='('+str_s(x.x)+' '+str_s(x.y)+')'
 end;

 function CHR_s(x:Complex):string;                           overload;
 begin
    result:=CHR_s(testreal(x))
 end;

 function CHRbyte(x:Complex):string;                         overload;
 begin
    result:=CHRbyte(testreal(x))
 end;

 function USING_s(const s:string; x:Complex):string;         overload;
 begin
    result:=USING_s(s, testreal(x))
 end;

 function USING_ss(const s:string; x:Complex):string;        overload;
 begin
   result:=USING_ss(s, testreal(x))
 end;

 function REPEAT_s(const s:string; x:Complex):string;        overload;
 begin
    result:=REPEAT_s(s, testreal(x))
 end;

 function BSTR_s(x:Complex; n:integer):string;               overload;
begin
   result:=BSTR_s(testreal(x),n)
end;

 function Mid_s(s:string; i1,i2:Complex):string;             overload;
 begin
   result:=MID_s(s, testreal(i1),testreal(i2))
 end;
 function Mid_s(s:string; i1:double; i2:Complex):string;             overload;
 begin
   result:=MID_s(s, testreal(i1),testreal(i2))
 end;
 function Mid_s(s:string; i1:complex; i2:double):string;             overload;
 begin
   result:=MID_s(s, testreal(i1),testreal(i2))
 end;

 function Mid_sByte(s:string; i1,i2:Complex):string;         overload;
 begin
   result:=MID_sByte(s, testreal(i1),testreal(i2))
 end;
 function Mid_sByte(s:string; i1:double; i2:Complex):string;         overload;
 begin
   result:=MID_sByte(s, testreal(i1),testreal(i2))
 end;
 function Mid_sByte(s:string; i1:complex; i2:double):string;         overload;
 begin
   result:=MID_sByte(s, testreal(i1),testreal(i2))
 end;

 function Left_sByte(s:string; i:Complex):string;            overload;
 begin
   result:=Left_sByte(s, testreal(i))
 end;

 function Left_s(s:string;i:Complex):string;                 overload;
 begin
   result:=Left_s(s, testreal(i))
 end;

 function Right_sByte(s:string; i:Complex):string;           overload;
 begin
   result:=Right_sByte(s, testreal(i))
 end;

 function Right_s(s:string;i:Complex):string;                overload;
 begin
   result:=Right_s(s, testreal(i))
 end;

{String Variable}
procedure SubstSubstringByte(var v:AnsiString; i,j:Complex; const s:ansistring); overload;
begin
    SubstSubstringByte(v, testreal(i), testreal(j), s)
end;
procedure SubstSubstringByte(var v:AnsiString; i:double; j:Complex; const s:ansistring); overload;
begin
    SubstSubstringByte(v, testreal(i), testreal(j), s)
end;
procedure SubstSubstringByte(var v:AnsiString; i:Complex; j:double; const s:ansistring); overload;
begin
    SubstSubstringByte(v, testreal(i), testreal(j), s)
end;

procedure SubstSubstring(var v:AnsiString; i,j:Complex; const s:ansistring);     overload;
begin
    SubstSubstring(v, testreal(i), testreal(j), s)
end;
procedure SubstSubstring(var v:AnsiString; i:double; j:Complex; const s:ansistring);     overload;
begin
    SubstSubstring(v, testreal(i), testreal(j), s)
end;
procedure SubstSubstring(var v:AnsiString; i:Complex; j:double; const s:ansistring);     overload;
begin
    SubstSubstring(v, testreal(i), testreal(j), s)
end;

{Let Statements}

procedure LETC(const p:Array of PComplex; x:Complex);
var
   i:integer;
begin
   for i:=0 to High(p) do
       p[i]^:=x;
end;


{ Ask Statement}
procedure AskFile(ch:TTextDEvice;
                  expAccess,expDatum,expErasable,expFileType,expName,
                  expOrganization,expPointer,expRecsize1,expRecType,
                  expSetter,expCharin,expTypeahead,expEchoControl,expEcho:TStrVar;
                  expMargin,expRecSize2,expZonewidth,expCharacterPending,expFilesize:PComplex);
begin
   baslib.AskFile(ch,
                  expAccess,expDatum,expErasable,expFileType,expName,
                  expOrganization,expPointer,expRecsize1,expRecType,
                  expSetter,expCharin,expTypeahead,expEchoControl,expEcho,
                  @(expMargin^.x), @(expRecSize2^.x), @(expZonewidth^.x),
                  @(expCharacterPending^.x), @(expFilesize^.x))
end;

{Misc.}
procedure Wait(n:Complex);         overload;
begin
   baslib.Wait(testreal(n))
end;

procedure swap(var x,y:Complex);overload;
begin
   baslib.swap(x.x, y.x); baslib.swap(x.y, y.y)
end;

function FloatVal( const s:ansistring):complex;
var
   code:integer;
   c:complex;
   i,j,k:integer;
   s1,s2:ansistring;
begin
   i:=pos('(',s);
   if i=0 then
    begin
        try
           system.Val(s,c.x,code);            {!!!!!!!!!!要修正!!!!!!!!!}
           if code<>0 then setexception(8101);
        except
           on EMathError do setexception(1006);
        end;
        c.y:=0;
        result:=c;
    end
   else
    begin
      j:=i+2;
      while (j<=length(s)) and (s[j]<>' ') do inc(j);
      k:=pos(')',s);
      s1:=copy(s,i+1,j-i-1);
      s2:=copy(s,j+1,k-j-1);
      try
         system.Val(s1,c.x,code);            {!!!!!!!!!!要修正!!!!!!!!!}
         if code<>0 then setexception(8101);
         system.Val(s2,c.y,code);             {!!!!!!!!!!要修正!!!!!!!!!}
         if code<>0 then setexception(8101);
       except
         on EMathError do setexception(1006);
      end;
      result:=c;
    end;
end;

end.

