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



interface
uses  Classes, StdCtrls, ComCtrls,  SysUtils, Graphics, inifiles, math,
      Types, Forms,Controls,{$IFDEF WINDOWS}LazUTF8,{$ENDIF}
      sconsts;

{$IF FPC_FULLVERSION<20600}
{$IFDEF CPU32}
type NativeINT=integer;
     NativeUint=Cardinal;
{$ENDIF}
{$IFDEF CPU64}
type NativeINT=Int64;
     NativeUint=QWord;
{$ENDIF}
{$ENDIF}

function UTF8ToNative(const s:string):string;
function NativeToUTF8(const s:string):string;

const
   MinInt=-maxint-1;

type
   IOOption=(ioReadWrite,ioCharacterByte,ioSkipRest,ioWhenInside,ioClear,ioNoWait);
   IOOptions=set of IOOption;
type
    tpRecordSetter=(rsNone,rsBEGIN,rsEND,rsNEXT,rsSAME);
type
    AccessMode=(amOUTIN,amINPUT,amOUTPUT);
    RecordType=(rcDISPLAY,rcINTERNAL,rcCSV);
    OrganizationType=(orgSEQ,orgSTREAM);

const
    AccessModeLiteral:array[AccessMode]of AnsiString=('OUTIN','INPUT','OUTPUT');
    RecordTypeLiteral:array[RecordType] of ansistring =('DISPLAY','INTERNAL','CSV');
    OrganizationTypeLiteral:array[OrganizationType] of Ansistring=('SEQUENTIAL','STREAM');
    YesNoLiteral:array[false..true]of AnsiString=('NO','YES');

type
  TypBmpSize=(BMPpc9801,BMPdosv,BMP321,BMP401,BMP501,BMP641,BMP801,BMP1001,BMP1281,BMP1601,BMP2001);
var
   BmpSize:TypBmpSize=BMP641;
const
   BMPSizeLiteral:array[TypBMPSize] of ansistring=
         ('BMPpc9801','BMPdosv','BMP321','BMP401','BMP501','BMP641','BMP801','BMP1001','BMP1281','BMP1601','BMP2001');



type
    EExtype=class(Exception)
       extype:integer;
      constructor create;overload ;
      constructor create(i:integer);overload ;
      constructor create(b:double);overload ;
    end;

procedure setexception(t:integer);
procedure setexceptionwith(const s:string; t:integer);




const
      outofmemory=-100;
      StackOverflow=-101;
      VirtualStackOverflow=-102;
      ArraySizeOverflow=-103;
      GosubStackOverflow=-104; {For Code Gen. Only}
      TooLargeVirtualStack=-105;
      TextOverFlow=-108;
      SystemErr=-109;



 type
  TBreakFlags=record
     case integer of
       1: (LongFlag:longbool);
       2: (ctrlBreak:boolean; TraceMode:boolean; TraceChannelPlus1:word);
     end;
var
  BreakFlags:TBreakFlags=(LongFlag:false) ;
  ctrlBreakHit: boolean absolute BreakFlags;

{*****************}
{Utility functions}
{*****************}
function max(a,b:NativeInt):NativeInt; inline;
function min(a,b:NativeInt):NativeInt; inline;
function imod(a,b:NativeInt):NativeInt;
function Spaces(n:integer):ansistring;
function strint(i:NativeInt):string;


//コプロセッサコントロールワード
const
   maxnumber1:array[0..4]of word=($ffff,$ffff,$ffff,$ffff,$7ffe);
var
   maxnumber:extended absolute maxnumber1;
const
   maxnumber2:array[0..3]of word=($ffff,$ffff,$ffff,$7fef);
var
   maxnumberDouble:double absolute maxnumber2;



 {***}
 {FPU}
 {***}

