Luxophia

1
unit LUX;
2

3
interface
4

5
uses
6
  System.Types,
7
  System.SysUtils,
8
  System.Classes,
9
  System.Math,
10
  System.Math.Vectors,
11
  System.Generics.Collections,
12
  System.Threading;
13

14
type
15

16
  Int08u = Byte;
17
  Int8u = Int08u;
18
  Int08s = Shortint;
19
  Int8s = Int08s;
20
  Int16u = Word;
21
  Int16s = Smallint;
22
  Int32u = Cardinal;
23
  Int32s = Integer;
24
  Int64u = UInt64;
25
  Int64s = Int64;
26

27
  Flo32s = Single;
28
  Flo64s = Double;
29

30
  // -------------------------------------------------------------------------
31

32
  PPByte = ^PByte;
33
  PPLongint = ^PLongint;
34

35
  // -------------------------------------------------------------------------
36

37
  PUInt8 = ^UInt8;
38
  PInt8 = ^Int8;
39
  PUInt16 = ^UInt16;
40
  PInt16 = ^Int16;
41
  PUInt32 = ^UInt32;
42
  PInt32 = ^Int32;
43
  PUIntPtr = ^UIntPtr;
44
  PIntPtr = ^IntPtr;
45

46
  // TArray2/3<>
47

48
  TArray2<T> = array of TArray<T>;
49
  TArray3<T> = array of TArray2<T>;
50

51
  // TConstProc/Func<>
52

53
  TConstProc<TA> = reference to procedure(const A: TA);
54
  TConstProc<TA, TB> = reference to procedure(const A: TA; const B: TB);
55
  TConstProc<TA, TB, TC> = reference to procedure(const A: TA; const B: TB;
56
    const C: TC);
57
  TConstProc<TA, TB, TC, TD> = reference to procedure(const A: TA; const B: TB;
58
    const C: TC; const D: TD);
59

60
  TConstFunc<TA, TResult> = reference to function(const A: TA): TResult;
61
  TConstFunc<TA, TB, TResult> = reference to function(const A: TA;
62
    const B: TB): TResult;
63
  TConstFunc<TA, TB, TC, TResult> = reference to function(const A: TA;
64
    const B: TB; const C: TC): TResult;
65
  TConstFunc<TA, TB, TC, TD, TResult> = reference to function(const A: TA;
66
    const B: TB; const C: TC; const D: TD): TResult;
67

68
  TConstProc1<T> = reference to procedure(const A: T);
69
  TConstProc2<T, TResult> = reference to procedure(const A, B: T);
70
  TConstProc3<T, TResult> = reference to procedure(const A, B, C: T);
71
  TConstProc4<T, TResult> = reference to procedure(const A, B, C, D: T);
72

73
  TConstFunc1<T, TResult> = reference to function(const A: T): TResult;
74
  TConstFunc2<T, TResult> = reference to function(const A, B: T): TResult;
75
  TConstFunc3<T, TResult> = reference to function(const A, B, C: T): TResult;
76
  TConstFunc4<T, TResult> = reference to function(const A, B, C, D: T): TResult;
77

78

79
  // THex4
80

81
  THex4 = type Word;
82

83
  HHex4 = record helper for THex4
84
  private
85
  public
86
    function ToString: String;
87
  end;
88

89
  // HMatrix3D
90

91
  HMatrix3D = record helper for TMatrix3D
92
  private
93
    function GetTranslate: TPoint3D;
94
    procedure SetTranslate(const Translate_: TPoint3D);
95
  public
96
    property Translate: TPoint3D read GetTranslate write SetTranslate;
97
    class function Identity: TMatrix3D; static;
98
  end;
99

100
  // TRay3D
101

102
  TRay3D = record
103
  private
104
  public
105
    Pos: TVector3D;
106
    Vec: TVector3D;
107
    constructor Create(const Pos_, Vec_: TVector3D);
108
  end;
109

110
  // TRangeArray<_TValue_>
111

112
  TRangeArray<_TValue_> = record
113
  private
114
    _Values: TArray<_TValue_>;
115
    _MinI: Integer;
116
    _MaxI: Integer;
117
    function GetValues(I_: Integer): _TValue_;
118
    procedure SetValues(I_: Integer; const Value_: _TValue_);
119
    procedure SetMinI(const MinI_: Integer);
120
    procedure SetMaxI(const MaxI_: Integer);
121
    function GetCount: Integer;
122
    procedure InitArray;
123
  public
124
    constructor Create(const MinI_, MaxI_: Integer);
125
    property Values[I_: Integer]: _TValue_ read GetValues
126
      write SetValues; default;
127
    property MinI: Integer read _MinI write SetMinI;
128
    property MaxI: Integer read _MaxI write SetMaxI;
129
    property Count: Integer read GetCount;
130
    procedure SetRange(const I_: Integer); overload;
131
    procedure SetRange(const MinI_, MaxI_: Integer); overload;
132
  end;
133

134
  // TMarginArray<_TValue_>
135

136
  TMarginArray<_TValue_> = record
137
  private
138
    _Values: TArray<_TValue_>;
139
    _LowerN: Integer;
140
    _Count: Integer;
141
    _UpperN: Integer;
142
    function GetValues(I_: Integer): _TValue_;
143
    procedure SetValues(I_: Integer; const Value_: _TValue_);
144
    procedure SetLowerN(const LowerN_: Integer);
145
    procedure SetCount(const Count_: Integer);
146
    procedure SetUpperN(const UpperN_: Integer);
147
    procedure InitArray;
148
  public
149
    constructor Create(const LowerN_, Count_, UpperN_: Integer);
150
    property Values[I_: Integer]: _TValue_ read GetValues
151
      write SetValues; default;
152
    property LowerN: Integer read _LowerN write SetLowerN;
153
    property Count: Integer read _Count write SetCount;
154
    property UpperN: Integer read _UpperN write SetUpperN;
155
  end;
156

157
  // TInterfacedBase
158

159
  TInterfacedBase = class(TObject, IInterface)
160
  private
161
  protected
162
    function QueryInterface(const IID_: TGUID; out Obj_): HResult; stdcall;
163
    function _AddRef: Integer; stdcall;
164
    function _Release: Integer; stdcall;
165
  public
166
  end;
167

168
  // TIdleTask
169

170
  TIdleTask = class
171
  private
172
  protected
173
    class var _Task: ITask;
174
  public
175
    class procedure Run(const Proc_: TThreadProcedure;
176
      const Delay_: Integer = 500);
177
  end;
178

179
  // TIter< TValue_ >
180

181
  TIter<TValue_> = class
182
  private
183
  protected
184
    function GetValue: TValue_; virtual; abstract;
185
    procedure SetValue(const Value_: TValue_); virtual; abstract;
186
  public
187
    property Value: TValue_ read GetValue write SetValue;
188
  end;
189

190
  // TFileReader
191

192
  TFileReader = class(TBinaryReader)
193
  private
194
  protected
195
    _Encoding: TEncoding;
196
    _OffsetBOM: Integer;
197
  public
198
    constructor Create(Stream_: TStream; Encoding_: TEncoding = nil;
199
      OwnsStream_: Boolean = False); overload;
200
    constructor Create(const Filename_: String;
201
      Encoding_: TEncoding = nil); overload;
202
    property OffsetBOM: Integer read _OffsetBOM;
203
    function EndOfStream: Boolean;
204
    function ReadLine: String;
205
    function Read(var Buffer_; Count_: Longint): Longint;
206
  end;
207

208
  // TSearchBM<_TYPE_>
209

210
  TSearchBM<_TYPE_> = class
211
  private
212
    __TableBC: TDictionary<_TYPE_, Integer>;
213
    _PN0: Integer;
214
    _PN1: Integer;
215
    _PN2: Integer;
216
    function Get_TableBC(const Key_: _TYPE_): Integer;
217
    procedure Set_TableBC(const Key_: _TYPE_; const Val_: Integer);
218
    function Equal(const A_, B_: _TYPE_): Boolean;
219
  protected
220
    _Pattern: TArray<_TYPE_>;
221
    _TableSF: TArray<Integer>;
222
    _TableGS: TArray<Integer>;
223
    property _TableBC[const Key_: _TYPE_]: Integer read Get_TableBC
224
      write Set_TableBC;
225
    function GetPattern: TArray<_TYPE_>;
226
    procedure SetPattern(const Pattern_: TArray<_TYPE_>);
227
    procedure MakeTableBC;
228
    procedure MakeTableSF;
229
    procedure MakeTableGS;
230
  public type
231
    TOnRead = reference to function(const I_: Integer): _TYPE_;
232

233
  type
234
    TOnReadBlock = reference to procedure(const HeadI_: Integer;
235
      const Buffer_: TArray<_TYPE_>);
236
  public
237
    constructor Create; overload;
238
    constructor Create(const Pattern_: TArray<_TYPE_>); overload;
239
    destructor Destroy; override;
240
    property Pattern: TArray<_TYPE_> read GetPattern write SetPattern;
241
    function Match(const Source_: TArray<_TYPE_>;
242
      const StartI_, StopI_: Integer): Integer; overload;
243
    function Matches(const Source_: TArray<_TYPE_>;
244
      const StartI_, StopI_: Integer): TArray<Integer>; overload;
245
    function Match(const Source_: TArray<_TYPE_>; const StartI_: Integer = 0)
