ASKernelDefs.pas

File name
C:\Users\Andreas Rejbrand\Documents\Dev\AlgoSim\ASKernelDefs.pas
Date exported
Time exported
Formatting processor
TPascalFormattingProcessor
unit ASKernelDefs;

{ **************************************************************************** }
{ Rejbrand AlgoSim Kernel definitions                                          }
{ Copyright © 2018-2019 Andreas Rejbrand                                       }
{ https://english.rejbrand.se/                                                 }
{ **************************************************************************** }

{$WARN SYMBOL_PLATFORM OFF}
{$WARN DUPLICATE_CTOR_DTOR OFF}

interface

uses
  Windows, SysUtils, ExtCtrls, Generics.Defaults, Generics.Collections, Graphics,
  ASSounds;

type
  TTokenKind = (tkIntegerLiteral, tkFloatLiteral, tkStringLiteral, tkOperator,
    tkBracket, tkComma, tkIdentifier, tkImplicitNull);

  TOperator = (oUnaryPlus, oLooseUnaryPlus, oUnaryMinus, oLooseUnaryMinus, oPlus,
    oMinus, oAsterisk, oSolidus, oCircumflex, oCDot, oCRing, oSqrt, oCross,
    oExclamation, oQuestion, oPercent, oPermille, oDegrees, oPeriod, oBar, oAmp,
    oAt, oColon, oSemicolon, oLessThan, oLessEqual, oGreaterThan, oGreaterEqual,
    oEquals, oNotEquals, oApprox, oAnd, oOr, oXor, oNand, oNor, oNot, oUnion,
    oIntersection, oSetDifference, oSymDiff, oComplement, oIn, oNi, oNotIn,
    oNotNi, oSubset, oSubsetEq, oSubsetNEq, oSuperset, oSupersetEq, oSupersetNEq,
    oDivides, oNDivides, oParallel, oNParallel, oOrthogonal, oCircledPlus,
    oCircledTimes, oCircledDot, oImpliesRight, oImpliesLeft, oEquivalent, oTo,
    oMapsTo, oAssign, oTilde, oNumberSignPrefix, oNumberSignPostfix, oSection,
    oBackslash);

  TOpKind = (okPrefix, okPostfix, okInfix);

  TVersionData = record
    Major,
    Minor,
    Release,
    Build: Cardinal;
    function ToString: string;
  end;

const
  KernelVersion: TVersionData =
    (
      Major: 3;
      Minor: 0;
      Release: 0;
      Build: 0
    );

type
  EKernelException = class(Exception);
    EAlgosimObjectException = class(EKernelException);
      EArrayException = class(EAlgosimObjectException);
      EStructureException = class(EAlgosimObjectException);
      ESetException = class(EAlgosimObjectException);
    EAlgosimOSError = class(EKernelException);
    EExpressionException = class(EKernelException);
      ESyntaxException = class(EExpressionException);
      EParseException = class(EExpressionException);
      ERuntimeException = class(EExpressionException)
      strict private
        FSource: TList<TClass>;
      public
        constructor Create(const AReason: string; ASource: TList<TClass> = nil);
        destructor Destroy; override;
      property
        Source: TList<TClass> read FSource write FSource;
      end;
        EInvArgs = class(ERuntimeException);
        EUnknownIdentifier = class(ERuntimeException);
        EInvalidIdentName = class(ERuntimeException);
        EIllegalLValue = class(ERuntimeException);
        ETooDeepRecursion = class(ERuntimeException);
        EManualAbort = class(ERuntimeException);
    EVariableException = class(EKernelException);
      EVariableProtectionException = class(EVariableException);
    EPropStoreException = class(EKernelException);
    EBufferException = class(EKernelException);
    EObjStoreLocked = class(EKernelException);
    EClientRequestException = class(EKernelException);
      EClientVisualizationError = class(EClientRequestException);


  TIdentAttrib = (iaProtected, iaSystem);
  TIdentAttribs = set of TIdentAttrib;

const
  MAX_EXPR_DEPTH = 255;
  MAX_RECURSE_DEPTH = 1023;

resourcestring
  SUniverseNotASet = 'The universe is not a set, but an object of type %s.';
  SUnknownFileExt = 'Unknown file extension: "%s".';
  SEmptyBracket = 'Empty bracket at column %d.';
  SAdjValues = 'Adjacent values at column %d; a comma or operator was expected.';
  SNothingBeforeComma = 'Value missing before comma at column %d.';
  SNothingAfterComma = 'Value missing after comma at column %d.';
  SNoLeftOperand = 'Operand missing before operator %s at column %d.';
  SNoRightOperand = 'Operand missing after operator %s at column %d.';
  SInvalidNumLit = 'Invalid numeric literal "%s" starting at column %d.';
  SInvNumBase = 'Invalid number base %d in numeric literal "%s" starting at column %d.';
  SInvDigit = 'Invalid base-%d digit "%s" in numeric literal "%s" starting at column %d.';
  SUnterminatedStringLiteral = 'Unterminated string literal "%s" starting at column %d.';
  SNegativeBracketLevel = 'Negative bracket level starting at column %d.';
  SWrongBracket = 'Closing bracket %s at column %d doesn''t match the most recent opening bracket %s at column %d.';
  SOpenBracketAtEOE = 'There is at least one open bracket at the end of the expression. The following brackets are open: "%s".';
  SInternalError = 'Internal error.';
  SWrongArgCount = '%d argument(s) expected, but %d given.';
  STooFewArgs = 'At least %d argument(s) required.';
  SWrongArgCountUnspec = 'There is no version of this function that can take %d argument(s).';
  SInvalidArguments = 'Invalid function arguments.';
  SInvArgClass = 'An object of type %s was expected as argument %d, but an object of type %s was given.';
  SNotAllArgsAre = 'This function requires that all arguments are of type %s, but ' +
    'the given argument at index %d is of type %s.';
  SNoFunctionObj = 'No function object assigned to custom function.';
  SASymbolWasExpected = 'A symbol was expected as argument %d.';
  SUnknownIdentifier = 'Unknown identifier "%s".';
  SNoCopyConstructor = 'No copy constructor for object of type "%s".';
  SObjectTypeHasNoCopyConstrForType = 'Object type "%s" has no copy construc' +
    'tor for object type "%s".';
  SNoMaxLen = 'An object of type "%s" has no maximum display length setting.';
  SArrayElementIsNil = 'Element with index %d is nil.';
  SArrayCannotInsertNil = 'Cannot insert nil into array.';
  SIndexOutOfBounds = 'Index %d out of bounds.';
  SIndexOutOfBounds2D = 'Index (%d, %d) out of bounds.';
  SNewLengthMustBeNonNegative = 'New length must be non-negative.';
  SStructAlreadyHasMember = 'The structure already contains a member named "' +
    '%s".';
  SCannotAlterTypedStruct = 'Cannot alter member arrangement in a typed stru' +
    'cture.';
  SStructNameValCountMismatch = 'The number of member names must equal the n' +
    'umber of member values.';
  SStructNoMemberFound = 'There is no member named "%s".';
  SNamedStructNoMemberFound = 'Structure "%s" has no member named "%s".';
  SMemberValueIsNil = 'Member value is nil.';
  SStructInvalidMemberName = 'Invalid member name: "%s".';
  SStructTooManyMembers = 'Too many members (%d) for structure type %s with ' +
    '%d member(s).';
  SStructMemberNotInType = 'Structure type "%s" does not contain a member name' +
    'd "%s".';
  SUnsupportedSignalType = 'Unsupported signal object type %d.';
  SInvalidObjectTypeInUnion = 'Invalid object type(s) in union.';
  SInvalidObjectTypeInIntersection = 'Invalid object type(s) in intersection.';
  SStructureOfType = 'structure of type "%s"';
  SInvalidGroupSize = 'Invalid group size %d.';
  SCannotTransposeNonMatrix = 'Cannot transpose an array that is not shaped ' +
    'as a matrix.';
  SObjectNoContainer = 'Object type "%s" is not a suitable container.';
  SObjectNoPlanarValueContainer = 'Object type "%s" is not a container that ' +
    'can be indexed by two integers.';
  SCannotFindMaxNonSpecific = 'Cannot find the largest value in this list.';
  SCannotFindMaximumEmpty = 'Cannot find the largest value in an empty list.';
  SCannotFindMax = 'Cannot find the largest number in an object of type "%s".';
  SCannotFindMinNonSpecific = 'Cannot find the smallest value in this list.';
  SCannotFindMinimumEmpty = 'Cannot find the smallest value in an empty list.';
  SCannotFindMin = 'Cannot find the smallest number in an object of type "%s".';
  SCannotComputeSumOfUnknownType = 'Cannot compute sum of zero objects of un' +
    'known type.';
  SCannotComputeSumOfContainer = 'Cannot compute sum of this container.';
  SCannotComputeSumOfObject = 'Cannot compute sum of this object.';
  SCannotComputeProductOfUnknownType = 'Cannot compute product of zero objects ' +
    'of unknown type.';
  SCannotComputeProductOfContainer = 'Cannot compute product of this container.';
  SCannotComputeProductOfObject = 'Cannot compute product of this object.';
  SCannotExtractPart = 'Cannot extract part of an object of type "%s".';
  SCannotExtractPart2d = 'Cannot extract two-dimensional part of an object of type "%s".';
  SCannotCountElements = 'Cannot count elements in an object of type "%s".';
  SCannotAccumulateElements = 'Cannot accumulate elements in an object of type "%s".';
  SCannotFilter = 'Cannot filter elements in an object of type "%s".';
  SCannotApply = 'Cannot apply function to elements in an object of type "%s".';
  SCannotReplace = 'Cannot replace elements in an object of type "%s".';
  SCannotRemove = 'Cannot remove elements from an object of type "%s".';
  SUnsupportedSubscriptOp = 'Unsupported subscript operation.';
  SCannotComputeUnaryMinus = 'Cannot compute unary minus of an object of typ' +
    'e "%s".';
  SCannotComputeImgPart = 'Cannot compute imaginary part of an object of typ' +
    'e "%s".';
  SCannotComputeRePart = 'Cannot compute real part of an object of type "%s".';
  SCannotDetermineSign = 'Cannot determine the sign of an object of type "%s".';
  SCannotComputeAbs = 'Cannot compute absolute value or modulus of an object ' +
    'of type "%s".';
  SCannotSquare = 'Cannot compute square of an object of type "%s".';
  SCannotComputeNorm = 'Cannot compute %s of an object of type "%s".';
  SCannotNormSquare = 'Cannot compute norm square of an object of type "%s".';
  SCannotInvert = 'Cannot invert an object of type "%s".';
  SCannotTranspose = 'Cannot transpose an object of type "%s".';
  SCannotConjTranspose = 'Cannot conjugate transpose an object of type "%s".';
  SCannotScale = 'Cannot scale an object of type "%s".';
  SCannotComputeAvg = 'Cannot compute mean of an object of type "%s".';
  SCannotComputeAvgNonSpecific = 'Cannot compute mean of this object.';
  SCannotComputeAvgEmptyList = 'Cannot compute the mean of an empty list.';
  SUnknownNormType = 'Unknown norm type "%s".';
  SInvalidSDDKind = 'Invalid SDD kind.';
  SPredicateDidntReturnBool = 'The predicate was expected to return a boolea' +
    'n, but an object of type %s was returned.';
  SComparerDidntReturnReal = 'The comparer was expected to return a real number, ' +
    'but an object of type %s was returned.';
  SCharApply = 'Character application function must return a single character.';
  SStringApply = 'String application function must return a string.';
  SRealNumberApply = 'Real number application function must return a real ' +
    'number.';
  SComplexNumberApply = 'Complex number application function must return a complex ' +
    'number.';
  SColorApply = 'Colour application function must return a colour.';
  SConvComplexReal = 'Complex number %s cannot be converted to a real number.';
  SConvStrRealNum = 'Cannot convert string "%s" to a real number.';
  SConvStrComplexNum = 'Cannot convert string "%s" to a complex number.';
  SConvContNumber = 'A container with more than a single value cannot be con' +
    'verted to a number.';
  SConvEmptyContNumber = 'An empty container cannot be converted to a number.';
  SConvObjRealNum = 'An object of type %s cannot be converted to a real number.';
  SConvObjComplexNum = 'An object of type %s cannot be converted to a complex ' +
    'number.';
  SComplexVectToReal = 'Complex vector cannot be converted to real vector be' +
    'cause it contains a non-real component %s.';
  SComplexMatToRealVect = 'Complex matrix cannot be converted to real vector be' +
    'cause it contains a non-real component %s.';
  SConvRealVect = 'An object of type "%s" cannot be converted to a real vector.';
  SConvComplexVect = 'An object of type "%s" cannot be converted to a complex v' +
    'ector.';
  SConvRealMat = 'An object of type "%s" cannot be converted to a real matrix.';
  SComplexVectToRealMatrix = 'Complex vector cannot be converted to real matrix be' +
    'cause it contains a non-real component %s.';
  SComplexMatToReal = 'Complex matrix cannot be converted to real matrix be' +
    'cause it contains a non-real component %s.';
  SConvComplexMat = 'An object of type "%s" cannot be converted to a complex matrix.';
  SConvChar = 'An object of type "%s" cannot be converted to a character.';
  SConvStrCharLen = 'A string of length %d cannot be converted to a character.';
  SConvStrBool = 'String "%s" cannot be converted to a boolean.';
  SConvColor = 'An object of type "%s" cannot be converted to a colour.';
  SConvNonIntColor = 'A number which isn''t a 32-bit integer cannot be converted to ' +
    'a colour.';
  SVectDim = 'A vector must have dimension at least one.';
  SMatDim = 'A matrix must have size at least 1×1.';
  SVarProtectionError = 'Cannot modify or delete protected variable "%s".';
  SNoPropInStore = 'There is no property named "%s" in store "%s".';
  SNoSubstoreInStore = 'There is no substore named "%s" in store "%s".';
  SObjectNotAStructure = 'Object "%s" is not a structure.';
  SUnassignedLValueData = 'Unassigned lvalue data.';
  SEmptyLValueData = 'Empty lvalue data.';
  SInvalidLValueDataRoot = 'Invalid lvalue data root.';
  SSetStringSubscriptNoChar = 'A character was expected, but an object of type "%s" given, when ' +
    'setting a character in a string.';
  SSetRVectSubscriptNoRNum = 'A real number was expected, but an object of type "%s" given, when ' +
    'setting a component in a real vector.';
  SSetCVectSubscriptNoNum = 'A real or complex number was expected, but an object of type "%s" given, when ' +
    'setting a component in a complex vector.';
  SSetRMatSubscriptNoRNum = 'A real number was expected, but an object of type "%s" given, when ' +
    'setting an entry in a real matrix.';
  SSetCMatSubscriptNoNum = 'A real or complex number was expected, but an object of type "%s" given, when ' +
    'setting an entry in a complex matrix.';
  SSetPixmapSubscriptNoColor = 'A colour was expected, but an object of type "%s" given, when setting a ' +
    'pixel in a pixmap.';
  SSetTableSubscriptNoString = 'A string was expected, but an object of type "%s" given, when setting a ' +
    'cell in a table.';
  SSetBinarySubscriptNoByte = 'A byte was expected, but an object of type "%s" given, when setting a ' +
    'byte in stream of bytes.';
  SInvalidIdentName = 'Invalid identifier name "%s".';
  SCannotRotate = 'An object of type "%s" cannot be rotated.';
  SCannotSort = 'An object of type "%s" cannot be sorted using this type of comparer.';
  SCannotShuffle = 'An object of type "%s" cannot be shuffled.';
  SCannotReverse = 'An object of type "%s" cannot be reversed.';
  SCannotConstructUnique = 'Cannot remove duplicates from an object of type "%s".';
  SCannotConstructUniqueFromSorted = 'Cannot remove adjacent duplicates from an object of type "%s".';
  SCannotConstructFreq = 'Cannot compute member frequencies in an object of type "%s".';
  SCannotConstructFreqAdj = 'Cannot compute adjacent member counts in an object of type "%s".';
  SUnknownComparer = 'Unknown comparison method "%s".';
  SLeftSideCannotBeAssignedTo = 'Left side cannot be assigned to.';
  SExprNodeChildren = 'An expression node must only have expression node children.';
  SExprNodeTree = 'Cannot insert expression node in a tree which is not an expression.';
  SNoStandaloneNode = 'Cannot create a stand-alone tree node.';
  SExpressionTreeNodes = 'An expression tree can only have expression nodes.';
  SUnknownStructType = 'Unknown structure type "%s".';
  SStructTypeAlreadyRegistered = 'There already is a registered structure type named "%s".';
  SCannotUnregisterKernelType = 'Cannot unregister kernel structure type "%s".';
  STooFewArguments = 'Too few arguments. A required argument of type %s is missing.';
  STooManyArguments = 'Too many arguments.';
  SArgNotNonNegInt = 'A non-negative integer was expected as argument %d, but "%s" was given.';
  SArgNotPosInt = 'A positive integer was expected as argument %d, but "%s" was given.';
  SArgNotNonNegReal = 'A non-negative real number was expected as argument %d, but "%s" was given.';
  SArgNotPosReal = 'A positive real number was expected as argument %d, but "%s" was given.';
  SInvPointList = 'Invalid point list.';
  SArgNotChr = 'A character was expected as argument %d, but "%s" was given.';
  SArgNotMatchingStruct = 'The structure in argument %d must be of type %s.';
  SIntTypeToSmall = 'Cannot represent this %d-bit integer value as a %d-bit value.';
  SObjNoDBitInt = 'Object cannot be represented as a %d-bit integer.';
  SObjNoRat = 'Object isn''t a rational number.';
  SObjNoFloat = 'Object isn''t a real number.';
  SObjNoComplex = 'Object isn''t a complex number.';
  SCmplxNoOrder = 'Complex numbers have no order.';
  SNoIntPointList = 'A list or set of integer points was expected as argument %d.';
  SConvBlob = 'An object of type "%s" cannot be converted to a binary object.';
  SUnknownClassType = 'Unknown class type: "%s".';
  SSetFromBlob = 'An object of type "%s" cannot be set using binary data.';
  SInvalidBlob = 'Invalid binary data for object of type "%s".';
  SObjectStoreStackEmpty = 'The object store stack is empty.';
  SCannotCloneRootlessExpression = 'Cannot clone a rootless expression.';
  SVectPlanarExtentWidth = 'A vector must be a single column.';
  SSpecValWrongLength2D = 'Cannot populate a %d×%d array with a list of %d values.';
  SNamedBufferNotFound = 'There is no output buffer named "%s".';
  SInvalidBufferName = 'Invalid buffer name "%s".';
  SUserCanceled = 'The operation was cancelled by the user.';
  SInvNumberBase = 'Invalid number base %d.';
  SInvNumDigits = 'Invalid number of digits %d.';
  SInvDigGrSize = 'Invalid digit grouping size %d.';
  SInvMinLen = 'Invalid minimum length %d.';
  SCannotConvertNon2DListToMatrix = 'Cannot convert a list which is not 2D to a matrix.';
  SExpressionTooDeep = 'Expression is too deep.';
  STooDeepRecursion = 'Too deep recursion.';

var
  DefaultFormatSettings: TFormatSettings;

function IsValidIdent(const AName: string): Boolean;
procedure CheckIdentName(const AName: string); inline;

procedure ErrInternal; inline;
procedure ErrInvalidArguments; inline;

function BytesToString(const ABytes: TBytes): string; overload; inline;
function BytesToString(ABuf: PByte; ALen: Cardinal): string; overload;

function LinkerTimestamp: TDateTime;

function IndexChr(const AChr: Char; AValues: array of Char): Integer;
function IndexInt(const AInt: Integer; AValues: array of Integer): Integer;

procedure RestartTimer(ATimer: TTimer);

function UnicodeSuperscript(const AChar: Char): Char;
function UnicodeSubscript(const AChar: Char): Char;
function UnicodeCircled(const AChar: Char): Char;
function UnicodeParenthesized(const AChar: Char): Char;
function UnicodeFullStop(const AChar: Char): Char;
function UnicodeDoublyCircled(const AChar: Char): Char;

function IntToPrettyStr(AValue: Integer): string;

type
  TReadOnlyPromise = (I_Will_Not_Modify_The_Object = 7);

  TResKind = (rkText, rkBitmap, rkSound);
  TResInfo = record
    ResKind: TResKind;
    ResName: string;
    Meta: string;
  end;

function ResLookup(const AName: string): TResInfo;
function LoadResBitmap(const AName: string): TBitmap;
function LoadResSound(const AName: string): TASSound;
function LoadResString(const AName: string): string;
function LoadResLicense(const AName: string): string;

function BlockCombineStrings(const AStrings: array of string;
  AMaxWidth, ASpaceCount: Integer): string;

implementation

uses
  Classes, Math, Character;

function IsValidIdent(const AName: string): Boolean;
var
  i: Integer;
begin
  Result := (AName.Length > 0) and AName[1].IsLetter;
  if Result then
    for i := 2 to AName.Length do
      if not AName[i].IsLetterOrDigit then
        Exit(False);
end;

procedure CheckIdentName(const AName: string);
begin
  if not IsValidIdent(AName) then
    raise EInvalidIdentName.CreateFmt(SInvalidIdentName, [AName]);
end;

procedure ErrInternal;
begin
  raise EKernelException.Create(SInternalError);
end;

procedure ErrInvalidArguments;
begin
  raise EInvArgs.Create(SInvalidArguments);
end;

function BytesToString(const ABytes: TBytes): string;
begin
  Result := BytesToString(PByte(ABytes), Length(ABytes));
end;

function BytesToString(ABuf: PByte; ALen: Cardinal): string;
const
  HexDigits: array[0..$F] of Char = '0123456789ABCDEF';
var
   i: Integer;
begin
   if ALen = 0 then
     Exit('');
   SetLength(Result, 3 * ALen - 1);
   Result[1] := HexDigits[ABuf[0] shr 4];
   Result[2] := HexDigits[ABuf[0] and $0F];
   for i := 1 to ALen - 1 do
   begin
     Result[3*i + 0] := ' ';
     Result[3*i + 1] := HexDigits[ABuf[i] shr 4];
     Result[3*i + 2] := HexDigits[ABuf[i] and $0F];
   end;
end;

function LinkerTimestamp: TDateTime;
// https://stackoverflow.com/a/8438985/282848
begin
  Result := PImageNtHeaders(HInstance + Cardinal(PImageDosHeader(HInstance)^._lfanew))^.FileHeader.TimeDateStamp / SecsPerDay + UnixDateDelta;
end;

function IndexChr(const AChr: Char; AValues: array of Char): Integer;
var
  i: Integer;
begin
  for i := 0 to High(AValues) do
    if AChr = AValues[i] then
      Exit(i);
  Result := -1;
end;

function IndexInt(const AInt: Integer; AValues: array of Integer): Integer;
var
  i: Integer;
begin
  for i := 0 to High(AValues) do
    if AInt = AValues[i] then
      Exit(i);
  Result := -1;
end;

procedure RestartTimer(ATimer: TTimer);
begin
  if ATimer = nil then
    Exit;
  ATimer.Enabled := False;
  ATimer.Enabled := True;
end;

function UnicodeSuperscript(const AChar: Char): Char;
begin
  Result := AChar;
  case AChar of
    '0':
      Result := '⁰';
    '1':
      Result := '¹';
    '2':
      Result := '²';
    '3':
      Result := '³';
    '4':
      Result := '⁴';
    '5':
      Result := '⁵';
    '6':
      Result := '⁶';
    '7':
      Result := '⁷';
    '8':
      Result := '⁸';
    '9':
      Result := '⁹';
    '+':
      Result := '⁺';
    '-', '−':
      Result := '⁻';
    '=':
      Result := '⁼';
    '(':
      Result := '⁽';
    ')':
      Result := '⁾';
    'n':
      Result := 'ⁿ';
  end;
end;

function UnicodeSubscript(const AChar: Char): Char;
begin
  Result := AChar;
  case AChar of
    '0':
      Result := '₀';
    '1':
      Result := '₁';
    '2':
      Result := '₂';
    '3':
      Result := '₃';
    '4':
      Result := '₄';
    '5':
      Result := '₅';
    '6':
      Result := '₆';
    '7':
      Result := '₇';
    '8':
      Result := '₈';
    '9':
      Result := '₉';
    '+':
      Result := '₊';
    '-', '−':
      Result := '₋';
    '=':
      Result := '₌';
    '(':
      Result := '₍';
    ')':
      Result := '₎';
  end;
end;

function UnicodeCircled(const AChar: Char): Char;
begin
  Result := AChar;
  if InRange(Ord(AChar), Ord('A'), Ord('Z')) then
    Result := Chr($24B6 + Ord(AChar) - Ord('A'))
  else if InRange(Ord(AChar), Ord('a'), Ord('z')) then
    Result := Chr($24D0 + Ord(AChar) - Ord('a'))
  else if InRange(Ord(AChar), Ord('1'), Ord('9')) then
    Result := Chr($2460 + Ord(AChar) - Ord('1'))
  else if AChar = '0' then
    Result := #$24EA;
end;

function UnicodeParenthesized(const AChar: Char): Char;
begin
  Result := AChar;
  if InRange(Ord(AChar), Ord('a'), Ord('z')) then
    Result := Chr($249C + Ord(AChar) - Ord('a'))
  else if InRange(Ord(AChar), Ord('1'), Ord('9')) then
    Result := Chr($2474 + Ord(AChar) - Ord('1'))
end;

function UnicodeFullStop(const AChar: Char): Char;
begin
  Result := AChar;
  if InRange(Ord(AChar), Ord('1'), Ord('9')) then
    Result := Chr($2488 + Ord(AChar) - Ord('1'))
end;

function UnicodeDoublyCircled(const AChar: Char): Char;
begin
  Result := AChar;
  if InRange(Ord(AChar), Ord('1'), Ord('9')) then
    Result := Chr($24F5 + Ord(AChar) - Ord('1'))
end;

{ ERuntimeException }

constructor ERuntimeException.Create(const AReason: string;
  ASource: TList<TClass>);
var
  i: Integer;
begin
  inherited Create(AReason);
  if Assigned(ASource) then
  begin
    FSource := TList<TClass>.Create;
    FSource.Capacity := ASource.Count;
    for i := 0 to ASource.Count - 1 do
      FSource.Add(ASource[i]);
  end;
end;

destructor ERuntimeException.Destroy;
begin
  FreeAndNil(FSource);
  inherited;
end;

var
  PrettyIntFS: TFormatSettings;

function IntToPrettyStr(AValue: Integer): string;
begin
  Result := Format('%.0n', [Double(AValue)], PrettyIntFS);
end;

function ResLookup(const AName: string): TResInfo;
var
  s, r: string;
  c: TArray<string>;
begin
  s := LoadResString('residx');
  for r in s.Split([sLineBreak]) do
  begin
    c := r.Split([#9]);
    if Length(c) >= 4 then
      if SameText(c[0], AName) then
      begin
        if SameText(c[1], 'text') then
          Result.ResKind := rkText
        else if SameText(c[1], 'bitmap') then
          Result.ResKind := rkBitmap
        else if SameText(c[1], 'sound') then
          Result.ResKind := rkSound
        else
          raise Exception.Create('Unsupported resource type.');
        Result.ResName := c[2];
        Result.Meta := c[3];
        Exit;
      end;
  end;
  raise Exception.CreateFmt('Resource "%s" not found.', [AName]);
end;

function LoadResBitmap(const AName: string): TBitmap;
var
  h: NativeUInt;
begin
  h := LoadLibrary('asres.dll');
  if h = 0 then
    RaiseLastOSError;
  try
    Result := TBitmap.Create;
    try
      Result.LoadFromResourceName(h, AName);
    except
      Result.Free;
      raise;
    end;
  finally
    FreeLibrary(h);
  end;
end;

function LoadResSound(const AName: string): TASSound;
var
  h: NativeUInt;
  rs: TResourceStream;
begin
  h := LoadLibrary('asres.dll');
  if h = 0 then
    RaiseLastOSError;
  try
    rs := TResourceStream.Create(h, AName, RT_RCDATA);
    try
      Result := LoadSoundFromStream(rs);
    finally
      rs.Free;
    end;
  finally
    FreeLibrary(h);
  end;
end;

function LoadResString(const AName: string): string;
var
  h: NativeUInt;
  rs: TResourceStream;
  ss: TStringStream;
begin
  h := LoadLibrary('asres.dll');
  if h = 0 then
    RaiseLastOSError;
  try
    rs := TResourceStream.Create(h, AName, RT_RCDATA);
    try
      ss := TStringStream.Create('', TEncoding.UTF8);
      try
        ss.CopyFrom(rs, rs.Size);
        Result := ss.DataString;
      finally
        ss.Free;
      end;
    finally
      rs.Free;
    end;
  finally
    FreeLibrary(h);
  end;
end;

function LoadResLicense(const AName: string): string;
begin
  Result := ResLookup(AName).Meta;
end;

function BlockCombineStrings(const AStrings: array of string;
  AMaxWidth, ASpaceCount: Integer): string;
var
  Lines: TArray<TArray<string>>;
  Widths: TArray<Integer>;
  Tops: TArray<Integer>;
  LastWritten: Integer;
  x, i, j: Integer;
  LineCount: Integer;
  OutputLines: TStringList;

  procedure FinalizeRow(ALastIndex: Integer);
  var
    k, l: Integer;
    s, line: string;
  begin

    for k := Succ(LastWritten) to ALastIndex do
      Tops[k] := (LineCount - Length(Lines[k])) div 2;

    for k := 0 to LineCount - 1 do
    begin
      line := '';
      for l := Succ(LastWritten) to ALastIndex do
      begin
        if InRange(k, Tops[l], Tops[l] + High(Lines[l])) then
          s := Lines[l][k - Tops[l]]
        else
          s := '';
        if s.Length < Widths[l] then
          s := s + StringOfChar(#32, Widths[l] - s.Length);
        line := line + s;
      end;
      OutputLines.Add(line);
    end;

    x := 0;
    LineCount := 0;
    LastWritten := ALastIndex;

    OutputLines.Add('');

  end;

begin
  SetLength(Lines, Length(AStrings));
  SetLength(Widths, Length(AStrings));
  SetLength(Tops, Length(AStrings));
  OutputLines := TStringList.Create;
  try
    x := 0;
    LineCount := 0;
    LastWritten := -1;
    for i := 0 to High(AStrings) do
    begin
      Lines[i] := AStrings[i].Split([sLineBreak]);
      for j := 0 to High(Lines[i]) do
        if Lines[i][j].Length > Widths[i] then
          Widths[i] := Lines[i][j].Length;
      if x + Widths[i] > AMaxWidth then
        FinalizeRow(Pred(i));
      if Length(Lines[i]) > LineCount then
        LineCount := Length(Lines[i]);
      if i < High(AStrings) then
        Inc(Widths[i], ASpaceCount);
      Inc(x, Widths[i]);
    end;
    FinalizeRow(High(AStrings));
    Result := OutputLines.Text;
  finally
    OutputLines.Free;
  end;
end;

{ TVersionData }

function TVersionData.ToString: string;
begin
  Result := Format('%d.%d.%d.%d', [Major, Minor, Release, Build]);
end;

initialization
  DefaultFormatSettings := TFormatSettings.Create(1033);
  PrettyIntFS := TFormatSettings.Invariant;
  PrettyIntFS.ThousandSeparator := #32;

end.