//const RoundMost :WORD = $1372; //近い方の値に丸め
const RoundNins :WORD = $177F; //－∞方向に切り捨て
const RoundPlus :WORD = $1B7F; //＋∞方向に切り上げ
const RoundZero :WORD = $1F7F; //０方向の値に丸め


  {$IFDEF CPU64}
  {$DEFINE SSEArithmetic}
  {$ENDIF}


  type CWrec={$IFDEF SSEArithmetic}TFPUExceptionMask{$ELSE}Word{$ENDIF};

  procedure SetFPUMask(cw:CWrec);inline;
  function GetFPUmask:CWrec;inline;
  procedure RecoverFloatException; inline;

  const NormalCW={$IFDEF SSEArithmetic}[exDenormalized,exUnderflow, exPrecision]{$ELSE}$1372{$ENDIF};
  var   ControlWord:CWrec=NormalCW;
  var   OriginalCW:CWrec;



const
  CharNameTBL1:array[0..39] of string[3] =
           ('NUL','SOH','STX','ETX','EOT','ENQ','ACK','BEL','BS','HT',
            'LF' ,'VT' ,'FF' ,'CR' ,'SO' ,'SI' ,'DLE','DC1','DC2','DC3',
            'DC4','NAK','SYN','ETB','CAN','EM' ,'SUB','ESC','FS' ,'GS' ,
            'RS' ,'US' ,'SP' ,'UND','GRA','LBR','VLN','RBR','TIL','DEL');
  CharNameTBL2:array[0..39] of byte =
           (  0, 1, 2, 3, 4, 5, 6, 7, 8, 9,
             10,11,12,13,14,15,16,17,18,19,
             20,21,22,23,24,25,26,27,28,29,
             30,31,32,95,96,123,124,125,126,127);



function Format17(x:double):String;
function Format20(x:extended):String;


{********}
{Ini File}
{********}

 function IniFileName:string;

type
   TMyIniFile=class(TObject)
     Ini:TIniFile;
     section:string;
     readOnly:boolean;
     constructor create(const section1:string);
     destructor  destroy; override;
     function FileName:string;virtual;
     function ReadInteger (const Ident: string; Default: integer): integer;
     function ReadString (const Ident: string; const Default: string): string;
     function ReadBool (const Ident: string; Default: Boolean): Boolean;
     procedure   WriteInteger(const Ident: string; Value: integer);
     procedure   Writestring(const Ident: string; const Value:string);
     procedure   WriteBool(const Ident: string; Value: Boolean);
     procedure   RestoreFont(font: TFont);
     procedure   StoreFont(font: TFont);
   end;

var
  IniFileReadOnly:boolean=false;
var
  NoInitialize:boolean=false;
var
   UseReg:boolean=false;



{++++++++++++}
implementation
{++++++++++++}

uses
      myutils;

function UTF8ToNative(const s:string):string;
begin
  {$IFDEF Windows}
  Result:=UTF8ToWinCP(s)
  {$ELSE}
  Result:=s
  {$ENDIF}
end;

function NativeToUTF8(const s:string):string;
begin
  {$IFDEF Windows}
  Result:=WinCPToUTF8(s)
  {$ELSE}
  Result:=s
  {$ENDIF}
end;

function Format17(x:double):String;
begin
  result:=SysUtils.Format('%.17g', [x]);
end;

function Format20(x:extended):String;
begin
  result:=SysUtils.Format('%.20g', [x]);
end;




function max(a,b:NativeInt):NativeInt;inline;
begin
  if a>b then
     max:=a
  else
     max:=b
end;

function min(a,b:NativeInt):NativeInt;inline;
begin
  if a>b then
     min:=b
  else
     min:=a
end;



{**************}
{error handling}
{**************}



procedure setexception(t:integer);
begin
  setexceptionwith('',t)
end;

procedure setexceptionwith(const s:string; t:integer);
begin
    if t=0 then exit; // extype 0 を発生ささない
    //statusmes.add(s);
    raise EExtype.create(t);
end;


function imod(a,b:NativeInt):NativeInt;
var
n:integer;
begin
   if a>=0 then
      imod:=a mod b
   else
      begin
         n:=a mod b;
         if n<>0 then inc(n,b);
         imod:=n
      end;
end;

function Spaces(n:integer):ansistring;
var
  i:integer;
  s:ansistring;
begin
  s:='';
  for i:=1 to n do s:=s+' ';
  Spaces:=s
end;


function strint(i:NativeInt):string;
var
   s:string;
begin
    str(i,s);
    strint:=s
end;




constructor EExtype.create;overload;
begin
  inherited create('');
end;