246
      : Integer; overload;
247
    function Matches(const Source_: TArray<_TYPE_>; const StartI_: Integer = 0)
248
      : TArray<Integer>; overload;
249
    function Match(const StartI_, StopI_: Integer; const OnRead_: TOnRead)
250
      : Integer; overload;
251
    function Matches(const StartI_, StopI_: Integer; const OnRead_: TOnRead)
252
      : TArray<Integer>; overload;
253
    function Match(const StartI_, StopI_: Integer;
254
      const OnReadBlock_: TOnReadBlock): Integer; overload;
255
    function Matches(const StartI_, StopI_: Integer;
256
      const OnReadBlock_: TOnReadBlock): TArray<Integer>; overload;
257
  end;
258

259
const
260
  SINGLE_EPS = 1.1920928955078125E-7;
261
  DOUBLE_EPS = 2.220446049250313080847263336181640625E-16;
262

263
  SINGLE_EPS1 = SINGLE_EPS * 1E1;
264
  DOUBLE_EPS1 = DOUBLE_EPS * 1E1;
265

266
  SINGLE_EPS2 = SINGLE_EPS * 1E2;
267
  DOUBLE_EPS2 = DOUBLE_EPS * 1E2;
268

269
  SINGLE_EPS3 = SINGLE_EPS * 1E3;
270
  DOUBLE_EPS3 = DOUBLE_EPS * 1E3;
271

272
  SINGLE_EPS4 = SINGLE_EPS * 1E4;
273
  DOUBLE_EPS4 = DOUBLE_EPS * 1E4;
274

275
  // ------------------------------------------------------------------------
276

277
  Pi2 = 2 * Pi;
278
  Pi3 = 3 * Pi;
279
  Pi4 = 4 * Pi;
280

281
  P2i = Pi / 2;
282
  P3i = Pi / 3;
283
  P4i = Pi / 4;
284

285
  P3i2 = Pi2 / 3;
286

287
  // ------------------------------------------------------------------------
288

289
  CRLF = #13#10;
290

291
var
292
  _ThreadPool_ :TThreadPool;
293

294
{$IF SizeOf( Extended ) = 10 }
295
function Int(const X_: Extended): Extended; inline; overload;
296
function Frac(const X_: Extended): Extended; inline; overload;
297
function Exp(const X_: Extended): Extended; inline; overload;
298
function Cos(const X_: Extended): Extended; inline; overload;
299
function Sin(const X_: Extended): Extended; inline; overload;
300
function Ln(const X_: Extended): Extended; inline; overload;
301
function ArcTan(const X_: Extended): Extended; inline; overload;
302
function Sqrt(const X_: Extended): Extended; inline; overload;
303
function Tangent(const X_: Extended): Extended; inline; overload;
304
procedure SineCosine(const X_: Extended; var Sin_, Cos_: Extended);
305
  inline; overload;
306
function ExpMinus1(const X_: Extended): Extended; inline; overload;
307
function LnXPlus1(const X_: Extended): Extended; inline; overload;
308
{$ENDIF}
309
function Pow2(const X_: Int32u): Int32u; inline; overload;
310
function Pow2(const X_: Int32s): Int32s; inline; overload;
311
function Pow2(const X_: Int64u): Int64u; inline; overload;
312
function Pow2(const X_: Int64s): Int64s; inline; overload;
313
function Pow2(const X_: Single): Single; inline; overload;
314
function Pow2(const X_: Double): Double; inline; overload;
315

316
function Pow3(const X_: Int32u): Int32u; inline; overload;
317
function Pow3(const X_: Int32s): Int32s; inline; overload;
318
function Pow3(const X_: Int64u): Int64u; inline; overload;
319
function Pow3(const X_: Int64s): Int64s; inline; overload;
320
function Pow3(const X_: Single): Single; inline; overload;
321
function Pow3(const X_: Double): Double; inline; overload;
322

323
function Pow4(const X_: Int32u): Int32u; inline; overload;
324
function Pow4(const X_: Int32s): Int32s; inline; overload;
325
function Pow4(const X_: Int64u): Int64u; inline; overload;
326
function Pow4(const X_: Int64s): Int64s; inline; overload;
327
function Pow4(const X_: Single): Single; inline; overload;
328
function Pow4(const X_: Double): Double; inline; overload;
329

330
function Pow5(const X_: Int32u): Int32u; inline; overload;
331
function Pow5(const X_: Int32s): Int32s; inline; overload;
332
function Pow5(const X_: Int64u): Int64u; inline; overload;
333
function Pow5(const X_: Int64s): Int64s; inline; overload;
334
function Pow5(const X_: Single): Single; inline; overload;
335
function Pow5(const X_: Double): Double; inline; overload;
336

337
function Roo2(const X_: Single): Single; inline; overload;
338
function Roo2(const X_: Double): Double; inline; overload;
339

340
function Roo3(const X_: Single): Single; inline; overload;
341
function Roo3(const X_: Double): Double; inline; overload;
342

343
function Clamp(const X_, Min_, Max_: Integer): Integer; inline; overload;
344
function Clamp(const X_, Min_, Max_: Single): Single; inline; overload;
345
function Clamp(const X_, Min_, Max_: Double): Double; inline; overload;
346

347
function ClampMin(const X_, Min_: Integer): Integer; inline; overload;
348
function ClampMin(const X_, Min_: Single): Single; inline; overload;
349
function ClampMin(const X_, Min_: Double): Double; inline; overload;
350

351
function ClampMax(const X_, Max_: Integer): Integer; inline; overload;
352
function ClampMax(const X_, Max_: Single): Single; inline; overload;
353
function ClampMax(const X_, Max_: Double): Double; inline; overload;
354

355
function Min(const A_, B_, C_: Integer): Integer; overload;
356
function Min(const A_, B_, C_: Single): Single; overload;
357
function Min(const A_, B_, C_: Double): Double; overload;
358

359
function Max(const A_, B_, C_: Integer): Integer; overload;
360
function Max(const A_, B_, C_: Single): Single; overload;
361
function Max(const A_, B_, C_: Double): Double; overload;
362

363
function MinI(const A_, B_: Integer): Byte; inline; overload;
364
function MinI(const A_, B_: Single): Byte; inline; overload;
365
function MinI(const A_, B_: Double): Byte; inline; overload;
366

367
function MaxI(const A_, B_: Integer): Byte; inline; overload;
368
function MaxI(const A_, B_: Single): Byte; inline; overload;
369
function MaxI(const A_, B_: Double): Byte; inline; overload;
370

371
function MinI(const A_, B_, C_: Integer): Integer; inline; overload;
372
function MinI(const A_, B_, C_: Single): Integer; inline; overload;
373
function MinI(const A_, B_, C_: Double): Integer; inline; overload;
374

375
function MaxI(const A_, B_, C_: Integer): Integer; inline; overload;
376
function MaxI(const A_, B_, C_: Single): Integer; inline; overload;
377
function MaxI(const A_, B_, C_: Double): Integer; inline; overload;
378

379
function MinI(const Vs_: array of Integer): Integer; overload;
380
function MinI(const Vs_: array of Single): Integer; overload;
381
function MinI(const Vs_: array of Double): Integer; overload;
382

383
function MaxI(const Vs_: array of Integer): Integer; overload;
384
function MaxI(const Vs_: array of Single): Integer; overload;
385
function MaxI(const Vs_: array of Double): Integer; overload;
386

387
function PoMod(const X_, Range_: Integer): Integer; overload;
388
function PoMod(const X_, Range_: Int64): Int64; overload;
389

390
{$IF Defined( MACOS ) or Defined( MSWINDOWS ) }
391
function RevBytes(const Value_: Word): Word; overload;
392
function RevBytes(const Value_: Smallint): Smallint; overload;
393

394
function RevBytes(const Value_: Cardinal): Cardinal; overload;
395
function RevBytes(const Value_: Integer): Integer; overload;
396
function RevBytes(const Value_: Single): Single; overload;
397

398
function RevBytes(const Value_: UInt64): UInt64; overload;
399
function RevBytes(const Value_: Int64): Int64; overload;
400
function RevBytes(const Value_: Double): Double; overload;
401
{$ENDIF}
402
{$IF Defined( MACOS ) or Defined( MSWINDOWS ) }
403
function CharsToStr(const Cs_: TArray<AnsiChar>): AnsiString;
404
{$ENDIF}
405
function FileToBytes(const Filename_: string): TBytes;
406

407
function Comb(N_, K_: Cardinal): UInt64;
408

409
function BinPow(const N_: Integer): Integer; overload;
410
function BinPow(const N_: Cardinal): Cardinal; overload;
411
function BinPow(const N_: Int64): Int64; overload;
412
function BinPow(const N_: UInt64): UInt64; overload;
413

414
function UIntToStr(const Value_: UInt32; const N_: Integer;
415
  const C_: Char = '0'): String; overload;
416
function UIntToStr(const Value_: UInt64; const N_: Integer;
417
  const C_: Char = '0'): String; overload;
418

419
function IntToStr(const Value_: Integer; const N_: Integer;
420
  const C_: Char = '0'): String; overload;
421
function IntToStr(const Value_: Int64; const N_: Integer; const C_: Char = '0')
422
  : String; overload;
423
function IntToStrP(const Value_: Integer; const N_: Integer;
424
  const C_: Char = '0'): String; overload;
425
function IntToStrP(const Value_: Int64; const N_: Integer; const C_: Char = '0')
426
  : String; overload;
427

428
function FloatToStr(const Value_: Single; const N_: Integer;
429
  out Man_, Exp_: String): Boolean; overload;
430
function FloatToStr(const Value_: Double; const N_: Integer;
431
  out Man_, Exp_: String): Boolean; overload;
432

433
function _TestFloatToStr_Single(const Value_: String;
434
  const N_: Integer): String;
435
function _TestFloatToStr_Double(const Value_: String;
436
  const N_: Integer): String;
437

438
function FloatToStr(const Value_: Single; const N_: Integer;
439
  out Man_, Exp_: String; out DecN_: Integer): Boolean; overload;
440
function FloatToStr(const Value_: Double; const N_: Integer;
441
  out Man_, Exp_: String; out DecN_: Integer): Boolean; overload;
442

443
function FloatToStr(const Value_: Single; const N_: Integer): String; overload;
444
function FloatToStr(const Value_: Double; const N_: Integer): String; overload;
445
function FloatToStrP(const Value_: Single; const N_: Integer): String; overload;
446
function FloatToStrP(const Value_: Double; const N_: Integer): String; overload;
447

448
function Floor(const X_, D_: UInt32): UInt32; overload;
449
function Floor(const X_, D_: UInt64): UInt64; overload;
450

451
function Ceil(const X_, D_: UInt32): UInt32; overload;
452
function Ceil(const X_, D_: UInt64): UInt64; overload;
453

454
function Floor2N(const X_, D_: UInt32): UInt32; overload;
455
function Floor2N(const X_, D_: UInt64): UInt64; overload;
456

457
function Ceil2N(const X_, D_: UInt32): UInt32; overload;
458
function Ceil2N(const X_, D_: UInt64): UInt64; overload;
459

460
procedure GetMemAligned(out P_: Pointer; const Size_, Align2N_: UInt32);
461
procedure FreeMemAligned(const P_: Pointer);
462

463
function RealMod(const X_, Range_: Integer): Integer; overload;
464
function RealMod(const X_, Range_: Int64): Int64; overload;
465

466

467
// ----------------------------------------------------------------
468
implementation
469
// ----------------------------------------------------------------
470

471
function RealMod(const X_, Range_: Integer): Integer;
472
begin
473
  Result := X_ mod Range_;
474
  if Result < 0 then
475
    Inc(Result, Range_);
476
end;
477

478
function RealMod(const X_, Range_: Int64): Int64;
479
begin
480
  Result := X_ mod Range_;
481
  if Result < 0 then
482
    Inc(Result, Range_);
483
end;
484

485

486
// THex4
487

488
function HHex4.ToString: String;
489
begin
490
  Result := IntToHex(Self, 4);
491
end;
492

493
// HMatrix3D
494

495
function HMatrix3D.GetTranslate: TPoint3D;
496
begin
497
  with Result do
498
  begin
499
    X := m41;
500
    Y := m42;
501
    Z := m43;
502
  end;
503
end;
504

505
procedure HMatrix3D.SetTranslate(const Translate_: TPoint3D);
506
begin
507
  with Translate_ do
508
  begin
509
    m41 := X;
510
    m42 := Y;
511
    m43 := Z;
512
  end;
513
end;
514

515
class function HMatrix3D.Identity: TMatrix3D;
516
begin
517
  with Result do
518
  begin
519
    m11 := 1;
520
    m12 := 0;
521
    m13 := 0;
522
    m14 := 0;
523
    m21 := 0;
524
    m22 := 1;
525
    m23 := 0;
526
    m24 := 0;
527
    m31 := 0;
528
    m32 := 0;
529
    m33 := 1;
530
    m34 := 0;
531
    m41 := 0;
532
    m42 := 0;
533
    m43 := 0;
534
    m44 := 1;
535
  end;
536
end;
537

538
// TRay3D
539

540
constructor TRay3D.Create(const Pos_, Vec_: TVector3D);
541
begin
542
  Pos := Pos_;
543
  Vec := Vec_;
544
end;
545

546
// TRangeArray<_TValue_>
547

548
function TRangeArray<_TValue_>.GetValues(I_: Integer): _TValue_;
549
begin
550
  Dec(I_, _MinI);
551
  Result := _Values[I_];
552
end;
553

554
procedure TRangeArray<_TValue_>.SetValues(I_: Integer; const Value_: _TValue_);
555
begin
556
  Dec(I_, _MinI);
557
  _Values[I_] := Value_;
558
end;
559

560
procedure TRangeArray<_TValue_>.SetMinI(const MinI_: Integer);
561
begin
562
  _MinI := MinI_;
563

564
  InitArray;
565
end;
566

567
procedure TRangeArray<_TValue_>.SetMaxI(const MaxI_: Integer);
568
begin
569
  _MaxI := MaxI_;
570

571
  InitArray;
572
end;
573

574
function TRangeArray<_TValue_>.GetCount: Integer;
575
begin
576
  Result := _MaxI - _MinI + 1;
577
end;
578

579
procedure TRangeArray<_TValue_>.InitArray;
580
begin
581
  SetLength(_Values, GetCount);
582
end;
583

584
constructor TRangeArray<_TValue_>.Create(const MinI_, MaxI_: Integer);
585
begin
586
  SetRange(MinI_, MaxI_);
587
end;
588

589
procedure TRangeArray<_TValue_>.SetRange(const I_: Integer);
590
begin
591
  SetRange(I_, I_);
592
end;
593

594
procedure TRangeArray<_TValue_>.SetRange(const MinI_, MaxI_: Integer);
595
begin
596
  _MinI := MinI_;
597
  _MaxI := MaxI_;
598

599
  InitArray;
600
end;
601

602
// TMarginArray<_TValue_>
603

604
function TMarginArray<_TValue_>.GetValues(I_: Integer): _TValue_;
605
begin
606
  Inc(I_, _LowerN);
607
  Result := _Values[I_];
608
end;
609

610
procedure TMarginArray<_TValue_>.SetValues(I_: Integer; const Value_: _TValue_);
611
begin
612
  Inc(I_, _LowerN);
613
  _Values[I_] := Value_;
614
end;
615

616
procedure TMarginArray<_TValue_>.SetLowerN(const LowerN_: Integer);
617
begin
618
  _LowerN := LowerN_;
619

620
  InitArray;
621
end;
622

623
procedure TMarginArray<_TValue_>.SetCount(const Count_: Integer);
624
begin
625
  _Count := Count_;
626

627
  InitArray;
628
end;
629

630
procedure TMarginArray<_TValue_>.SetUpperN(const UpperN_: Integer);
631
begin
632
  _UpperN := UpperN_;
633

634
  InitArray;
635
end;
636

637
/// //////////////////////////////////////////////////////////////////// メソッド
638

639
procedure TMarginArray<_TValue_>.InitArray;
640
begin
641
  SetLength(_Values, _LowerN + _Count + _UpperN);
642
end;
643

644
constructor TMarginArray<_TValue_>.Create(const LowerN_, Count_,
645
  UpperN_: Integer);
646
begin
647
  _LowerN := LowerN_;
648
  _Count := Count_;
649
  _UpperN := UpperN_;
650

651
  InitArray;
652
end;
653

654
// TInterfacedBase
655

656
function TInterfacedBase.QueryInterface(const IID_: TGUID; out Obj_): HResult;
657
begin
658
  if GetInterface(IID_, Obj_) then
659
    Result := 0
660
  else
661
    Result := E_NOINTERFACE;
662
end;
663

664
function TInterfacedBase._AddRef: Integer;
665
begin
666
  Result := 0;
667
end;
668

669
function TInterfacedBase._Release: Integer;
670
begin
671
  Result := 0;
672
end;
673

674
// TIdleTask
675

676
class procedure TIdleTask.Run(const Proc_: TThreadProcedure;
677
  const Delay_: Integer = 500);
678
begin
679
  if Assigned(_Task) then
680
    _Task.Cancel;
681

682
  _Task := TTask.Run(
683
    procedure
684
    begin
685
      Sleep(Delay_);
686

687
      if TTask.CurrentTask.Status = TTaskStatus.Running then
688
        TThread.Queue(nil, Proc_);
689
    end);
690
end;
691

692
// TFileReader
693

694
constructor TFileReader.Create(Stream_: TStream; Encoding_: TEncoding = nil;
695
OwnsStream_: Boolean = False);
696
begin
697
  inherited Create(Stream_, TEncoding.ANSI, OwnsStream_);
698

699
  _OffsetBOM := TEncoding.GetBufferEncoding(ReadBytes(8), _Encoding, Encoding_);
700

701
  BaseStream.Position := _OffsetBOM;
702
end;
703

704
constructor TFileReader.Create(const Filename_: String;
705
Encoding_: TEncoding = nil);
706
begin
707
  Create(TFileStream.Create(Filename_, fmOpenRead or fmShareDenyWrite),
708
    Encoding_, True);
709
end;
710

711
function TFileReader.EndOfStream: Boolean;
712
begin
713
  Result := (PeekChar = -1);
714
end;
715

716
function TFileReader.ReadLine: String;
717
var
718
  Bs: TBytes;
719
  B: Byte;
720
begin
721
  Bs := [];
722

723
  while not EndOfStream do
724
  begin
725
    B := ReadByte;
726

727
    case B of
728
      10:
729
        Break;
730
      13:
731
        begin
732
          if PeekChar = 10 then
733
            ReadByte;
734

735
          Break;
736
        end;
737
    else
738
      Bs := Bs + [B];
739
    end;
740
  end;
741

742
  Result := _Encoding.GetString(Bs);
743
end;
744

745
function TFileReader.Read(var Buffer_; Count_: Longint): Longint;
746
begin
747
  Result := BaseStream.Read(Buffer_, Count_);
748
end;
749

750
// TSearchBM<_TYPE_>
751

752
function TSearchBM<_TYPE_>.Get_TableBC(const Key_: _TYPE_): Integer;
753
begin
754
  if __TableBC.ContainsKey(Key_) then
755
    Result := __TableBC[Key_]
756
  else
757
    Result := _PN0;
758

759
end;
760

761
procedure TSearchBM<_TYPE_>.Set_TableBC(const Key_: _TYPE_;
762
const Val_: Integer);
763
begin
764
  __TableBC.AddOrSetValue(Key_, Val_);
765
end;
766

767
function TSearchBM<_TYPE_>.Equal(const A_, B_: _TYPE_): Boolean;
768
begin
769
  Result := CompareMem(@A_, @B_, SizeOf(_TYPE_));
770
end;
771

772
function TSearchBM<_TYPE_>.GetPattern: TArray<_TYPE_>;
773
begin
774
  Result := _Pattern;
775
end;
776

777
procedure TSearchBM<_TYPE_>.SetPattern(const Pattern_: TArray<_TYPE_>);
778
begin
779
  _Pattern := Pattern_;
780

781
  _PN0 := Length(_Pattern);
782
  _PN1 := _PN0 - 1;
783
  _PN2 := _PN1 - 1;
784

785
  MakeTableBC;
786
  MakeTableSF;
787
  MakeTableGS;
788
end;
789

790
procedure TSearchBM<_TYPE_>.MakeTableBC;
791
var
792
  I: Integer;
793
begin
794
  with __TableBC do
795
  begin
796
    Clear;
797

798
    for I := 0 to _PN2 do
799
      AddOrSetValue(_Pattern[I], _PN1 - I);
800
  end;
801
end;
802

803
procedure TSearchBM<_TYPE_>.MakeTableSF;
804
var
805
  I, G, F: Integer;
806
begin
807
  SetLength(_TableSF, _PN0);
808

809
  _TableSF[_PN1] := _PN0;
810

811
  F := _PN1;
812
  G := _PN1;
813
  for I := _PN2 downto 0 do
814
  begin
815
    if (I > G) and (_TableSF[I + _PN1 - F] < I - G) then
816
    begin
817
      _TableSF[I] := _TableSF[I + _PN1 - F];
818
    end
819
    else
820
    begin
821
      if I < G then
822
        G := I;
823

824
      F := I;
825

826
      while (G >= 0) and Equal(_Pattern[G], _Pattern[G + _PN1 - F]) do
827
        Dec(G);
828

829
      _TableSF[I] := F - G;
830
    end;
831
  end;
832
end;
833

834
{
835
  procedure TSearchBM<_TYPE_>.MakeTableGS;
836
  var
837
  S, I, J :Integer;
838
  begin
839
  SetLength( _TableGS, _PN0 );
840

841
  for I := 0 to _PN1 do _TableGS[ I ] := _PN0;
842

843
  I := 0;
844
  S := 0;
845
  for J := _PN1 downto 0 do
846
  begin
847
  if _TableSF[ J ] = J + 1 then
848
  begin
849
  while I < S do
850
  begin
851
  _TableGS[ I ] := S;
852

853
  Inc( I );
854
  end;
855
  end;
856

857
  Inc( S );
858
  end;
859

860
  for I := 0 to _PN2 do _TableGS[ _PN1 - _TableSF[ I ] ] := _PN1 - I;
861
  end;
862
}
863
procedure TSearchBM<_TYPE_>.MakeTableGS;
864
var
865
  S, I, J: Integer;
866
begin
867
  SetLength(_TableGS, _PN0);
868

869
  S := _PN0;
870

871
  _TableGS[_PN1] := S;
872

873
  J := 0;
874
  for I := _PN2 downto 0 do
875
  begin
876
    if _TableSF[J] = J + 1 then
877
      S := I + 1;
878

879
    _TableGS[I] := S;
880

881
    Inc(J);
882
  end;
883

884
  for I := 0 to _PN2 do
885
    _TableGS[_PN1 - _TableSF[I]] := _PN1 - I;
886
end;
887

888
constructor TSearchBM<_TYPE_>.Create;
889
begin
890
  inherited;
891

892
  __TableBC := TDictionary<_TYPE_, Integer>.Create;
893
end;
894

895
constructor TSearchBM<_TYPE_>.Create(const Pattern_: TArray<_TYPE_>);
896
begin
897
  Create;
898

899
  SetPattern(Pattern_);
900
end;
901

902
destructor TSearchBM<_TYPE_>.Destroy;
903
begin
904
  __TableBC.Free;
905

906
  inherited;
907
end;
908

909
function TSearchBM<_TYPE_>.Match(const Source_: TArray<_TYPE_>;
910
const StartI_, StopI_: Integer): Integer;
911
var
912
  J, I: Integer;
913
  A: _TYPE_;
914
label
915
  NOTMATCH;
916
begin
917
  J := StartI_;
918

919
  while J <= StopI_ - _PN0 do
920
  begin
921
    for I := _PN1 downto 0 do
922
    begin
923
      A := Source_[J + I];
924

925
      if not Equal(_Pattern[I], A) then
926
      begin
927
        Inc(J, Max(_TableGS[I], _TableBC[A] - _PN1 + I));
928

929
        goto NOTMATCH;
930
      end;
931
    end;
932

933
    Result := J;
934

935
    Exit;
936

937
  NOTMATCH:
938
  end;
939

940
  Result := -1;
941
end;
942

943
function TSearchBM<_TYPE_>.Matches(const Source_: TArray<_TYPE_>;
944
const StartI_, StopI_: Integer): TArray<Integer>;
945
var
946
  J, I: Integer;
947
  A: _TYPE_;
948
label
949
  NOTMATCH;
950
begin
951
  Result := [];
952

953
  J := StartI_;
954

955
  while J <= StopI_ - _PN0 do
956
  begin
957
    for I := _PN1 downto 0 do
958
    begin
959
      A := Source_[J + I];
960

961
      if not Equal(_Pattern[I], A) then
962
      begin
963
        Inc(J, Max(_TableGS[I], _TableBC[A] - _PN1 + I));
964

965
        goto NOTMATCH;
966
      end;
967
    end;
968

969
    Result := Result + [J];
970

971
    Inc(J, _TableGS[0]);
972

973
  NOTMATCH:
974
  end;
975
end;
976

977
// ------------------------------------------------------------------------------
978

979
function TSearchBM<_TYPE_>.Match(const Source_: TArray<_TYPE_>;
980
const StartI_: Integer = 0): Integer;
981
begin
982
  Result := Match(Source_, StartI_, Length(Source_));
983
end;
984

985
function TSearchBM<_TYPE_>.Matches(const Source_: TArray<_TYPE_>;
986
const StartI_: Integer = 0): TArray<Integer>;
987
begin
988
  Result := Matches(Source_, StartI_, Length(Source_));
989
end;
990

991
// ------------------------------------------------------------------------------
992

993
function TSearchBM<_TYPE_>.Match(const StartI_, StopI_: Integer;
994
const OnRead_: TOnRead): Integer;
995
var
996
  J, I: Integer;
997
  A: _TYPE_;
998
label
999
  NOTMATCH;
1000
begin
1001
  J := StartI_;
1002

1003
  while J <= StopI_ - _PN0 do
1004
  begin
1005
    for I := _PN1 downto 0 do
1006
    begin
1007
      A := OnRead_(J + I);
1008

1009
      if not Equal(_Pattern[I], A) then
1010
      begin
1011
        Inc(J, Max(_TableGS[I], _TableBC[A] - _PN1 + I));
1012

1013
        goto NOTMATCH;
1014
      end;
1015
    end;
1016

1017
    Result := J;
1018

1019
    Exit;
1020

1021
  NOTMATCH:
1022
  end;
1023

1024
  Result := -1;
1025
end;
1026

1027
function TSearchBM<_TYPE_>.Matches(const StartI_, StopI_: Integer;
1028
const OnRead_: TOnRead): TArray<Integer>;
1029
var
1030
  J, I: Integer;
1031
  A: _TYPE_;
1032
label
1033
  NOTMATCH;
1034
begin
1035
  Result := [];
1036

1037
  J := StartI_;
1038

1039
  while J <= StopI_ - _PN0 do
1040
  begin
1041
    for I := _PN1 downto 0 do
1042
    begin
1043
      A := OnRead_(J + I);
1044

1045
      if not Equal(_Pattern[I], A) then
1046
      begin
1047
        Inc(J, Max(_TableGS[I], _TableBC[A] - _PN1 + I));
1048

1049
        goto NOTMATCH;
1050
      end;
1051
    end;
1052

1053
    Result := Result + [J];
1054

1055
    Inc(J, _TableGS[0]);
1056

1057
  NOTMATCH:
1058
  end;
1059
end;
1060

1061
// ------------------------------------------------------------------------------
1062