constructor EExtype.create(i:integer);  overload;
begin
  inherited create('extype ' + strint(i));
  extype:=i
end;

constructor EExtype.create(b:double);  overload;
var
   i:integer;
begin
  i:=Math.Floor(b+0.5);
  inherited create('extype ' + strint(i));
  extype:=i
end;





{********}
{INI File}
{********}


function IniFileName:string;
begin
{$IFDEF Windows}
   result:= ChangeFileExt(Application.ExeName,'.ini')
{$ELSE}
   result:=GetEnvironmentVariable('HOME') +'/.'+ ChangeFileExt( ExtractFileName(Application.ExeName), '.ini' )
   {$ENDIF}
end;

function TMyIniFile.FileName:string;
begin
   result:=inifileName;
end;

constructor TMyIniFile.create(const section1:string);
begin
   inherited create;
   Ini:=TIniFile.create(FileName);
   section:=section1;
   ReadOnly:=NoInitialize or IniFileReadOnly;
end;

destructor TMyIniFile.destroy;
begin
   if Ini<>nil then ini.free;
   section:='';
   inherited destroy;
end;


function TMyIniFile.ReadInteger (const Ident: string; Default: integer): integer;
begin
  if ini<>nil then
    result:=ini.ReadInteger(section,ident,default)
end;

function TMyIniFile.ReadString (const Ident: string; const Default: string): string;
begin
   if ini<>nil then
    result:=ini.ReadString(section,ident,default)
end;

function TMyIniFile.ReadBool (const Ident: string; Default: Boolean): Boolean;
begin
  if ini<>nil then
    result:=ini.ReadBool(section,ident,default)
end;

procedure   TMyIniFile.WriteInteger(const Ident: string; Value: integer);
begin
   if not readonly then
     if ini<>nil then
      try
       ini.WriteInteger(section,ident,value)
      except
      end
end;

procedure   TMyIniFile.Writestring(const Ident: string; const Value:string);
begin
   if not readonly then
     if ini<>nil then
       try
        ini.WriteString(section,ident,value)
       except
       end
end;

procedure   TMyIniFile.WriteBool(const Ident: string; Value: Boolean);
begin
   if not readonly then
     if ini<>nil then
      try
       ini.WriteBool(section,ident,value)
      except
      end
end;

procedure   TMyIniFile.RestoreFont(font: TFont);
begin
 with font do
   begin
      Charset:=TFontCharset(ReadInteger('FontCharset',Ord(charset)));
      Name:=ReadString('FontName',Name);
       //Height:=ReadInteger('FontHeight',Height);
      Size:=ReadInteger('FontSize',Size);
      style:=TFontStyles(ReadInteger('FontStyle',Integer(Style)));
   end;
end;

procedure   TMyIniFile.StoreFont(font: TFont);
begin
  with font do
   begin
      WriteInteger('FontCharset',Ord(charset));
      WriteString('FontName',Name);
      //WriteInteger('FontHeight',Height);
      WriteInteger('FontSize',Size);
      WriteInteger('FontStyle',Integer(style));
   end;
end;


procedure SetFPUMask(cw:CWrec);inline;
begin
  {$IFDEF SSEArithmetic}
  ClearExceptions(False);
  SetExceptionMask(cw)
  {$ELSE}
  Set8087CW(cw)
  {$ENDIF}
end;

function GetFPUmask:CWrec;inline;
begin
  {$IFDEF SSEArithmetic}
  result:=GetExceptionMask
  {$ELSE}
  result:=Get8087CW
  {$ENDIF}
end;

procedure RecoverFloatException; inline;
begin
  asm finit end;
  SetFPUMask(NormalCW);
end;






{+++++++++++++}
initialization
{+++++++++++++}

SetRoundMode(rmNearest);
{$IFDEF Linux}
  {$IFDEF CPU32}
  originalCW:=$137f;
  {$ELSE}
  originalCW:=[exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision];
  {$ENDIF}
  SetFPUMask(OriginalCW); //Linux では，FPU割り込みを無効化しておく。
{$ELSE}  //Windows, Mac
originalCW:=getFPUMask;
{$ENDIF}


 DecimalSeparator:='.';

 finalization




end.