1063
function TSearchBM<_TYPE_>.Match(const StartI_, StopI_: Integer;
1064
const OnReadBlock_: TOnReadBlock): Integer;
1065
var
1066
  B: TArray<_TYPE_>;
1067
  J, I: Integer;
1068
label
1069
  NOTMATCH;
1070
begin
1071
  SetLength(B, _PN0);
1072

1073
  J := StartI_;
1074

1075
  while J <= StopI_ - _PN0 do
1076
  begin
1077
    OnReadBlock_(J, B);
1078

1079
    for I := _PN1 downto 0 do
1080
    begin
1081
      if not Equal(_Pattern[I], B[I]) then
1082
      begin
1083
        Inc(J, Max(_TableGS[I], _TableBC[B[I]] - _PN1 + I));
1084

1085
        goto NOTMATCH;
1086
      end;
1087
    end;
1088

1089
    Result := J;
1090

1091
    Exit;
1092

1093
  NOTMATCH:
1094
  end;
1095

1096
  Result := -1;
1097
end;
1098

1099
function TSearchBM<_TYPE_>.Matches(const StartI_, StopI_: Integer;
1100
const OnReadBlock_: TOnReadBlock): TArray<Integer>;
1101
var
1102
  B: TArray<_TYPE_>;
1103
  J, I: Integer;
1104
label
1105
  NOTMATCH;
1106
begin
1107
  Result := [];
1108

1109
  SetLength(B, _PN0);
1110

1111
  J := StartI_;
1112

1113
  while J <= StopI_ - _PN0 do
1114
  begin
1115
    OnReadBlock_(J, B);
1116

1117
    for I := _PN1 downto 0 do
1118
    begin
1119
      if not Equal(_Pattern[I], B[I]) then
1120
      begin
1121
        Inc(J, Max(_TableGS[I], _TableBC[B[I]] - _PN1 + I));
1122

1123
        goto NOTMATCH;
1124
      end;
1125
    end;
1126

1127
    Result := Result + [J];
1128

1129
    Inc(J, _TableGS[0]);
1130

1131
  NOTMATCH:
1132
  end;
1133
end;
1134

1135
{$IF SizeOf( Extended ) = 10 }
1136

1137
function Int(const X_: Extended): Extended;
1138
begin
1139
  Result := System.Int(X_);
1140
end;
1141

1142
function Frac(const X_: Extended): Extended;
1143
begin
1144
  Result := System.Frac(X_);
1145
end;
1146

1147
function Exp(const X_: Extended): Extended;
1148
begin
1149
  Result := System.Exp(X_);
1150
end;
1151

1152
function Cos(const X_: Extended): Extended;
1153
begin
1154
  Result := System.Cos(X_);
1155
end;
1156

1157
function Sin(const X_: Extended): Extended;
1158
begin
1159
  Result := System.Sin(X_);
1160
end;
1161

1162
function Ln(const X_: Extended): Extended;
1163
begin
1164
  Result := System.Ln(X_);
1165
end;
1166

1167
function ArcTan(const X_: Extended): Extended;
1168
begin
1169
  Result := System.ArcTan(X_);
1170
end;
1171

1172
function Sqrt(const X_: Extended): Extended;
1173
begin
1174
  Result := System.Sqrt(X_);
1175
end;
1176

1177
function Tangent(const X_: Extended): Extended;
1178
begin
1179
  Result := System.Tangent(X_);
1180
end;
1181

1182
procedure SineCosine(const X_: Extended; var Sin_, Cos_: Extended);
1183
begin
1184
  System.SineCosine(X_, Sin_, Cos_);
1185
end;
1186

1187
function ExpMinus1(const X_: Extended): Extended;
1188
begin
1189
  Result := System.ExpMinus1(X_);
1190
end;
1191

1192
function LnXPlus1(const X_: Extended): Extended;
1193
begin
1194
  Result := System.LnXPlus1(X_);
1195
end;
1196

1197
{$ENDIF}
1198

1199
// ------------------------------------------------------------------------------
1200

1201
function Pow2(const X_: Int32u): Int32u;
1202
begin
1203
  Result := Sqr(X_);
1204
end;
1205

1206
function Pow2(const X_: Int32s): Int32s;
1207
begin
1208
  Result := Sqr(X_);
1209
end;
1210

1211
function Pow2(const X_: Int64u): Int64u;
1212
begin
1213
  Result := Sqr(X_);
1214
end;
1215

1216
function Pow2(const X_: Int64s): Int64s;
1217
begin
1218
  Result := Sqr(X_);
1219
end;
1220

1221
function Pow2(const X_: Single): Single;
1222
begin
1223
  Result := Sqr(X_);
1224
end;
1225

1226
function Pow2(const X_: Double): Double;
1227
begin
1228
  Result := Sqr(X_);
1229
end;
1230

1231
// ------------------------------------------------------------------------------
1232

1233
function Pow3(const X_: Int32u): Int32u;
1234
begin
1235
  Result := X_ * Pow2(X_);
1236
end;
1237

1238
function Pow3(const X_: Int32s): Int32s;
1239
begin
1240
  Result := X_ * Pow2(X_);
1241
end;
1242

1243
function Pow3(const X_: Int64u): Int64u;
1244
begin
1245
  Result := X_ * Pow2(X_);
1246
end;
1247

1248
function Pow3(const X_: Int64s): Int64s;
1249
begin
1250
  Result := X_ * Pow2(X_);
1251
end;
1252

1253
function Pow3(const X_: Single): Single;
1254
begin
1255
  Result := X_ * Pow2(X_);
1256
end;
1257

1258
function Pow3(const X_: Double): Double;
1259
begin
1260
  Result := X_ * Pow2(X_);
1261
end;
1262

1263
// ------------------------------------------------------------------------------
1264

1265
function Pow4(const X_: Int32u): Int32u;
1266
begin
1267
  Result := Pow2(Pow2(X_));
1268
end;
1269

1270
function Pow4(const X_: Int32s): Int32s;
1271
begin
1272
  Result := Pow2(Pow2(X_));
1273
end;
1274

1275
function Pow4(const X_: Int64u): Int64u;
1276
begin
1277
  Result := Pow2(Pow2(X_));
1278
end;
1279

1280
function Pow4(const X_: Int64s): Int64s;
1281
begin
1282
  Result := Pow2(Pow2(X_));
1283
end;
1284

1285
function Pow4(const X_: Single): Single;
1286
begin
1287
  Result := Pow2(Pow2(X_));
1288
end;
1289

1290
function Pow4(const X_: Double): Double;
1291
begin
1292
  Result := Pow2(Pow2(X_));
1293
end;
1294

1295
// ------------------------------------------------------------------------------
1296

1297
function Pow5(const X_: Int32u): Int32u;
1298
begin
1299
  Result := Pow4(X_) * X_;
1300
end;
1301

1302
function Pow5(const X_: Int32s): Int32s;
1303
begin
1304
  Result := Pow4(X_) * X_;
1305
end;
1306

1307
function Pow5(const X_: Int64u): Int64u;
1308
begin
1309
  Result := Pow4(X_) * X_;
1310
end;
1311

1312
function Pow5(const X_: Int64s): Int64s;
1313
begin
1314
  Result := Pow4(X_) * X_;
1315
end;
1316

1317
function Pow5(const X_: Single): Single;
1318
begin
1319
  Result := Pow4(X_) * X_;
1320
end;
1321

1322
function Pow5(const X_: Double): Double;
1323
begin
1324
  Result := Pow4(X_) * X_;
1325
end;
1326

1327
// ------------------------------------------------------------------------------
1328

1329
function Roo2(const X_: Single): Single;
1330
begin
1331
  Result := Sqrt(X_);
1332
end;
1333

1334
function Roo2(const X_: Double): Double;
1335
begin
1336
  Result := Sqrt(X_);
1337
end;
1338

1339
// ------------------------------------------------------------------------------
1340

1341
function Roo3(const X_: Single): Single;
1342
begin
1343
  Result := Sign(X_) * Power(Abs(X_), 1 / 3);
1344
end;
1345

1346
function Roo3(const X_: Double): Double;
1347
begin
1348
  Result := Sign(X_) * Power(Abs(X_), 1 / 3);
1349
end;
1350

1351
// ------------------------------------------------------------------------------
1352

1353
function Clamp(const X_, Min_, Max_: Integer): Integer;
1354
begin
1355
  if X_ < Min_ then
1356
    Result := Min_
1357
  else if Max_ < X_ then
1358
    Result := Max_
1359
  else
1360
    Result := X_;
1361
end;
1362

1363
function Clamp(const X_, Min_, Max_: Single): Single;
1364
begin
1365
  if X_ < Min_ then
1366
    Result := Min_
1367
  else if Max_ < X_ then
1368
    Result := Max_
1369
  else
1370
    Result := X_;
1371
end;
1372

1373
function Clamp(const X_, Min_, Max_: Double): Double;
1374
begin
1375
  if X_ < Min_ then
1376
    Result := Min_
1377
  else if Max_ < X_ then
1378
    Result := Max_
1379
  else
1380
    Result := X_;
1381
end;
1382

1383
// ------------------------------------------------------------------------------
1384

1385
function ClampMin(const X_, Min_: Integer): Integer;
1386
begin
1387
  if X_ < Min_ then
1388
    Result := Min_
1389
  else
1390
    Result := X_;
1391
end;
1392

1393
function ClampMin(const X_, Min_: Single): Single;
1394
begin
1395
  if X_ < Min_ then
1396
    Result := Min_
1397
  else
1398
    Result := X_;
1399
end;
1400

1401
function ClampMin(const X_, Min_: Double): Double;
1402
begin
1403
  if X_ < Min_ then
1404
    Result := Min_
1405
  else
1406
    Result := X_;
1407
end;
1408

1409
// ------------------------------------------------------------------------------
1410

1411
function ClampMax(const X_, Max_: Integer): Integer;
1412
begin
1413
  if Max_ < X_ then
1414
    Result := Max_
1415
  else
1416
    Result := X_;
1417
end;
1418

1419
function ClampMax(const X_, Max_: Single): Single;
1420
begin
1421
  if Max_ < X_ then
1422
    Result := Max_
1423
  else
1424
    Result := X_;
1425
end;
1426

1427
function ClampMax(const X_, Max_: Double): Double;
1428
begin
1429
  if Max_ < X_ then
1430
    Result := Max_
1431
  else
1432
    Result := X_;
1433
end;
1434

1435
// ------------------------------------------------------------------------------
1436

1437
function Min(const A_, B_, C_: Integer): Integer;
1438
begin
1439
  if A_ <= B_ then
1440
  begin
1441
    if A_ <= C_ then
1442
      Result := A_
1443
    else
1444
      Result := C_;
1445
  end
1446
  else
1447
  begin
1448
    if B_ <= C_ then
1449
      Result := B_
1450
    else
1451
      Result := C_;
1452
  end;
1453
end;
1454

1455
function Min(const A_, B_, C_: Single): Single;
1456
begin
1457
  if A_ <= B_ then
1458
  begin
1459
    if A_ <= C_ then
1460
      Result := A_
1461
    else
1462
      Result := C_;
1463
  end
1464
  else
1465
  begin
1466
    if B_ <= C_ then
1467
      Result := B_
1468
    else
1469
      Result := C_;
1470
  end;
1471
end;
1472

1473
function Min(const A_, B_, C_: Double): Double;
1474
begin
1475
  if A_ <= B_ then
1476
  begin
1477
    if A_ <= C_ then
1478
      Result := A_
1479
    else
1480
      Result := C_;
1481
  end
1482
  else
1483
  begin
1484
    if B_ <= C_ then
1485
      Result := B_
1486
    else
1487
      Result := C_;
1488
  end;
1489
end;
1490

1491
// ------------------------------------------------------------------------------
1492

1493
function Max(const A_, B_, C_: Integer): Integer;
1494
begin
1495
  if A_ >= B_ then
1496
  begin
1497
    if A_ >= C_ then
1498
      Result := A_
1499
    else
1500
      Result := C_;
1501
  end
1502
  else
1503
  begin
1504

1505
    if B_ >= C_ then
1506
      Result := B_
1507
    else
1508
      Result := C_;
1509
  end;
1510
end;
1511

1512
function Max(const A_, B_, C_: Single): Single;
1513
begin
1514
  if A_ >= B_ then
1515
  begin
1516
    if A_ >= C_ then
1517
      Result := A_
1518
    else
1519
      Result := C_;
1520
  end
1521
  else
1522
  begin
1523

1524
    if B_ >= C_ then
1525
      Result := B_
1526
    else
1527
      Result := C_;
1528
  end;
1529
end;
1530

1531
function Max(const A_, B_, C_: Double): Double;
1532
begin
1533
  if A_ >= B_ then
1534
  begin
1535
    if A_ >= C_ then
1536
      Result := A_
1537
    else
1538
      Result := C_;
1539
  end
1540
  else
1541
  begin
1542

1543
    if B_ >= C_ then
1544
      Result := B_
1545
    else
1546
      Result := C_;
1547
  end;
1548
end;
1549

1550
// ------------------------------------------------------------------------------
1551

1552
function MinI(const A_, B_: Integer): Byte;
1553
begin
1554
  if A_ <= B_ then
1555
    Result := 1
1556
  else
1557
    Result := 2;
1558
end;
1559

1560
function MinI(const A_, B_: Single): Byte;
1561
begin
1562
  if A_ <= B_ then
1563
    Result := 1
1564
  else
1565
    Result := 2;
1566
end;
1567

1568
function MinI(const A_, B_: Double): Byte;
1569
begin
1570
  if A_ <= B_ then
1571
    Result := 1
1572
  else
1573
    Result := 2;
1574
end;
1575

1576
// ------------------------------------------------------------------------------
1577

1578
function MaxI(const A_, B_: Integer): Byte;
1579
begin
1580
  if A_ <= B_ then
1581
    Result := 2
1582
  else
1583
    Result := 1;
1584
end;
1585

1586
function MaxI(const A_, B_: Single): Byte;
1587
begin
1588
  if A_ <= B_ then
1589
    Result := 2
1590
  else
1591
    Result := 1;
1592
end;
1593

1594
function MaxI(const A_, B_: Double): Byte;
1595
begin
1596
  if A_ <= B_ then
1597
    Result := 2
1598
  else
1599
    Result := 1;
1600
end;
1601

1602
// ------------------------------------------------------------------------------
1603

1604
function MinI(const A_, B_, C_: Integer): Integer;
1605
begin
1606
  if A_ <= B_ then
1607
  begin
1608
    if A_ <= C_ then
1609
      Result := 1
1610
    else
1611
      Result := 3;
1612
  end
1613
  else
1614
  begin
1615
    if B_ <= C_ then
1616
      Result := 2
1617
    else
1618
      Result := 3;
1619
  end;
1620
end;
1621

1622
function MinI(const A_, B_, C_: Single): Integer;
1623
begin
1624
  if A_ <= B_ then
1625
  begin
1626
    if A_ <= C_ then
1627
      Result := 1
1628
    else
1629
      Result := 3;
1630
  end
1631
  else
1632
  begin
1633
    if B_ <= C_ then
1634
      Result := 2
1635
    else
1636
      Result := 3;
1637
  end;
1638
end;
1639

1640
function MinI(const A_, B_, C_: Double): Integer;
1641
begin
1642
  if A_ <= B_ then
1643
  begin
1644
    if A_ <= C_ then
1645
      Result := 1
1646
    else
1647
      Result := 3;
1648
  end
1649
  else
1650
  begin
1651
    if B_ <= C_ then
1652
      Result := 2
1653
    else
1654
      Result := 3;
1655
  end;
1656
end;
1657

1658
// ------------------------------------------------------------------------------
1659

1660
function MaxI(const A_, B_, C_: Integer): Integer;
1661
begin
1662
  if A_ >= B_ then
1663
  begin
1664
    if A_ >= C_ then
1665
      Result := 1
1666
    else
1667
      Result := 3;
1668
  end
1669
  else
1670
  begin
1671
    if B_ >= C_ then
1672
      Result := 2
1673
    else
1674
      Result := 3;
1675
  end;
1676
end;
1677

1678
function MaxI(const A_, B_, C_: Single): Integer;
1679
begin
1680
  if A_ >= B_ then
1681
  begin
1682
    if A_ >= C_ then
1683
      Result := 1
1684
    else
1685
      Result := 3;
1686
  end
1687
  else
1688
  begin
1689
    if B_ >= C_ then
1690
      Result := 2
1691
    else
1692
      Result := 3;
1693
  end;
1694
end;
1695

1696
function MaxI(const A_, B_, C_: Double): Integer;
1697
begin
1698
  if A_ >= B_ then
1699
  begin
1700
    if A_ >= C_ then
1701
      Result := 1
1702
    else
1703
      Result := 3;
1704
  end
1705
  else
1706
  begin
1707
    if B_ >= C_ then
1708
      Result := 2
1709
    else
1710
      Result := 3;
1711
  end;
1712
end;
1713

1714
// ------------------------------------------------------------------------------
1715

1716
function MinI(const Vs_: array of Integer): Integer;
1717
var
1718
  I, V0, V1: Integer;
1719
begin
1720
  Result := 0;
1721
  V0 := Vs_[0];
1722

1723
  for I := 1 to High(Vs_) do
1724
  begin
1725
    V1 := Vs_[I];
1726

1727
    if V1 < V0 then
1728
    begin
1729
      Result := I;
1730
      V0 := V1;
1731
    end
1732
  end
1733
end;
1734

1735
function MinI(const Vs_: array of Single): Integer;
1736
var
1737
  I: Integer;
1738
  V0, V1: Single;
1739
begin
1740
  Result := 0;
1741
  V0 := Vs_[0];
1742

1743
  for I := 1 to High(Vs_) do
1744
  begin
1745
    V1 := Vs_[I];
1746

1747
    if V1 < V0 then
1748
    begin
1749
      Result := I;
1750
      V0 := V1;
1751
    end
1752
  end
1753
end;
1754

1755
function MinI(const Vs_: array of Double): Integer;
1756
var
1757
  I: Integer;
1758
  V0, V1: Double;
1759
begin
1760
  Result := 0;
1761
  V0 := Vs_[0];
1762

1763
  for I := 1 to High(Vs_) do
1764
  begin
1765
    V1 := Vs_[I];
1766

1767
    if V1 < V0 then
1768
    begin
1769
      Result := I;
1770
      V0 := V1;
1771
    end
1772
  end
1773
end;
1774

1775
// ------------------------------------------------------------------------------
1776

1777
function MaxI(const Vs_: array of Integer): Integer;
1778
var
1779
  I, V0, V1: Integer;
1780
begin
1781
  Result := 0;
1782
  V0 := Vs_[0];
1783

1784
  for I := 1 to High(Vs_) do
1785
  begin
1786
    V1 := Vs_[I];
1787

1788
    if V1 > V0 then
1789
    begin
1790
      Result := I;
1791
      V0 := V1;
1792
    end
1793
  end
1794
end;
1795

1796
function MaxI(const Vs_: array of Single): Integer;
1797
var
1798
  I: Integer;
1799
  V0, V1: Single;
1800
begin
1801
  Result := 0;
1802
  V0 := Vs_[0];
1803

1804
  for I := 1 to High(Vs_) do
1805
  begin
1806
    V1 := Vs_[I];
1807

1808
    if V1 > V0 then
1809
    begin
1810
      Result := I;
1811
      V0 := V1;
1812
    end
1813
  end
1814
end;
1815

1816
function MaxI(const Vs_: array of Double): Integer;
1817
var
1818
  I: Integer;
1819
  V0, V1: Double;
1820
begin
1821
  Result := 0;
1822
  V0 := Vs_[0];
1823

1824
  for I := 1 to High(Vs_) do
1825
  begin
1826
    V1 := Vs_[I];
1827

1828
    if V1 > V0 then
1829
    begin
1830
      Result := I;
1831
      V0 := V1;
1832
    end
1833
  end
1834
end;
1835

1836
// ------------------------------------------------------------------------------
1837

1838
function PoMod(const X_, Range_: Integer): Integer;
1839
begin
1840
  Result := X_ - (X_ div Range_) * Range_;
1841

1842
  if Result < 0 then
1843
    Inc(Result, Range_);
1844
end;
1845

1846
function PoMod(const X_, Range_: Int64): Int64;
1847
begin
1848
  Result := X_ - (X_ div Range_) * Range_;
1849

1850
  if Result < 0 then
1851
    Inc(Result, Range_);
1852
end;
1853

1854
// ------------------------------------------------------------------------------
1855

1856
{$IF Defined( MACOS ) or Defined( MSWINDOWS ) }
1857

1858
function RevBytes(const Value_: Word): Word;
1859
asm
1860
  {$IFDEF CPUX64 }
1861
  mov rax, rcx
1862
  {$ENDIF}
1863
  xchg al, ah
1864
end;
1865

1866
function RevBytes(const Value_: Smallint): Smallint;
1867
asm
1868
  {$IFDEF CPUX64 }
1869
  mov rax, rcx
1870
  {$ENDIF}
1871
  xchg al, ah
1872
end;
1873

1874
// ------------------------------------------------------------------------------
1875

1876
function RevBytes(const Value_: Cardinal): Cardinal;
1877
asm
1878
  {$IFDEF CPUX64 }
1879
  mov rax, rcx
1880
  {$ENDIF}
1881
  bswap eax
1882
end;
1883

1884
function RevBytes(const Value_: Integer): Integer;
1885
asm
1886
  {$IFDEF CPUX64 }
1887
  mov rax, rcx
1888
  {$ENDIF}
1889
  bswap eax
1890
end;
1891

1892
function RevBytes(const Value_: Single): Single;
1893
var
1894
  V: Cardinal;
1895
begin
1896
  V := RevBytes(PCardinal(@Value_)^);
1897

1898
  Result := PSingle(@V)^;
1899
end;
1900

1901
// ------------------------------------------------------------------------------
1902

1903
function RevBytes(const Value_: UInt64): UInt64;
1904
asm
1905
  {$IF Defined( CPUX86 ) }
1906
  mov   edx, [ ebp + $08 ]
1907
  mov   eax, [ ebp + $0c ]
1908
  bswap edx
1909
  bswap eax
1910
  {$ELSEIF Defined( CPUX64 ) }
1911
  mov   rax, rcx
1912
  bswap rax
1913
  {$ELSE}
1914
  {$MESSAGE Fatal 'RevByte has not been implemented for this architecture.' }
1915
  {$ENDIF}
1916
end;
1917

1918
function RevBytes(const Value_: Int64): Int64;
1919
asm
1920
  {$IF Defined( CPUX86 ) }
1921
  mov   edx, [ ebp + $08 ]
1922
  mov   eax, [ ebp + $0c ]
1923
  bswap edx
1924
  bswap eax
1925
  {$ELSEIF Defined( CPUX64 ) }
1926
  mov   rax, rcx
1927
  bswap rax
1928
  {$ELSE}
1929
  {$MESSAGE Fatal 'RevByte has not been implemented for this architecture.' }
1930
  {$ENDIF}
1931
end;
1932

1933
function RevBytes(const Value_: Double): Double;
1934
var
1935
  V: UInt64;
1936
begin
1937
  V := RevBytes(PUInt64(@Value_)^);
1938

1939
  Result := PDouble(@V)^;
1940
end;
1941

1942
{$ENDIF}
1943

1944
// ------------------------------------------------------------------------------
1945

1946
{$IF Defined( MACOS ) or Defined( MSWINDOWS ) }
1947

1948
function CharsToStr(const Cs_: TArray<AnsiChar>): AnsiString;
1949
var
1950
  I: Integer;
1951
begin
1952
  Result := '';
1953

1954
  for I := 0 to High(Cs_) do
1955
  begin
1956
    if Cs_[I] = Char(nil) then
1957
      Result := Result + CRLF
1958
    else
1959
      Result := Result + Cs_[I];
1960
  end;
1961
end;
1962

1963
{$ENDIF}
1964

1965
// ------------------------------------------------------------------------------
1966

1967
function FileToBytes(const Filename_: string): TBytes;
1968
begin
1969
  with TMemoryStream.Create do
1970
  begin
1971
    try
1972
      LoadFromFile(Filename_);
1973

1974
      SetLength(Result, Size);
1975

1976
      Read(Result, Size);
1977

1978
    finally
1979
      Free;
1980
    end;
1981
  end;
1982
end;
1983

1984
// ------------------------------------------------------------------------------
1985

1986
function Comb(N_, K_: Cardinal): UInt64;
1987
var
1988
  I: Cardinal;
1989
begin
1990
  if N_ < 2 * K_ then
1991
    K_ := N_ - K_;
1992

1993
  Result := 1;
1994

1995
  for I := 1 to K_ do
1996
  begin
1997
    // Result := Result * ( N_ - K_ + I ) div I;
1998

1999
    Result := Result * N_ div I;
2000
    Dec(N_);
2001
  end;
2002
end;
2003

2004
// ------------------------------------------------------------------------------
2005

2006
function BinPow(const N_: Integer): Integer;
2007
begin
2008
  Result := 1 shl N_;
2009
end;
2010

2011
function BinPow(const N_: Cardinal): Cardinal;
2012
begin
2013
  Result := 1 shl N_;
2014
end;
2015

2016
function BinPow(const N_: Int64): Int64;
2017
begin
2018
  Result := 1 shl N_;
2019
end;
2020

2021
function BinPow(const N_: UInt64): UInt64;
2022
begin
2023
  Result := 1 shl N_;
2024
end;
2025

2026
// ------------------------------------------------------------------------------
2027

2028
function UIntToStr(const Value_: UInt32; const N_: Integer;
2029
const C_: Char = '0'): String;
2030
begin
2031
  Result := UIntToStr(Value_);
2032

2033
  Result := Result.Insert(0, StringOfChar(C_, N_ - Length(Result)));
2034
end;
2035

2036
function UIntToStr(const Value_: UInt64; const N_: Integer;
2037
const C_: Char = '0'): String;
2038
begin
2039
  Result := UIntToStr(Value_);
2040

2041
  Result := Result.Insert(0, StringOfChar(C_, N_ - Length(Result)));
2042
end;
2043

2044
// ------------------------------------------------------------------------------
2045

2046
function IntToStr(const Value_: Integer; const N_: Integer;
2047
const C_: Char = '0'): String;
2048
var
2049
  I: Integer;
2050
begin
2051
  Result := IntToStr(Value_);
2052

2053
  if Value_ < 0 then
2054
    I := 1
2055
  else
2056
    I := 0;
2057

2058
  Result := Result.Insert(I, StringOfChar(C_, N_ + I - Length(Result)));
2059
end;
2060

2061
function IntToStr(const Value_: Int64; const N_: Integer;
2062
const C_: Char = '0'): String;
2063
var
2064
  I: Integer;
2065
begin
2066
  Result := IntToStr(Value_);
2067

2068
  if Value_ < 0 then
2069
    I := 1
2070
  else
2071
    I := 0;
2072

2073
  Result := Result.Insert(I, StringOfChar(C_, N_ + I - Length(Result)));
2074
end;
2075

2076
function IntToStrP(const Value_: Integer; const N_: Integer;
2077
const C_: Char = '0'): String;
2078
begin
2079
  Result := IntToStr(Value_, N_, C_);
2080

2081
  if Value_ > 0 then
2082
    Result := '+' + Result;
2083
end;
2084

2085
function IntToStrP(const Value_: Int64; const N_: Integer;
2086
const C_: Char = '0'): String;
2087
begin
2088
  Result := IntToStr(Value_, N_, C_);
2089

2090
  if Value_ > 0 then
2091
    Result := '+' + Result;
2092
end;
2093

2094
// ------------------------------------------------------------------------------
2095

2096
procedure _SplitME(const Value_: String; out Man_, Exp_: String);
2097
var
2098
  I: Integer;
2099
begin
2100
  I := Value_.IndexOf('E');
2101

2102
  Man_ := Value_.Substring(0, I).TrimRight(['0']);
2103
  Exp_ := Value_.Substring(I + 1);
2104
end;
2105

2106
function FloatToStr(const Value_: Single; const N_: Integer;
2107
out Man_, Exp_: String): Boolean;
2108
begin
2109
  Result := not(Value_.IsNan or Value_.IsInfinity);
2110

2111
  if Result then
2112
    _SplitME(FloatToStrF(Value_, TFloatFormat.ffExponent, N_, 0), Man_, Exp_);
2113
end;
2114

2115
function FloatToStr(const Value_: Double; const N_: Integer;
2116
out Man_, Exp_: String): Boolean;
2117
begin
2118
  Result := not(Value_.IsNan or Value_.IsInfinity);
2119

2120
  if Result then
2121
    _SplitME(FloatToStrF(Value_, TFloatFormat.ffExponent, N_, 0), Man_, Exp_);
2122
end;
2123

2124
// ------------------------------------------------------------------------------
2125

2126
function _DecN(const Man_, Exp_: String): Integer;
2127
var
2128
  M, E: Integer;
2129
begin
2130
  if Man_.Chars[0] = '-' then
2131
    M := Man_.Length - 3
2132
  else
2133
    M := Man_.Length - 2;
2134

2135
  E := Exp_.ToInteger;
2136

2137
  Result := M - E;
2138

2139
  if Result <= 0 then
2140
    Result := -E - 1;
2141
end;
2142

2143
function FloatToStr(const Value_: Single; const N_: Integer;
2144
out Man_, Exp_: String; out DecN_: Integer): Boolean;
2145
begin
2146
  Result := FloatToStr(Value_, N_, Man_, Exp_);
2147

2148
  if Result then
2149
    DecN_ := _DecN(Man_, Exp_);
2150
end;
2151

2152
function FloatToStr(const Value_: Double; const N_: Integer;
2153
out Man_, Exp_: String; out DecN_: Integer): Boolean;
2154
begin
2155
  Result := FloatToStr(Value_, N_, Man_, Exp_);
2156

2157
  if Result then
2158
    DecN_ := _DecN(Man_, Exp_);
2159
end;
2160

2161
// ------------------------------------------------------------------------------
2162

2163
function _TestFloatToStr_Single(const Value_: String;
2164
const N_: Integer): String;
2165
var
2166
  Zs, S0, S: String;
2167
  I: Integer;
2168
begin
2169
  Zs := StringOfChar('0', N_ + 1);
2170

2171
  S0 := Zs + Value_ + Zs;
2172

2173
  for I := 1 to Length(S0) - 1 do
2174
  begin
2175
    S := S0;
2176
    S.Insert(I, '.');
2177

2178
    Result := Result + S + '	' + FloatToStr(S.ToSingle, N_) + CRLF;
2179
  end;
2180
end;
2181

2182
function _TestFloatToStr_Double(const Value_: String;
2183
const N_: Integer): String;
2184
var
2185
  Zs, S0, S: String;
2186
  I: Integer;
2187
begin
2188
  Zs := StringOfChar('0', N_ + 1);
2189

2190
  S0 := Zs + Value_ + Zs;
2191

2192
  for I := 1 to Length(S0) - 1 do
2193
  begin
2194
    S := S0;
2195
    S.Insert(I, '.');
2196

2197
    Result := Result + S + '	' + FloatToStr(S.ToDouble, N_) + CRLF;
2198
  end;
2199
end;
2200

2201
// ------------------------------------------------------------------------------
2202

2203
function FloatToStr(const Value_: Single; const N_: Integer): String;
2204
var
2205
  M, E: String;
2206
  D: Integer;
2207
begin
2208
  if FloatToStr(Value_, N_, M, E, D) then
2209
  begin
2210
    if Abs(D) <= N_ then
2211
      Result := FloatToStrF(Value_, TFloatFormat.ffFixed, N_, ClampMin(D, 0))
2212
    else
2213
      Result := M + 'e' + E;
2214
  end
2215
  else if Value_.IsNan then
2216
    Result := 'NAN'
2217
  else if Value_.IsNegativeInfinity then
2218
    Result := '-INF'
2219
  else if Value_.IsPositiveInfinity then
2220
    Result := '+INF';
2221
end;
2222

2223
function FloatToStr(const Value_: Double; const N_: Integer): String;
2224
var
2225
  M, E: String;
2226
  D: Integer;
2227
begin
2228
  if FloatToStr(Value_, N_, M, E, D) then
2229
  begin
2230
    if Abs(D) <= N_ then
2231
      Result := FloatToStrF(Value_, TFloatFormat.ffFixed, N_, ClampMin(D, 0))
2232
    else
2233
      Result := M + 'e' + E;
2234
  end
2235
  else if Value_.IsNan then
2236
    Result := 'NAN'
2237
  else if Value_.IsNegativeInfinity then
2238
    Result := '-INF'
2239
  else if Value_.IsPositiveInfinity then
2240
    Result := '+INF';
2241
end;
2242

2243
function FloatToStrP(const Value_: Single; const N_: Integer): String;
2244
begin
2245
  Result := FloatToStr(Value_, N_);
2246

2247
  if Value_ > 0 then
2248
    Result := '+' + Result;
2249
end;
2250

2251
function FloatToStrP(const Value_: Double; const N_: Integer): String;
2252
begin
2253
  Result := FloatToStr(Value_, N_);
2254

2255
  if Value_ > 0 then
2256
    Result := '+' + Result;
2257
end;
2258

2259
// ------------------------------------------------------------------------------
2260

2261
function Floor(const X_, D_: UInt32): UInt32;
2262
begin
2263
  Result := X_ div D_ * D_;
2264
end;
2265

2266
function Floor(const X_, D_: UInt64): UInt64;
2267
begin
2268
  Result := X_ div D_ * D_;
2269
end;
2270

2271
// ------------------------------------------------------------------------------
2272

2273
function Ceil(const X_, D_: UInt32): UInt32;
2274
begin
2275
  Result := Floor(X_ + D_ - 1, D_);
2276
end;
2277

2278
function Ceil(const X_, D_: UInt64): UInt64;
2279
begin
2280
  Result := Floor(X_ + D_ - 1, D_);
2281
end;
2282

2283
// ------------------------------------------------------------------------------
2284

2285
function Floor2N(const X_, D_: UInt32): UInt32;
2286
begin
2287
  Result := X_ and not(D_ - 1);
2288
end;
2289

2290
function Floor2N(const X_, D_: UInt64): UInt64;
2291
begin
2292
  Result := X_ and not(D_ - 1);
2293
end;
2294

2295
// ------------------------------------------------------------------------------
2296

2297
function Ceil2N(const X_, D_: UInt32): UInt32;
2298
begin
2299
  Result := Floor(X_ + D_ - 1, D_);
2300
end;
2301

2302
function Ceil2N(const X_, D_: UInt64): UInt64;
2303
begin
2304
  Result := Floor(X_ + D_ - 1, D_);
2305
end;
2306

2307
// ------------------------------------------------------------------------------
2308

2309
procedure GetMemAligned(out P_: Pointer; const Size_, Align2N_: UInt32);
2310
const
2311
  H: UInt32 = SizeOf(Pointer);
2312
var
2313
  P0: Pointer;
2314
  PP: PPointer;
2315
  I0, I1: NativeUInt;
2316
begin
2317
  // ┠───Ａ───╂────────Ｓ────────┤
2318
  // ┃              ┃                                  │
2319
  // ┃  │I0        ┃              ┃              ┃  │      │  ┃
2320
  // ╂─├─┬─┬─┣━┯━┯━┯━╋━┯━┯━┯━╋━┥─┬─┤─╂
2321
  // ┃  │×│×│I0┃◯│◯│◯│◯┃◯│◯│◯│◯┃◯│×│×│  ┃
2322
  // ╂─├─┴─┴─┣━┷━┷━┷━╋━┷━┷━┷━╋━┥─┴─┤─╂
2323
  // ┃  │  │      ┃I1    │      ┃              ┃          │  ┃
2324
  // │  │              │                                  │
2325
  // ├Ｈ┼───Ａ───┼────────Ｓ────────┤
2326

2327
  GetMem(P0, H + Align2N_ + Size_);
2328

2329
  I0 := NativeUInt(P0);
2330

2331
  I1 := Ceil2N(H + I0, Align2N_);
2332

2333
  P_ := Pointer(I1);
2334

2335
  PP := P_;
2336
  Dec(PP);
2337
  PP^ := P0;
2338
end;
2339

2340
procedure FreeMemAligned(const P_: Pointer);
2341
var
2342
  PP: PPointer;
2343
begin
2344
  PP := P_;
2345
  Dec(PP);
2346
  FreeMem(PP^);
2347
end;
2348

2349
initialization // ------------------------------------------------------------
2350

2351
  _ThreadPool_ := TThreadPool.Create;
2352

2353
Randomize;
2354

2355
SetCurrentDir(ExtractFilePath(ParamStr(0)));
2356

2357
finalization
2358
  _ThreadPool_.Free;
2359

2360
end.
2361