freepascal.compiler/utils/unicode/helper.pas

{   Unicode parser helper unit.

    Copyright (c) 2012 by Inoussa OUEDRAOGO

    The source code is distributed under the Library GNU
    General Public License with the following modification:

        - object files and libraries linked into an application may be
          distributed without source code.

    If you didn't receive a copy of the file COPYING, contact:
          Free Software Foundation
          675 Mass Ave
          Cambridge, MA  02139
          USA

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. }
unit helper;

{$mode delphi}
{$H+}
{$PACKENUM 1}
{$pointermath on}

interface

uses
  Classes, SysUtils, StrUtils;

const
  SLicenseText =
    '    {   Unicode implementation tables. ' + sLineBreak +
    ' ' + sLineBreak +
    '        Copyright (c) 2013 by Inoussa OUEDRAOGO ' + sLineBreak +
    ' ' + sLineBreak +
    '        Permission is hereby granted, free of charge, to any person ' + sLineBreak +
    '        obtaining a copy of the Unicode data files and any associated ' + sLineBreak +
    '        documentation (the "Data Files") or Unicode software and any ' + sLineBreak +
    '        associated documentation (the "Software") to deal in the Data ' + sLineBreak +
    '        Files or Software without restriction, including without ' + sLineBreak +
    '        limitation the rights to use, copy, modify, merge, publish, ' + sLineBreak +
    '        distribute, and/or sell copies of the Data Files or Software, ' + sLineBreak +
    '        and to permit persons to whom the Data Files or Software are ' + sLineBreak +
    '        furnished to do so, provided that (a) the above copyright ' + sLineBreak +
    '        notice(s) and this permission notice appear with all copies ' + sLineBreak +
    '        of the Data Files or Software, (b) both the above copyright ' + sLineBreak +
    '        notice(s) and this permission notice appear in associated ' + sLineBreak +
    '        documentation, and (c) there is clear notice in each modified ' + sLineBreak +
    '        Data File or in the Software as well as in the documentation ' + sLineBreak +
    '        associated with the Data File(s) or Software that the data or ' + sLineBreak +
    '        software has been modified. ' + sLineBreak +
    ' ' + sLineBreak +
    ' ' + sLineBreak +
    '        This program is distributed in the hope that it will be useful, ' + sLineBreak +
    '        but WITHOUT ANY WARRANTY; without even the implied warranty of ' + sLineBreak +
    '        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. }';


type
  // Unicode General Category
  TUnicodeCategory = (
    ucUppercaseLetter,             // Lu = Letter, uppercase
    ucLowercaseLetter,             //  Ll = Letter, lowercase
    ucTitlecaseLetter,             //  Lt = Letter, titlecase
    ucModifierLetter,              //  Lm = Letter, modifier
    ucOtherLetter,                 //  Lo = Letter, other

    ucNonSpacingMark,              //  Mn = Mark, nonspacing
    ucCombiningMark,               //  Mc = Mark, spacing combining
    ucEnclosingMark,               //  Me = Mark, enclosing

    ucDecimalNumber,               //  Nd = Number, decimal digit
    ucLetterNumber,                //  Nl = Number, letter
    ucOtherNumber,                 //  No = Number, other

    ucConnectPunctuation,          //  Pc = Punctuation, connector
    ucDashPunctuation,             //  Pd = Punctuation, dash
    ucOpenPunctuation,             //  Ps = Punctuation, open
    ucClosePunctuation,            //  Pe = Punctuation, close
    ucInitialPunctuation,          //  Pi = Punctuation, initial quote (may behave like Ps or Pe depending on usage)
    ucFinalPunctuation,            //  Pf = Punctuation, final quote (may behave like Ps or Pe depending on usage)
    ucOtherPunctuation,            //  Po = Punctuation, other

    ucMathSymbol,                  //  Sm = Symbol, math
    ucCurrencySymbol,              //  Sc = Symbol, currency
    ucModifierSymbol,              //  Sk = Symbol, modifier
    ucOtherSymbol,                 //  So = Symbol, other

    ucSpaceSeparator,              //  Zs = Separator, space
    ucLineSeparator,               //  Zl = Separator, line
    ucParagraphSeparator,          //  Zp = Separator, paragraph

    ucControl,                     //  Cc = Other, control
    ucFormat,                      //  Cf = Other, format
    ucSurrogate,                   //  Cs = Other, surrogate
    ucPrivateUse,                  //  Co = Other, private use
    ucUnassigned                   //  Cn = Other, not assigned (including noncharacters)
  );


  TUInt24Rec = packed record
  public
  {$ifdef FPC_LITTLE_ENDIAN}
    byte0, byte1, byte2 : Byte;
  {$else FPC_LITTLE_ENDIAN}
    byte2, byte1, byte0 : Byte;
  {$endif FPC_LITTLE_ENDIAN}
  public
    class operator Implicit(a : TUInt24Rec) : Cardinal;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator Implicit(a : TUInt24Rec) : LongInt;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator Implicit(a : TUInt24Rec) : Word;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator Implicit(a : TUInt24Rec) : Byte;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator Implicit(a : Cardinal) : TUInt24Rec;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator Equal(a, b: TUInt24Rec): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}

    class operator Equal(a : TUInt24Rec; b : Cardinal): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator Equal(a : Cardinal; b : TUInt24Rec): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}

    class operator Equal(a : TUInt24Rec; b : LongInt): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator Equal(a : LongInt; b : TUInt24Rec): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}

    class operator Equal(a : TUInt24Rec; b : Word): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator Equal(a : Word; b : TUInt24Rec): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}

    class operator Equal(a : TUInt24Rec; b : Byte): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator Equal(a : Byte; b : TUInt24Rec): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}

    class operator NotEqual(a, b: TUInt24Rec): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator NotEqual(a : TUInt24Rec; b : Cardinal): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator NotEqual(a : Cardinal; b : TUInt24Rec): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator GreaterThan(a, b: TUInt24Rec): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator GreaterThan(a : TUInt24Rec; b : Cardinal): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator GreaterThan(a : Cardinal; b : TUInt24Rec): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator GreaterThanOrEqual(a, b: TUInt24Rec): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator GreaterThanOrEqual(a : TUInt24Rec; b : Cardinal): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator GreaterThanOrEqual(a : Cardinal; b : TUInt24Rec): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator LessThan(a, b: TUInt24Rec): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator LessThan(a : TUInt24Rec; b : Cardinal): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator LessThan(a : Cardinal; b : TUInt24Rec): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator LessThanOrEqual(a, b: TUInt24Rec): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator LessThanOrEqual(a : TUInt24Rec; b : Cardinal): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}
    class operator LessThanOrEqual(a : Cardinal; b : TUInt24Rec): Boolean;{$ifdef USE_INLINE}inline;{$ENDIF}
  end;

  UInt24 = TUInt24Rec;
  PUInt24 = ^UInt24;
  TUnicodeCodePoint = Cardinal;
  TUnicodeCodePointArray = array of TUnicodeCodePoint;
  TDecompositionArray = array of TUnicodeCodePointArray;
  TNumericValue = Double;
  TNumericValueArray = array of TNumericValue;

  TBlockItemRec = packed record
    RangeStart    : TUnicodeCodePoint;
    RangeEnd      : TUnicodeCodePoint;
    Name          : string[120];
    CanonicalName : string[120];
  end;
  TBlocks = array of TBlockItemRec;

  PPropRec = ^TPropRec;

  { TPropRec }

  TPropRec = packed record
  private
    function GetCategory : TUnicodeCategory;inline;
    procedure SetCategory(AValue : TUnicodeCategory);
    function GetWhiteSpace : Boolean;inline;
    procedure SetWhiteSpace(AValue : Boolean);
    function GetHangulSyllable : Boolean;inline;
    procedure SetHangulSyllable(AValue : Boolean);
  public
    CategoryData    : Byte;

    PropID          : Word;
    CCC             : Byte; // Canonical Combining Class
    NumericIndex    : Byte;
    SimpleUpperCase : UInt24;
    SimpleLowerCase : UInt24;
    DecompositionID : SmallInt;
  public
    property Category : TUnicodeCategory read GetCategory write SetCategory;
    property WhiteSpace : Boolean read GetWhiteSpace write SetWhiteSpace;
    property HangulSyllable : Boolean read GetHangulSyllable write SetHangulSyllable;
  end;
  TPropRecArray = array of TPropRec;

  TDecompositionIndexRec = packed record
    StartPosition : Word;
    Length        : Byte;
  end;
  TDecompositionBook = packed record
    Index      : array of TDecompositionIndexRec;
    CodePoints : array of TUnicodeCodePoint;
  end;

  PDataLineRec = ^TDataLineRec;
  TDataLineRec = record
    PropID    : Integer;
    case LineType : Byte of
      0 : (CodePoint : TUnicodeCodePoint);
      1 : (StartCodePoint, EndCodePoint : TUnicodeCodePoint);
  end;
  TDataLineRecArray = array of TDataLineRec;

  TCodePointRec = record
    case LineType : Byte of
      0 : (CodePoint : TUnicodeCodePoint);
      1 : (StartCodePoint, EndCodePoint : TUnicodeCodePoint);
  end;
  TCodePointRecArray = array of TCodePointRec;

  TPropListLineRec = packed record
    CodePoint : TCodePointRec;
    PropName  : string[123];
  end;
  TPropListLineRecArray = array of TPropListLineRec;

  TUCA_WeightRec = packed record
    Weights  : array[0..3] of Cardinal;
    Variable : Boolean;
  end;
  TUCA_WeightRecArray = array of TUCA_WeightRec;

  TUCA_LineContextItemRec = packed record
  public
    CodePoints : TUnicodeCodePointArray;
    Weights    : TUCA_WeightRecArray;
  public
    procedure Clear();
    procedure Assign(ASource : TUCA_LineContextItemRec);
    function Clone() : TUCA_LineContextItemRec;
  end;
  PUCA_LineContextItemRec = ^TUCA_LineContextItemRec;

  TUCA_LineContextRec = packed record
  public
    Data : array of TUCA_LineContextItemRec;
  public
    procedure Clear();
    procedure Assign(ASource : TUCA_LineContextRec);
    function Clone() : TUCA_LineContextRec;
  end;
  PUCA_LineContextRec = ^TUCA_LineContextRec;

  { TUCA_LineRec }

  TUCA_LineRec = packed record
  public
    CodePoints : TUnicodeCodePointArray;
    Weights    : TUCA_WeightRecArray;
    Context    : TUCA_LineContextRec;
    //Variable   : Boolean;
    Deleted    : Boolean;
    Stored     : Boolean;
  public
    procedure Clear();
    procedure Assign(ASource : TUCA_LineRec);
    function Clone() : TUCA_LineRec;
    function HasContext() : Boolean;
  end;
  PUCA_LineRec = ^TUCA_LineRec;
  TUCA_VariableKind = (
    ucaShifted, ucaNonIgnorable, ucaBlanked, ucaShiftedTrimmed,
    ucaIgnoreSP
  );
  TUCA_DataBook = packed record
    Version        : string;
    VariableWeight : TUCA_VariableKind;
    Backwards      : array[0..3] of Boolean;
    Lines          : array of TUCA_LineRec;
  end;
  PUCA_DataBook = ^TUCA_DataBook;
  TUCA_DataBookIndex = array of Integer;

const
  BIT_POS_VALIDE = 0;
  BIT_POS_COMPRESS_WEIGHT_1 = BIT_POS_VALIDE + 1;
  BIT_POS_COMPRESS_WEIGHT_2 = BIT_POS_COMPRESS_WEIGHT_1 + 1;
type
  TWeightLength = 0..24;
  TUCA_PropWeights = packed record
    Weights  : array[0..2] of Word;
    //Variable : Byte;
  end;
  PUCA_PropWeights = ^TUCA_PropWeights;

  TUCA_PropItemContextRec = packed record
    CodePointCount : Byte;
    WeightCount    : Byte;
    //CodePoints     : UInt24;
    //Weights        : TUCA_PropWeights;
  end;
  PUCA_PropItemContextRec = ^TUCA_PropItemContextRec;
  TUCA_PropItemContextTreeNodeRec = packed record
    Left    : Word;
    Right   : Word;
    Data    : TUCA_PropItemContextRec;
  end;
  PUCA_PropItemContextTreeNodeRec = ^TUCA_PropItemContextTreeNodeRec;

  TUCA_PropItemContextTreeRec = packed record
  public
    Size : UInt24;
  public
    function GetData:PUCA_PropItemContextTreeNodeRec;inline;
    property Data : PUCA_PropItemContextTreeNodeRec read GetData;
  end;
  PUCA_PropItemContextTreeRec = ^TUCA_PropItemContextTreeRec;

  { TUCA_PropItemRec }

  TUCA_PropItemRec = packed record
  private
    const FLAG_CODEPOINT  = 1;
    const FLAG_CONTEXTUAL = 2;
    const FLAG_DELETION   = 3;
  private
    function GetWeightLength: TWeightLength;inline;
    procedure SetWeightLength(AValue: TWeightLength);inline;
    function GetWeightSize : Word;inline;
  public
    //CodePoint    : UInt24;
    Valid        : Byte;// On First Bit
    ChildCount   : Byte;
    Size         : Word;
    Flags        : Byte;
  public
    function GetCodePoint() : UInt24;//inline;
    property CodePoint : UInt24 read GetCodePoint;
    //WeightLength is stored in the 5 last bits of "Valid"
    property WeightLength : TWeightLength read GetWeightLength write SetWeightLength;
    //Weights    : array[0..WeightLength] of TUCA_PropWeights;
    procedure GetWeightArray(ADest : PUCA_PropWeights);
    function GetSelfOnlySize() : Word;inline;

    procedure SetContextual(AValue : Boolean);inline;
    function GetContextual() : Boolean;inline;
    property Contextual : Boolean read GetContextual write setContextual;
    function GetContext() : PUCA_PropItemContextTreeRec;
    procedure SetDeleted(AValue : Boolean);inline;
    function IsDeleted() : Boolean;inline;
  end;
  PUCA_PropItemRec = ^TUCA_PropItemRec;
  TUCA_PropIndexItem = packed record
    CodePoint : Cardinal;
    Position  : Integer;
  end;
  PUCA_PropIndexItem = ^TUCA_PropIndexItem;
  TUCA_PropBook = packed record
    ItemSize      : Integer;
    Index         : array of TUCA_PropIndexItem;
    Items         : PUCA_PropItemRec;
    VariableLowLimit  : Word;
    VariableHighLimit : Word;
  end;
  PUCA_PropBook = ^TUCA_PropBook;

  TBmpFirstTable = array[0..255] of Byte;
  TBmpSecondTableItem = array[0..255] of Word;
  TBmpSecondTable = array of TBmpSecondTableItem;

  T3lvlBmp1Table = array[0..255] of Byte;
  T3lvlBmp2TableItem = array[0..15] of Word;
  T3lvlBmp2Table = array of T3lvlBmp2TableItem;
  T3lvlBmp3TableItem = array[0..15] of Word;
  T3lvlBmp3Table = array of T3lvlBmp3TableItem;

  TucaBmpFirstTable = array[0..255] of Byte;
  TucaBmpSecondTableItem = array[0..255] of Cardinal;
  TucaBmpSecondTable = array of TucaBmpSecondTableItem;
  PucaBmpFirstTable = ^TucaBmpFirstTable;
  PucaBmpSecondTable = ^TucaBmpSecondTable;

const
  LOW_SURROGATE_BEGIN  = Word($DC00);
  LOW_SURROGATE_END    = Word($DFFF);
  LOW_SURROGATE_COUNT  = LOW_SURROGATE_END - LOW_SURROGATE_BEGIN + 1;

  HIGH_SURROGATE_BEGIN = Word($D800);
  HIGH_SURROGATE_END   = Word($DBFF);
  HIGH_SURROGATE_COUNT = HIGH_SURROGATE_END - HIGH_SURROGATE_BEGIN + 1;
type
  TOBmpFirstTable = array[0..(HIGH_SURROGATE_COUNT-1)] of Word;
  TOBmpSecondTableItem = array[0..(LOW_SURROGATE_COUNT-1)] of Word;
  TOBmpSecondTable = array of TOBmpSecondTableItem;

  T3lvlOBmp1Table = array[0..1023] of Byte;
  T3lvlOBmp2TableItem = array[0..31] of Word;
  T3lvlOBmp2Table = array of T3lvlOBmp2TableItem;
  T3lvlOBmp3TableItem = array[0..31] of Word;
  T3lvlOBmp3Table = array of T3lvlOBmp3TableItem;

  TucaOBmpFirstTable = array[0..(HIGH_SURROGATE_COUNT-1)] of Word;
  TucaOBmpSecondTableItem = array[0..(LOW_SURROGATE_COUNT-1)] of Cardinal;
  TucaOBmpSecondTable = array of TucaOBmpSecondTableItem;
  PucaOBmpFirstTable = ^TucaOBmpFirstTable;
  PucaOBmpSecondTable = ^TucaOBmpSecondTable;

type
  TEndianKind = (ekLittle, ekBig);
const
  THIS_ENDIAN =
{$IFDEF ENDIAN_LITTLE}
    ekLittle;
{$ENDIF ENDIAN_LITTLE}
{$IFDEF ENDIAN_BIG}
    ekBig;
{$ENDIF ENDIAN_BIG}

  procedure GenerateLicenceText(ADest : TStream);

  function BoolToByte(AValue : Boolean): Byte;inline;

  function IsHangulSyllable(
    const ACodePoint  : TUnicodeCodePoint;
    const AHangulList : TCodePointRecArray
  ) : Boolean;
  procedure ParseHangulSyllableTypes(
        ADataAStream   : TMemoryStream;
    var ACodePointList : TCodePointRecArray
  );

  procedure ParseProps(
        ADataAStream   : TMemoryStream;
    var APropList      : TPropListLineRecArray
  );
  function FindCodePointsByProperty(
    const APropName : string;
    const APropList : TPropListLineRecArray
  ) : TCodePointRecArray;

  procedure ParseBlokcs(
        ADataAStream   : TMemoryStream;
    var ABlocks        : TBlocks
  );
  procedure ParseUCAFile(
        ADataAStream : TMemoryStream;
    var ABook        : TUCA_DataBook
  );
  procedure MakeUCA_Props(
          ABook         : PUCA_DataBook;
    out   AProps        : PUCA_PropBook
  );
  procedure FreeUcaBook(var ABook : PUCA_PropBook);
  procedure MakeUCA_BmpTables(
    var   AFirstTable   : TucaBmpFirstTable;
    var   ASecondTable  : TucaBmpSecondTable;
    const APropBook     : PUCA_PropBook
  );
  procedure MakeUCA_OBmpTables(
    var   AFirstTable   : TucaOBmpFirstTable;
    var   ASecondTable  : TucaOBmpSecondTable;
    const APropBook     : PUCA_PropBook
  );
  function GetPropPosition(
    const AHighS,
          ALowS         : Word;
    const AFirstTable   : PucaOBmpFirstTable;
    const ASecondTable  : PucaOBmpSecondTable
  ): Integer;inline;overload;

  procedure GenerateUCA_Head(
    ADest  : TStream;
    ABook  : PUCA_DataBook;
    AProps : PUCA_PropBook
  );
  procedure GenerateUCA_BmpTables(
          AStream,
          ABinStream    : TStream;
    var   AFirstTable   : TucaBmpFirstTable;
    var   ASecondTable  : TucaBmpSecondTable;
    const AEndian       : TEndianKind
  );
  procedure GenerateUCA_PropTable(
  // WARNING : files must be generated for each endianess (Little / Big)
          ADest     : TStream;
    const APropBook : PUCA_PropBook
  );
  procedure GenerateUCA_OBmpTables(
          AStream,
          ABinStream    : TStream;
    var   AFirstTable   : TucaOBmpFirstTable;
    var   ASecondTable  : TucaOBmpSecondTable;
    const AEndian       : TEndianKind
  );

  procedure Parse_UnicodeData(
          ADataAStream   : TMemoryStream;
    var   APropList      : TPropRecArray;
    var   ANumericTable  : TNumericValueArray;
    var   ADataLineList  : TDataLineRecArray;
    var   ADecomposition : TDecompositionArray;
    const AHangulList    : TCodePointRecArray;
    const AWhiteSpaces   : TCodePointRecArray
  );
  procedure MakeDecomposition(
    const ARawData : TDecompositionArray;
    var   ABook    : TDecompositionBook
  );

  procedure MakeBmpTables(
    var   AFirstTable   : TBmpFirstTable;
    var   ASecondTable  : TBmpSecondTable;
    const APropList     : TPropRecArray;
    const ADataLineList : TDataLineRecArray
  );
  procedure MakeBmpTables3Levels(
    var   AFirstTable   : T3lvlBmp1Table;
    var   ASecondTable  : T3lvlBmp2Table;
    var   AThirdTable  : T3lvlBmp3Table;
    const ADataLineList : TDataLineRecArray
  );
  procedure GenerateBmpTables(
          ADest : TStream;
    var   AFirstTable   : TBmpFirstTable;
    var   ASecondTable  : TBmpSecondTable
  );
  procedure Generate3lvlBmpTables(
          ADest : TStream;
    var   AFirstTable   : T3lvlBmp1Table;
    var   ASecondTable  : T3lvlBmp2Table;
    var   AThirdTable   : T3lvlBmp3Table
  );
  procedure GeneratePropTable(
          ADest     : TStream;
    const APropList : TPropRecArray;
    const AEndian   : TEndianKind
  );
  procedure GenerateNumericTable(
          ADest         : TStream;
    const ANumList      : TNumericValueArray;
    const ACompleteUnit : Boolean
  );
  procedure GenerateDecompositionBookTable(
          ADest   : TStream;
    const ABook   : TDecompositionBook;
    const AEndian : TEndianKind
  );
  procedure GenerateOutBmpTable(
          ADest     : TStream;
    const AList : TDataLineRecArray
  );

  function Compress(const AData : TDataLineRecArray) : TDataLineRecArray;

  function EvaluateFloat(const AStr : string) : Double;
  function StrToCategory(const AStr : string) : TUnicodeCategory;
  function StringToCodePoint(ACP : string) : TUnicodeCodePoint;
  function IsWhiteSpace(
    const ACodePoint   : TUnicodeCodePoint;
    const AWhiteSpaces : TCodePointRecArray
  ) : Boolean;

  function GetPropID(
          ACodePoint    : TUnicodeCodePoint;
    const ADataLineList : TDataLineRecArray
  ) : Cardinal;

//--------------------
  procedure MakeOBmpTables(
    var   AFirstTable   : TOBmpFirstTable;
    var   ASecondTable  : TOBmpSecondTable;
    const ADataLineList : TDataLineRecArray
  );
  procedure MakeOBmpTables3Levels(
    var   AFirstTable   : T3lvlOBmp1Table;
    var   ASecondTable  : T3lvlOBmp2Table;
    var   AThirdTable  : T3lvlOBmp3Table;
    const ADataLineList : TDataLineRecArray
  );
  procedure GenerateOBmpTables(
          ADest : TStream;
    var   AFirstTable   : TOBmpFirstTable;
    var   ASecondTable  : TOBmpSecondTable
  );
  procedure Generate3lvlOBmpTables(
          ADest : TStream;
    var   AFirstTable   : T3lvlOBmp1Table;
    var   ASecondTable  : T3lvlOBmp2Table;
    var   AThirdTable   : T3lvlOBmp3Table
  );
  function GetProp(
    const AHighS,
          ALowS         : Word;
    const AProps        : TPropRecArray;
    var   AFirstTable   : TOBmpFirstTable;
    var   ASecondTable  : TOBmpSecondTable
  ): PPropRec; inline;overload;
  function GetProp(
    const AHighS,
          ALowS         : Word;
    const AProps        : TPropRecArray;
    var   AFirstTable   : T3lvlOBmp1Table;
    var   ASecondTable  : T3lvlOBmp2Table;
    var   AThirdTable   : T3lvlOBmp3Table
  ): PPropRec; inline;overload;
  procedure FromUCS4(const AValue : TUnicodeCodePoint; var AHighS, ALowS : Word);inline;
  function ToUCS4(const AHighS, ALowS : Word) : TUnicodeCodePoint; inline;
//--------------------

type
  TBitOrder = 0..7;

  function IsBitON(const AData : Byte; const ABit : TBitOrder) : Boolean ;{$IFDEF USE_INLINE}inline;{$ENDIF}
  procedure SetBit(var AData : Byte; const ABit : TBitOrder; const AValue : Boolean);{$IFDEF USE_INLINE}inline;{$ENDIF}

  function GenerateEndianIncludeFileName(const AStoreName : string): string;inline;

resourcestring
  SInsufficientMemoryBuffer = 'Insufficient Memory Buffer';

implementation
uses
  typinfo, Math, AVL_Tree,
  trie;


type

  TCardinalRec = packed record
  {$ifdef FPC_LITTLE_ENDIAN}
    byte0, byte1, byte2, byte3 : Byte;
  {$else FPC_LITTLE_ENDIAN}
    byte3, byte2, byte1, byte0 : Byte;
  {$endif FPC_LITTLE_ENDIAN}
  end;

  TWordRec = packed record
  {$ifdef FPC_LITTLE_ENDIAN}
    byte0, byte1 : Byte;
  {$else FPC_LITTLE_ENDIAN}
    byte1, byte0 : Byte;
  {$endif FPC_LITTLE_ENDIAN}
  end;

{ TUInt24Rec }

class operator TUInt24Rec.Implicit(a : TUInt24Rec) : Cardinal;
begin
  TCardinalRec(Result).byte0 := a.byte0;
  TCardinalRec(Result).byte1 := a.byte1;
  TCardinalRec(Result).byte2 := a.byte2;
  TCardinalRec(Result).byte3 := 0;
end;

class operator TUInt24Rec.Implicit(a : TUInt24Rec) : LongInt;
begin
  Result := Cardinal(a);
end;

class operator TUInt24Rec.Implicit(a : TUInt24Rec) : Word;
begin
{$IFOPT R+}
  if (a > $FFFF) then
    Error(reIntOverflow);
{$ENDIF R+}
  TWordRec(Result).byte0 := a.byte0;
  TWordRec(Result).byte1 := a.byte1;
end;

class operator TUInt24Rec.Implicit(a : TUInt24Rec) : Byte;
begin
{$IFOPT R+}
  if (a > $FF) then
    Error(reIntOverflow);
{$ENDIF R+}
  Result := a.byte0;
end;

class operator TUInt24Rec.Implicit(a : Cardinal) : TUInt24Rec;
begin
{$IFOPT R+}
  if (a > $FFFFFF) then
    Error(reIntOverflow);
{$ENDIF R+}
  Result.byte0 := TCardinalRec(a).byte0;
  Result.byte1 := TCardinalRec(a).byte1;
  Result.byte2 := TCardinalRec(a).byte2;
end;

class operator TUInt24Rec.Equal(a, b : TUInt24Rec) : Boolean;
begin
  Result := (a.byte0 = b.byte0) and (a.byte1 = b.byte1) and (a.byte2 = b.byte2);
end;

class operator TUInt24Rec.Equal(a : TUInt24Rec; b : Cardinal) : Boolean;
begin
  Result := (TCardinalRec(b).byte3 = 0) and
            (a.byte0 = TCardinalRec(b).byte0) and
            (a.byte1 = TCardinalRec(b).byte1) and
            (a.byte2 = TCardinalRec(b).byte2);
end;

class operator TUInt24Rec.Equal(a : Cardinal; b : TUInt24Rec) : Boolean;
begin
  Result := (b = a);
end;

class operator TUInt24Rec.Equal(a : TUInt24Rec; b : LongInt) : Boolean;
begin
  Result := (LongInt(a) = b);
end;

class operator TUInt24Rec.Equal(a : LongInt; b : TUInt24Rec) : Boolean;
begin
  Result := (b = a);
end;

class operator TUInt24Rec.Equal(a : TUInt24Rec; b : Word) : Boolean;
begin
  Result := (a.byte2 = 0) and
            (a.byte0 = TWordRec(b).byte0) and
            (a.byte1 = TWordRec(b).byte1);
end;

class operator TUInt24Rec.Equal(a : Word; b : TUInt24Rec) : Boolean;
begin
  Result := (b = a);
end;

class operator TUInt24Rec.Equal(a : TUInt24Rec; b : Byte) : Boolean;
begin
  Result := (a.byte2 = 0) and
            (a.byte1 = 0) and
            (a.byte0 = b);
end;

class operator TUInt24Rec.Equal(a : Byte; b : TUInt24Rec) : Boolean;
begin
  Result := (b = a);
end;

class operator TUInt24Rec.NotEqual(a, b : TUInt24Rec) : Boolean;
begin
  Result := (a.byte0 <> b.byte0) or (a.byte1 <> b.byte1) or (a.byte2 <> b.byte2);
end;

class operator TUInt24Rec.NotEqual(a : TUInt24Rec; b : Cardinal) : Boolean;
begin
  Result := (TCardinalRec(b).byte3 <> 0) or
            (a.byte0 <> TCardinalRec(b).byte0) or
            (a.byte1 <> TCardinalRec(b).byte1) or
            (a.byte2 <> TCardinalRec(b).byte2);
end;

class operator TUInt24Rec.NotEqual(a : Cardinal; b : TUInt24Rec) : Boolean;
begin
  Result := (b <> a);
end;

class operator TUInt24Rec.GreaterThan(a, b: TUInt24Rec): Boolean;
begin
  Result := (a.byte2 > b.byte2) or
            ((a.byte2 = b.byte2) and (a.byte1 > b.byte1)) or
            ((a.byte2 = b.byte2) and (a.byte1 = b.byte1) and (a.byte0 > b.byte0));
end;

class operator TUInt24Rec.GreaterThan(a: TUInt24Rec; b: Cardinal): Boolean;
begin
  Result := Cardinal(a) > b;
end;

class operator TUInt24Rec.GreaterThan(a: Cardinal; b: TUInt24Rec): Boolean;
begin
  Result := a > Cardinal(b);
end;

class operator TUInt24Rec.GreaterThanOrEqual(a, b: TUInt24Rec): Boolean;
begin
  Result := (a.byte2 > b.byte2) or
            ((a.byte2 = b.byte2) and (a.byte1 > b.byte1)) or
            ((a.byte2 = b.byte2) and (a.byte1 = b.byte1) and (a.byte0 >= b.byte0));
end;

class operator TUInt24Rec.GreaterThanOrEqual(a: TUInt24Rec; b: Cardinal): Boolean;
begin
  Result := Cardinal(a) >= b;
end;

class operator TUInt24Rec.GreaterThanOrEqual(a: Cardinal; b: TUInt24Rec): Boolean;
begin
  Result := a >= Cardinal(b);
end;

class operator TUInt24Rec.LessThan(a, b: TUInt24Rec): Boolean;
begin
  Result := (b > a);
end;

class operator TUInt24Rec.LessThan(a: TUInt24Rec; b: Cardinal): Boolean;
begin
  Result := Cardinal(a) < b;
end;

class operator TUInt24Rec.LessThan(a: Cardinal; b: TUInt24Rec): Boolean;
begin
  Result := a < Cardinal(b);
end;

class operator TUInt24Rec.LessThanOrEqual(a, b: TUInt24Rec): Boolean;
begin
  Result := (b >= a);
end;

class operator TUInt24Rec.LessThanOrEqual(a: TUInt24Rec; b: Cardinal): Boolean;
begin
  Result := Cardinal(a) <= b;
end;

class operator TUInt24Rec.LessThanOrEqual(a: Cardinal; b: TUInt24Rec): Boolean;
begin
  Result := a <= Cardinal(b);
end;

function GenerateEndianIncludeFileName(const AStoreName : string): string;inline;
const
  ENDIAN_SUFFIX =
{$IFDEF ENDIAN_LITTLE}
    'le';
{$ENDIF ENDIAN_LITTLE}
{$IFDEF ENDIAN_BIG}
    'be';
{$ENDIF ENDIAN_BIG}
begin
  Result := ExtractFilePath(AStoreName) +
            ChangeFileExt(ExtractFileName(AStoreName),Format('_%s.inc',[ENDIAN_SUFFIX]));
end;

function IsBitON(const AData : Byte; const ABit : TBitOrder) : Boolean ;
begin
  Result := ( ( AData and ( 1 shl ABit ) ) <> 0 );
end;

procedure SetBit(var AData : Byte; const ABit : TBitOrder; const AValue : Boolean);
begin
  if AValue then
    AData := AData or (1 shl (ABit mod 8))
  else
    AData := AData and ( not ( 1 shl ( ABit mod 8 ) ) );
end;

var
  FS : TFormatSettings;

function EvaluateFloat(const AStr : string) : Double;
var
  s, n, d : string;
  i : Integer;
begin
  Result := 0;
  s := Trim(AStr);
  if (Length(s) > 0) then begin
    i := Pos('/',s);
    if (i < 1) then
      Result := StrToFloat(s,FS)
    else begin
      n := Copy(s,1,i-1);
      d := Copy(s,i+1,MaxInt);
      Result := StrToInt(n) / StrToInt(d);
    end;
  end;
end;

function StrToCategory(const AStr : string) : TUnicodeCategory;
var
  s : string;
begin
  s := UpperCase(Trim(AStr));
  if (s = 'LU') then
    Result := ucUppercaseLetter
  else if (s = 'LL') then
    Result := ucLowercaseLetter
  else if (s = 'LT') then
    Result := ucTitlecaseLetter
  else if (s = 'LM') then
    Result := ucModifierLetter
  else if (s = 'LO') then
    Result := ucOtherLetter
  else

  if (s = 'MN') then
    Result := ucNonSpacingMark
  else if (s = 'MC') then
    Result := ucCombiningMark
  else if (s = 'ME') then
    Result := ucEnclosingMark
  else

  if (s = 'ND') then
    Result := ucDecimalNumber
  else if (s = 'NL') then
    Result := ucLetterNumber
  else if (s = 'NO') then
    Result := ucOtherNumber
  else

  if (s = 'PC') then
    Result := ucConnectPunctuation
  else if (s = 'PD') then
    Result := ucDashPunctuation
  else if (s = 'PS') then
    Result := ucOpenPunctuation
  else if (s = 'PE') then
    Result := ucClosePunctuation
  else if (s = 'PI') then
    Result := ucInitialPunctuation
  else     if (s = 'PF') then
    Result := ucFinalPunctuation
  else if (s = 'PO') then
    Result := ucOtherPunctuation
  else

  if (s = 'SM') then
    Result := ucMathSymbol
  else if (s = 'SC') then
    Result := ucCurrencySymbol
  else if (s = 'SK') then
    Result := ucModifierSymbol
  else if (s = 'SO') then
    Result := ucOtherSymbol
  else

  if (s = 'ZS') then
    Result := ucSpaceSeparator
  else if (s = 'ZL') then
    Result := ucLineSeparator
  else if (s = 'ZP') then
    Result := ucParagraphSeparator
  else

  if (s = 'CC') then
    Result := ucControl
  else if (s = 'CF') then
    Result := ucFormat
  else if (s = 'CS') then
    Result := ucSurrogate
  else if (s = 'CO') then
    Result := ucPrivateUse
  else
    Result := ucUnassigned;
end;

function StringToCodePoint(ACP : string) : TUnicodeCodePoint;
var
  s : string;
begin
  s := Trim(ACP);
  Result := 0;
  if (Length(s) > 0) and (s <> '#') then
    Result := StrToInt('$' + s);
end;

{function IsWhiteSpace(const ACodePoint : TUnicodeCodePoint) : Boolean;
begin
  case ACodePoint of
    $0009..$000D  : Result := True;// White_Space # Cc   [5] <control-0009>..<control-000D>
    $0020          : Result := True;// White_Space # Zs       SPACE
    $0085          : Result := True;// White_Space # Cc       <control-0085>
    $00A0          : Result := True;// White_Space # Zs       NO-BREAK SPACE
    $1680          : Result := True;// White_Space # Zs       OGHAM SPACE MARK
    $180E          : Result := True;// White_Space # Zs       MONGOLIAN VOWEL SEPARATOR
    $2000..$200A   : Result := True;// White_Space # Zs  [11] EN QUAD..HAIR SPACE
    $2028          : Result := True;// White_Space # Zl       LINE SEPARATOR
    $2029          : Result := True;// White_Space # Zp       PARAGRAPH SEPARATOR
    $202F          : Result := True;// White_Space # Zs       NARROW NO-BREAK SPACE
    $205F          : Result := True;// White_Space # Zs       MEDIUM MATHEMATICAL SPACE
    $3000          : Result := True;// White_Space # Zs       IDEOGRAPHIC SPACE
    else
      Result := False;
  end;
end;}
function IsWhiteSpace(
  const ACodePoint   : TUnicodeCodePoint;
  const AWhiteSpaces : TCodePointRecArray
) : Boolean;
var
  i : Integer;
  p : ^TCodePointRec;
begin
  p := @AWhiteSpaces[Low(AWhiteSpaces)];
  for i := Low(AWhiteSpaces) to High(AWhiteSpaces) do begin
    if (p^.LineType = 0) then begin
      if (p^.CodePoint = ACodePoint) then
        exit(True);
    end else begin
      if (ACodePoint >= p^.StartCodePoint) and (ACodePoint <= p^.EndCodePoint) then
        exit(True);
    end;
    Inc(p);
  end;
  Result := False;
end;

function NormalizeBlockName(const AName : string) : string;
var
  i, c, k : Integer;
  s : string;
begin
  c := Length(AName);
  SetLength(Result,c);
  s := LowerCase(AName);
  k := 0;
  for i := 1 to c do begin
    if (s[1] in ['a'..'z','0'..'9','-']) then begin
      k := k + 1;
      Result[k] := s[i];
    end;
  end;
  SetLength(Result,k);
end;

procedure ParseBlokcs(
      ADataAStream   : TMemoryStream;
  var ABlocks        : TBlocks
);
const READ_BUFFER_LENGTH = 1024*8;
      LINE_LENGTH        = 1024;
      DATA_LENGTH        = 25000;
var
  p : PAnsiChar;
  actualDataLen : Integer;
  bufferLength, bufferPos, lineLength, linePos : Integer;
  line : ansistring;

  function NextLine() : Boolean;
  var
    k, locOldPos : Integer;
    locOldPointer : PAnsiChar;
  begin
    Result := False;
    locOldPointer := p;
    locOldPos := bufferPos;
    while (bufferPos < bufferLength) and (p^ <> #10) do begin
      Inc(p);
      Inc(bufferPos);
    end;
    if (locOldPos = bufferPos) and (p^ = #10) then begin
      lineLength := 0;
      Inc(p);
      Inc(bufferPos);
      linePos := 1;
      Result := True;
    end else  if (locOldPos < bufferPos) then begin
      lineLength := (bufferPos - locOldPos);
      Move(locOldPointer^,line[1],lineLength);
      if (p^ = #10) then begin
        Dec(lineLength);
        Inc(p);
        Inc(bufferPos);
      end;
      linePos := 1;
      Result := True;
    end;
  end;

  function NextToken() : ansistring;
  var
    k : Integer;
  begin
    k := linePos;
    if (linePos < lineLength) and (line[linePos] in [';','#','.']) then begin
      Inc(linePos);
      Result := Copy(line,k,(linePos-k));
      exit;
    end;
    while (linePos < lineLength) and not(line[linePos] in [';','#','.']) do
      Inc(linePos);
    if (linePos > k) then begin
      if (line[linePos] in [';','#','.']) then
        Result := Copy(line,k,(linePos-k))
      else
        Result := Copy(line,k,(linePos-k+1));
      Result := Trim(Result);
    end else begin
      Result := '';
    end;
  end;

  procedure ParseLine();
  var
    locCP : Cardinal;
    locData : TBlockItemRec;
    s : ansistring;
  begin
    s := NextToken();
    if (s = '') or (s[1] = '#') then
      exit;
    locData.RangeStart := StrToInt('$'+s);
    s := NextToken();
    if (s <> '.') then
      raise Exception.CreateFmt('"." expected but "%s" found.',[s]);
    s := NextToken();
    if (s <> '.') then
      raise Exception.CreateFmt('"." expected but "%s" found.',[s]);
    s := NextToken();
    locData.RangeEnd := StrToInt('$'+s);
    s := NextToken();
    if (s <> ';') then
      raise Exception.CreateFmt('";" expected but "%s" found.',[s]);
    locData.Name := Trim(NextToken());
    locData.CanonicalName := NormalizeBlockName(locData.Name);
    if (Length(ABlocks) <= actualDataLen) then
      SetLength(ABlocks,Length(ABlocks)*2);
    ABlocks[actualDataLen] := locData;
    Inc(actualDataLen);
  end;

  procedure Prepare();
  var
    r : TPropRec;
  begin
    SetLength(ABlocks,DATA_LENGTH);
    actualDataLen := 0;
    bufferLength := ADataAStream.Size;
    bufferPos := 0;
    p := ADataAStream.Memory;
    lineLength := 0;
    SetLength(line,LINE_LENGTH);
  end;

begin
  Prepare();
  while NextLine() do
    ParseLine();
  SetLength(ABlocks,actualDataLen);
end;

procedure ParseProps(
      ADataAStream   : TMemoryStream;
  var APropList      : TPropListLineRecArray
);
const READ_BUFFER_LENGTH = 1024*8;
      LINE_LENGTH        = 1024;
      DATA_LENGTH        = 25000;
var
  p : PAnsiChar;
  actualDataLen : Integer;
  bufferLength, bufferPos, lineLength, linePos : Integer;
  line : ansistring;

  function NextLine() : Boolean;
  var
    k, locOldPos : Integer;
    locOldPointer : PAnsiChar;
  begin
    Result := False;
    locOldPointer := p;
    locOldPos := bufferPos;
    while (bufferPos < bufferLength) and (p^ <> #10) do begin
      Inc(p);
      Inc(bufferPos);
    end;
    if (locOldPos = bufferPos) and (p^ = #10) then begin
      lineLength := 0;
      Inc(p);
      Inc(bufferPos);
      linePos := 1;
      Result := True;
    end else  if (locOldPos < bufferPos) then begin
      lineLength := (bufferPos - locOldPos);
      Move(locOldPointer^,line[1],lineLength);
      if (p^ = #10) then begin
        Dec(lineLength);
        Inc(p);
        Inc(bufferPos);
      end;
      linePos := 1;
      Result := True;
    end;
  end;

  function NextToken() : ansistring;
  var
    k : Integer;
  begin
    k := linePos;
    if (linePos < lineLength) and (line[linePos] in [';','#','.']) then begin
      Inc(linePos);
      Result := Copy(line,k,(linePos-k));
      exit;
    end;
    while (linePos < lineLength) and not(line[linePos] in [';','#','.']) do
      Inc(linePos);
    if (linePos > k) then begin
      if (line[linePos] in [';','#','.']) then
        Result := Copy(line,k,(linePos-k))
      else
        Result := Copy(line,k,(linePos-k+1));
      Result := Trim(Result);
    end else begin
      Result := '';
    end;
  end;

  procedure ParseLine();
  var
    locCP : Cardinal;
    locData : TPropListLineRec;
    s : ansistring;
  begin
    s := NextToken();
    if (s = '') or (s[1] = '#') then
      exit;
    locCP := StrToInt('$'+s);
    s := NextToken();
    if (s = ';') then begin
      locData.CodePoint.LineType := 0;
      locData.CodePoint.CodePoint := locCP;
    end else begin
      if (s = '') or (s <> '.') or (NextToken() <> '.') then
        raise Exception.CreateFmt('Invalid line : "%s".',[Copy(line,1,lineLength)]);
      locData.CodePoint.LineType := 1;
      locData.CodePoint.StartCodePoint := locCP;
      locData.CodePoint.EndCodePoint := StrToInt('$'+NextToken());
      s := NextToken();
      if (s <> ';') then
        raise Exception.CreateFmt('"." expected but "%s" found.',[s]);
    end;
    locData.PropName := Trim(NextToken());
    if (Length(APropList) <= actualDataLen) then
      SetLength(APropList,Length(APropList)*2);
    APropList[actualDataLen] := locData;
    Inc(actualDataLen);
  end;

  procedure Prepare();
  var
    r : TPropRec;
  begin
    SetLength(APropList,DATA_LENGTH);
    actualDataLen := 0;
    bufferLength := ADataAStream.Size;
    bufferPos := 0;
    p := ADataAStream.Memory;
    lineLength := 0;
    SetLength(line,LINE_LENGTH);
  end;

begin
  Prepare();
  while NextLine() do
    ParseLine();
  SetLength(APropList,actualDataLen);
end;

function FindCodePointsByProperty(
  const APropName : string;
  const APropList : TPropListLineRecArray
) : TCodePointRecArray;
var
  r : TCodePointRecArray;
  i, k : Integer;
  s : string;
begin
  k := 0;
  r := nil;
  s := LowerCase(Trim(APropName));
  for i := Low(APropList) to High(APropList) do begin
    if (LowerCase(APropList[i].PropName) = s) then begin
      if (k >= Length(r)) then begin
        if (k = 0) then
          SetLength(r,24)
        else
          SetLength(r,(2*Length(r)));
      end;
      r[k] := APropList[i].CodePoint;
      Inc(k);
    end;
  end;
  SetLength(r,k);
  Result := r;
end;

procedure ParseHangulSyllableTypes(
      ADataAStream   : TMemoryStream;
  var ACodePointList : TCodePointRecArray
);
const READ_BUFFER_LENGTH = 1024*8;
      LINE_LENGTH        = 1024;
      DATA_LENGTH        = 25000;
var
  p : PAnsiChar;
  actualDataLen : Integer;
  bufferLength, bufferPos, lineLength, linePos : Integer;
  line : ansistring;

  function NextLine() : Boolean;
  var
    k, locOldPos : Integer;
    locOldPointer : PAnsiChar;
  begin
    Result := False;
    locOldPointer := p;
    locOldPos := bufferPos;
    while (bufferPos < bufferLength) and (p^ <> #10) do begin
      Inc(p);
      Inc(bufferPos);
    end;
    if (locOldPos = bufferPos) and (p^ = #10) then begin
      lineLength := 0;
      Inc(p);
      Inc(bufferPos);
      linePos := 1;
      Result := True;
    end else  if (locOldPos < bufferPos) then begin
      lineLength := (bufferPos - locOldPos);
      Move(locOldPointer^,line[1],lineLength);
      if (p^ = #10) then begin
        Dec(lineLength);
        Inc(p);
        Inc(bufferPos);
      end;
      linePos := 1;
      Result := True;
    end;
  end;

  function NextToken() : ansistring;
  var
    k : Integer;
  begin
    k := linePos;
    if (linePos < lineLength) and (line[linePos] = '.') then begin
      Inc(linePos);
      while (linePos < lineLength) and (line[linePos] = '.') do begin
        Inc(linePos);
      end;
      Result := Copy(line,k,(linePos-k));
      exit;
    end;
    while (linePos < lineLength) and not(line[linePos] in [';','#','.']) do
      Inc(linePos);
    if (linePos > k) then begin
      if (line[linePos] in [';','#','.']) then
        Result := Copy(line,k,(linePos-k))
      else
        Result := Copy(line,k,(linePos-k+1));
      Result := Trim(Result);
    end else begin
      Result := '';
    end;
    //Inc(linePos);
  end;

  procedure ParseLine();
  var
    locCP : Cardinal;
    locData : TCodePointRec;
    s : ansistring;
  begin
    s := NextToken();
    if (s = '') or (s[1] = '#') then
      exit;
    locData.CodePoint := StrToInt('$'+s);
    s := NextToken();
    if (s = '') or (s[1] in [';','#']) then begin
      locData.LineType := 0;
    end else begin
      if (s <> '..') then
        raise Exception.CreateFmt('Unknown line type : "%s"',[Copy(line,1,lineLength)]);
      locData.StartCodePoint := locData.CodePoint;
      locData.EndCodePoint := StrToInt('$'+NextToken());
      locData.LineType := 1;
    end;
    if (Length(ACodePointList) <= actualDataLen) then
      SetLength(ACodePointList,Length(ACodePointList)*2);
    ACodePointList[actualDataLen] := locData;
    Inc(actualDataLen);
  end;

  procedure Prepare();
  var
    r : TPropRec;
  begin
    SetLength(ACodePointList,DATA_LENGTH);
    actualDataLen := 0;
    bufferLength := ADataAStream.Size;
    bufferPos := 0;
    p := ADataAStream.Memory;
    lineLength := 0;
    SetLength(line,LINE_LENGTH);
  end;

begin
  Prepare();
  while NextLine() do
    ParseLine();
  SetLength(ACodePointList,actualDataLen);
end;

function IsHangulSyllable(
  const ACodePoint  : TUnicodeCodePoint;
  const AHangulList : TCodePointRecArray
) : Boolean;
var
  i : Integer;
  p : ^TCodePointRec;
begin
  Result := False;
  p := @AHangulList[Low(AHangulList)];
  for i := Low(AHangulList) to High(AHangulList) do begin
    if ( (p^.LineType = 0) and (ACodePoint = p^.CodePoint) ) or
       ( (p^.LineType = 1) and (ACodePoint >= p^.StartCodePoint) and (ACodePoint <= p^.EndCodePoint) )
    then begin
      Result := True;
      Break;
    end;
    Inc(p);
  end;
end;

function IndexOf(
  const AProp     : TPropRec;
  const APropList : TPropRecArray;
  const AActualLen : Integer
) : Integer;overload;
var
  i : Integer;
  p : PPropRec;
begin
  Result := -1;
  if (AActualLen > 0) then begin
    p := @APropList[0];
    for i := 0 to AActualLen - 1 do begin
      if (AProp.Category = p^.Category) and
         (AProp.CCC = p^.CCC) and
         (AProp.NumericIndex = p^.NumericIndex) and
         (AProp.SimpleUpperCase = p^.SimpleUpperCase) and
         (AProp.SimpleLowerCase = p^.SimpleLowerCase) and
         (AProp.WhiteSpace = p^.WhiteSpace) and
         //
         (AProp.DecompositionID =  p^.DecompositionID) and
         (*   ( (AProp.DecompositionID = -1 ) and (p^.DecompositionID = -1) ) or
             ( (AProp.DecompositionID <> -1 ) and (p^.DecompositionID <> -1) )
         *)
         (AProp.HangulSyllable = p^.HangulSyllable)
      then begin
        Result := i;
        Break;
      end;
      Inc(p);
    end;
  end;
end;

function IndexOf(
  const AItem : TUnicodeCodePointArray;
  const AList : TDecompositionArray
) : Integer;overload;
var
  p : TUnicodeCodePointArray;
  i : Integer;
begin
  Result := -1;
  if (Length(AList) = 0) then
    exit;
  for i := Low(AList) to High(AList) do begin
    p := AList[i];
    if (Length(p) = Length(AItem)) then begin
      if CompareMem(@p[0],@AItem[0],Length(AItem)*SizeOf(TUnicodeCodePoint)) then
        exit(i);
    end;
  end;
  Result := -1;
end;

function IndexOf(
  const AItem : TNumericValue;
  const AList : TNumericValueArray;
  const AActualLen : Integer
) : Integer;overload;
var
  p : ^TNumericValue;
  i : Integer;
begin
  Result := -1;
  if (AActualLen = 0) then
    exit;
  p := @AList[Low(AList)];
  for i := Low(AList) to AActualLen - 1 do begin
    if (AItem = p^) then
      exit(i);
    Inc(p);
  end;
  Result := -1;
end;

procedure Parse_UnicodeData(
        ADataAStream   : TMemoryStream;
  var   APropList      : TPropRecArray;
  var   ANumericTable  : TNumericValueArray;
  var   ADataLineList  : TDataLineRecArray;
  var   ADecomposition : TDecompositionArray;
  const AHangulList    : TCodePointRecArray;
  const AWhiteSpaces   : TCodePointRecArray
);
const READ_BUFFER_LENGTH = 1024*8;
      LINE_LENGTH        = 1024;
      PROP_LENGTH        = 5000;
      DATA_LENGTH        = 25000;
var
  p : PAnsiChar;
  bufferLength, bufferPos : Integer;
  actualPropLen, actualDataLen, actualNumLen : Integer;
  line : ansistring;
  lineLength, linePos : Integer;

  function NextLine() : Boolean;
  var
    k, locOldPos : Integer;
    locOldPointer : PAnsiChar;
  begin
    Result := False;
    locOldPointer := p;
    locOldPos := bufferPos;
    while (bufferPos < bufferLength) and (p^ <> #10) do begin
      Inc(p);
      Inc(bufferPos);
    end;
    if (locOldPos < bufferPos) then begin
      lineLength := (bufferPos - locOldPos);
      Move(locOldPointer^,line[1],lineLength);
      if (p^ = #10) then begin
        Dec(lineLength);
        Inc(p);
        Inc(bufferPos);
      end;
      if (lineLength > 7) then begin
        linePos := 1;
        Result := True;
      end;
    end;
  end;

  function NextToken() : ansistring;
  var
    k : Integer;
  begin
    k := linePos;
    while (linePos < lineLength) and not(line[linePos] in [';','#']) do
      Inc(linePos);
    if (linePos > k) then begin
      if (line[linePos] in [';','#']) then
        Result := Copy(line,k,(linePos-k))
      else
        Result := Copy(line,k,(linePos-k+1));
      Result := Trim(Result);
    end else begin
      Result := '';
    end;
    Inc(linePos);
  end;

  function ParseCanonicalDecomposition(AStr : ansistring) : TUnicodeCodePointArray;
  var
    locStr, ks : ansistring;
    k0,k, cp : Integer;
  begin
    SetLength(Result,0);
    locStr := UpperCase(Trim(AStr));
    if (locStr = '') or (locStr[1] = '<') then
      exit;
    k0 := 1;
    k := 1;
    while (k <= Length(locStr)) do begin
      while (k <= Length(locStr)) and (locStr[k] in ['0'..'9','A'..'F']) do
        inc(k);
      ks := Trim(Copy(locStr,k0,k-k0));
      SetLength(Result,Length(Result)+1);
      Result[Length(Result)-1] := StringToCodePoint(ks);
      Inc(k);
      k0 := k;
    end;
  end;

  procedure ParseLine();
  var
    locCP : TUnicodeCodePoint;
    locProp : TPropRec;
    locData : TDataLineRec;
    s : ansistring;
    locRangeStart, locRangeEnd : Boolean;
    k : Integer;
    locDecompItem : TUnicodeCodePointArray;
    numVal : TNumericValue;
  begin
    FillChar(locData,SizeOf(locData),#0);
    FillChar(locProp,SizeOf(locProp),#0);
    locCP := StrToInt('$'+NextToken());
    s := NextToken();
    locRangeStart := AnsiEndsText(', First>',s);
    if locRangeStart then
      locRangeEnd := False
    else
      locRangeEnd := AnsiEndsText(', Last>',s);
    if locRangeStart then begin
      locData.LineType := 1;
      locData.StartCodePoint := locCP;
    end else if locRangeEnd then begin
      ADataLineList[actualDataLen - 1].EndCodePoint := locCP;
      exit;
      //locData.EndCodePoint := locCP;
    end else begin
      locData.LineType := 0;
      locData.CodePoint := locCP;
    end;
    locProp.Category := StrToCategory(NextToken());
    locProp.CCC := StrToInt(NextToken());//Canonical_Combining_Class
    NextToken();//Bidi_Class
    s := NextToken();//Decomposition_Type
    locDecompItem := ParseCanonicalDecomposition(s);
    if (Length(locDecompItem) = 0) then
      locProp.DecompositionID := -1
    else begin
      locProp.DecompositionID := IndexOf(locDecompItem,ADecomposition);
      if (locProp.DecompositionID = -1) then begin
        k := Length(ADecomposition);
        locProp.DecompositionID := k;
        SetLength(ADecomposition,k+1);
        ADecomposition[k] := locDecompItem;
      end;
    end;

    numVal := EvaluateFloat(NextToken());
    if (numVal <> Double(0.0)) then begin
      NextToken();
      NextToken();
    end else begin
      s := NextToken();
      if (s <> '') then
        numVal := EvaluateFloat(s);
      s := NextToken();
      if (numVal = Double(0.0)) then
        numVal := EvaluateFloat(s);
    end;
    k := IndexOf(numVal,ANumericTable,actualNumLen);
    if (k = -1) then begin
      if (actualNumLen >= Length(ANumericTable)) then
        SetLength(ANumericTable,(actualNumLen*2));
      ANumericTable[actualNumLen] := numVal;
      k := actualNumLen;
      Inc(actualNumLen);
    end;
    locProp.NumericIndex := k;

    NextToken();//Bidi_Mirroed
    NextToken();//Unicode_l_Name
    NextToken();//ISO_Comment
    locProp.SimpleUpperCase := StringToCodePoint(NextToken());
    locProp.SimpleLowerCase := StringToCodePoint(NextToken());
    NextToken();//Simple_Title_Case_Mapping
    locProp.WhiteSpace := IsWhiteSpace(locCP,AWhiteSpaces);
    locProp.HangulSyllable := IsHangulSyllable(locCP,AHangulList);
    k := IndexOf(locProp,APropList,actualPropLen);
    if (k = -1) then begin
      k := actualPropLen;
      locProp.PropID := k{ + 1};
      APropList[k] := locProp;
      Inc(actualPropLen);
    end;
    locData.PropID := k;
    ADataLineList[actualDataLen] := locData;
    Inc(actualDataLen);
  end;

  procedure Prepare();
  var
    r : TPropRec;
  begin
    SetLength(APropList,PROP_LENGTH);
    actualPropLen := 0;
    SetLength(ADataLineList,DATA_LENGTH);
    actualDataLen := 0;
    bufferLength := ADataAStream.Size;
    bufferPos := 0;
    p := ADataAStream.Memory;
    lineLength := 0;
    SetLength(line,LINE_LENGTH);
    SetLength(ANumericTable,500);
    actualNumLen := 0;

    FillChar(r,SizeOf(r),#0);
    r.PropID := 0;
    r.Category := ucUnassigned;
    r.DecompositionID := -1;
    r.NumericIndex := 0;
    APropList[0] := r;
    Inc(actualPropLen);
    ANumericTable[0] := 0;
    Inc(actualNumLen);
  end;

begin
  Prepare();
  while NextLine() do
    ParseLine();
  SetLength(APropList,actualPropLen);
  SetLength(ADataLineList,actualDataLen);
  SetLength(ANumericTable,actualNumLen);
end;

function GetPropID(
        ACodePoint    : TUnicodeCodePoint;
  const ADataLineList : TDataLineRecArray
) : Cardinal;
var
  i : Integer;
  p : PDataLineRec;
begin
  Result := 0;
  p := @ADataLineList[Low(ADataLineList)];
  for i := Low(ADataLineList) to High(ADataLineList) do begin
    if (p^.LineType = 0) then begin
      if (p^.CodePoint = ACodePoint) then begin
        Result := p^.PropID;
        Break;
      end;
    end else begin
      if (p^.StartCodePoint <= ACodePoint) and (p^.EndCodePoint >= ACodePoint) then begin
        Result := p^.PropID;
        Break;
      end;
    end;
    Inc(p);
  end;
end;

procedure MakeDecomposition(
  const ARawData : TDecompositionArray;
  var   ABook    : TDecompositionBook
);
var
  i, c, locPos : Integer;
  locItem : TUnicodeCodePointArray;
begin
  c := 0;
  for i := Low(ARawData) to High(ARawData) do
    c := c + Length(ARawData[i]);
  SetLength(ABook.CodePoints,c);
  SetLength(ABook.Index,Length(ARawData));
  locPos := 0;
  for i := Low(ARawData) to High(ARawData) do begin
    locItem := ARawData[i];
    ABook.Index[i].StartPosition := locPos;
    ABook.Index[i].Length := Length(locItem);
    Move(locItem[0],ABook.CodePoints[locPos],(Length(locItem) * SizeOf(TUnicodeCodePoint)));
    locPos := locPos + Length(locItem);
  end;
end;

type
  PBmpSecondTableItem = ^TBmpSecondTableItem;
function IndexOf(
  const AItem  : PBmpSecondTableItem;
  const ATable : TBmpSecondTable;
  const ATableActualLength : Integer
) : Integer;overload;
var
  i : Integer;
  p : PBmpSecondTableItem;
begin
  Result := -1;
  if (ATableActualLength > 0) then begin
    p := @ATable[0];
    for i := 0 to ATableActualLength - 1 do begin
      if CompareMem(p,AItem,SizeOf(TBmpSecondTableItem)) then begin
        Result := i;
        Break;
      end;
      Inc(p);
    end;
  end;
end;

procedure MakeBmpTables(
  var   AFirstTable   : TBmpFirstTable;
  var   ASecondTable  : TBmpSecondTable;
  const APropList     : TPropRecArray;
  const ADataLineList : TDataLineRecArray
);
var
  locLowByte, locHighByte : Byte;
  locTableItem : TBmpSecondTableItem;
  locCP : TUnicodeCodePoint;
  i, locSecondActualLen : Integer;
begin
  SetLength(ASecondTable,120);
  locSecondActualLen := 0;
  for locHighByte := 0 to 255 do begin
    FillChar(locTableItem,SizeOf(locTableItem),#0);
    for locLowByte := 0 to 255 do begin
      locCP := (locHighByte * 256) + locLowByte;
      locTableItem[locLowByte] := GetPropID(locCP,ADataLineList)// - 1;
    end;
    i := IndexOf(@locTableItem,ASecondTable,locSecondActualLen);
    if (i = -1) then begin
      if (locSecondActualLen = Length(ASecondTable)) then
        SetLength(ASecondTable,locSecondActualLen + 50);
      i := locSecondActualLen;
      ASecondTable[i] := locTableItem;
      Inc(locSecondActualLen);
    end;
    AFirstTable[locHighByte] := i;
  end;
  SetLength(ASecondTable,locSecondActualLen);
end;

type
  P3lvlBmp3TableItem = ^T3lvlBmp3TableItem;
function IndexOf(
  const AItem  : P3lvlBmp3TableItem;
  const ATable : T3lvlBmp3Table;
  const ATableActualLength : Integer
) : Integer;overload;
var
  i : Integer;
  p : P3lvlBmp3TableItem;
begin
  Result := -1;
  if (ATableActualLength > 0) then begin
    p := @ATable[0];
    for i := 0 to ATableActualLength - 1 do begin
      if CompareMem(p,AItem,SizeOf(T3lvlBmp3TableItem)) then begin
        Result := i;
        Break;
      end;
      Inc(p);
    end;
  end;
end;

type
  P3lvlBmp2TableItem = ^T3lvlBmp2TableItem;
function IndexOf(
  const AItem  : P3lvlBmp2TableItem;
  const ATable : T3lvlBmp2Table
) : Integer;overload;
var
  i : Integer;
  p : P3lvlBmp2TableItem;
begin
  Result := -1;
  if (Length(ATable) > 0) then begin
    p := @ATable[0];
    for i := 0 to Length(ATable) - 1 do begin
      if CompareMem(p,AItem,SizeOf(T3lvlBmp2TableItem)) then begin
        Result := i;
        Break;
      end;
      Inc(p);
    end;
  end;
end;
procedure MakeBmpTables3Levels(
  var   AFirstTable   : T3lvlBmp1Table;
  var   ASecondTable  : T3lvlBmp2Table;
  var   AThirdTable  : T3lvlBmp3Table;
  const ADataLineList : TDataLineRecArray
);
var
  locLowByte0, locLowByte1, locHighByte : Byte;
  locTableItem2 : T3lvlBmp2TableItem;
  locTableItem3 : T3lvlBmp3TableItem;
  locCP : TUnicodeCodePoint;
  i, locThirdActualLen : Integer;
begin
  SetLength(AThirdTable,120);
  locThirdActualLen := 0;
  for locHighByte := 0 to 255 do begin
    FillChar(locTableItem2,SizeOf(locTableItem2),#0);
    for locLowByte0 := 0 to 15 do begin
      FillChar(locTableItem3,SizeOf(locTableItem3),#0);
      for locLowByte1 := 0 to 15 do begin
        locCP := (locHighByte * 256) + (locLowByte0*16) + locLowByte1;
        locTableItem3[locLowByte1] := GetPropID(locCP,ADataLineList);
      end;
      i := IndexOf(@locTableItem3,AThirdTable,locThirdActualLen);
      if (i = -1) then begin
        if (locThirdActualLen = Length(AThirdTable)) then
          SetLength(AThirdTable,locThirdActualLen + 50);
        i := locThirdActualLen;
        AThirdTable[i] := locTableItem3;
        Inc(locThirdActualLen);
      end;
      locTableItem2[locLowByte0] := i;
    end;
    i := IndexOf(@locTableItem2,ASecondTable);
    if (i = -1) then begin
      i := Length(ASecondTable);
      SetLength(ASecondTable,(i + 1));
      ASecondTable[i] := locTableItem2;
    end;
    AFirstTable[locHighByte] := i;
  end;
  SetLength(AThirdTable,locThirdActualLen);
end;

procedure GenerateLicenceText(ADest : TStream);
var
  s : ansistring;
begin
  s := SLicenseText + sLineBreak + sLineBreak;
  ADest.Write(s[1],Length(s));
end;

procedure GenerateBmpTables(
        ADest : TStream;
  var   AFirstTable   : TBmpFirstTable;
  var   ASecondTable  : TBmpSecondTable
);
  procedure AddLine(const ALine : ansistring);
  var
    buffer : ansistring;
  begin
    buffer := ALine + sLineBreak;
    ADest.Write(buffer[1],Length(buffer));
  end;

var
  i, j, c : Integer;
  locLine : string;
begin
  AddLine('const');
  AddLine('  UC_TABLE_1 : array[0..255] of Byte = (');
  locLine := '';
  for i := Low(AFirstTable) to High(AFirstTable) - 1 do begin
    locLine := locLine + IntToStr(AFirstTable[i]) + ',';
    if (((i+1) mod 16) = 0) then begin
      locLine := '    ' + locLine;
      AddLine(locLine);
      locLine := '';
    end;
  end;
  locLine := locLine + IntToStr(AFirstTable[High(AFirstTable)]);
  locLine := '    ' + locLine;
  AddLine(locLine);
  AddLine('  );' + sLineBreak);

  AddLine('  UC_TABLE_2 : array[0..(256*' + IntToStr(Length(ASecondTable)) +'-1)] of Word =(');
  c := High(ASecondTable);
  for i := Low(ASecondTable) to c do begin
    locLine := '';
    for j := Low(TBmpSecondTableItem) to High(TBmpSecondTableItem) do begin
      locLine := locLine + IntToStr(ASecondTable[i][j]) + ',';
      if (((j+1) mod 16) = 0) then begin
        if (i = c) and (j = 255) then
          Delete(locLine,Length(locLine),1);
        locLine := '    ' + locLine;
        AddLine(locLine);
        locLine := '';
      end;
    end;
  end;
  AddLine('  );' + sLineBreak);
end;

//----------------------------------
procedure Generate3lvlBmpTables(
        ADest : TStream;
  var   AFirstTable   : T3lvlBmp1Table;
  var   ASecondTable  : T3lvlBmp2Table;
  var   AThirdTable   : T3lvlBmp3Table
);

  procedure AddLine(const ALine : ansistring);
  var
    buffer : ansistring;
  begin
    buffer := ALine + sLineBreak;
    ADest.Write(buffer[1],Length(buffer));
  end;

var
  i, j, c : Integer;
  locLine : string;
begin
  AddLine('const');
  AddLine('  UC_TABLE_1 : array[0..255] of Byte = (');
  locLine := '';
  for i := Low(AFirstTable) to High(AFirstTable) - 1 do begin
    locLine := locLine + IntToStr(AFirstTable[i]) + ',';
    if (((i+1) mod 16) = 0) then begin
      locLine := '    ' + locLine;
      AddLine(locLine);
      locLine := '';
    end;
  end;
  locLine := locLine + IntToStr(AFirstTable[High(AFirstTable)]);
  locLine := '    ' + locLine;
  AddLine(locLine);
  AddLine('  );' + sLineBreak);

  AddLine('  UC_TABLE_2 : array[0..' + IntToStr(Length(ASecondTable)-1) +'] of array[0..15] of Word = (');
  c := High(ASecondTable);
  for i := Low(ASecondTable) to c do begin
    locLine := '(';
    for j := Low(T3lvlBmp2TableItem) to High(T3lvlBmp2TableItem) do
      locLine := locLine + IntToStr(ASecondTable[i][j]) + ',';
    Delete(locLine,Length(locLine),1);
    locLine := '    ' + locLine + ')';
    if (i < c) then
      locLine := locLine + ',';
    AddLine(locLine);
  end;
  AddLine('  );' + sLineBreak);

  AddLine('  UC_TABLE_3 : array[0..' + IntToStr(Length(AThirdTable)-1) +'] of array[0..15] of Word = (');
  c := High(AThirdTable);
  for i := Low(AThirdTable) to c do begin
    locLine := '(';
    for j := Low(T3lvlBmp3TableItem) to High(T3lvlBmp3TableItem) do
      locLine := locLine + IntToStr(AThirdTable[i][j]) + ',';
    Delete(locLine,Length(locLine),1);
    locLine := '    ' + locLine + ')';
    if (i < c) then
      locLine := locLine + ',';
    AddLine(locLine);
  end;
  AddLine('  );' + sLineBreak);
end;

function UInt24ToStr(const AValue : UInt24; const AEndian : TEndianKind): string;inline;
begin
  if (AEndian = ekBig) then
    Result := Format(
                '(byte2 : $%s; byte1 : $%s; byte0 : $%s;)',
                [ IntToHex(AValue.byte2,2), IntToHex(AValue.byte1,2),
                  IntToHex(AValue.byte0,2)
                ]
              )
  else
    Result := Format(
                '(byte0 : $%s; byte1 : $%s; byte2 : $%s;)',
                [ IntToHex(AValue.byte0,2), IntToHex(AValue.byte1,2),
                  IntToHex(AValue.byte2,2)
                ]
              );
end;

procedure GeneratePropTable(
        ADest     : TStream;
  const APropList : TPropRecArray;
  const AEndian   : TEndianKind
);

  procedure AddLine(const ALine : ansistring);
  var
    buffer : ansistring;
  begin
    buffer := ALine + sLineBreak;
    ADest.Write(buffer[1],Length(buffer));
  end;

var
  i : Integer;
  locLine : string;
  pti : PTypeInfo;
  p : PPropRec;
begin
  pti := TypeInfo(TUnicodeCategory);
  AddLine('');
  AddLine('const');
  AddLine('  UC_PROP_REC_COUNT = ' + IntToStr(Length(APropList)) + ';');
  AddLine('  UC_PROP_ARRAY : array[0..(UC_PROP_REC_COUNT-1)] of TUC_Prop = (');
  p := @APropList[0];
  for i := Low(APropList) to High(APropList) - 1 do begin
    locLine := //'    (Category : TUnicodeCategory.' + GetEnumName(pti,Ord(p^.Category)) + ';' +
               '    (CategoryData : ' + IntToStr(p^.CategoryData) + ';' +
               ' CCC : ' + IntToStr(p^.CCC) + ';' +
               ' NumericIndex : ' + IntToStr(p^.NumericIndex) + ';' +
               ' SimpleUpperCase : ' + UInt24ToStr(p^.SimpleUpperCase,AEndian) + ';' +
               ' SimpleLowerCase : ' + UInt24ToStr(p^.SimpleLowerCase,AEndian) + ';' +
               ' DecompositionID : ' + IntToStr(p^.DecompositionID) + '),';
    AddLine(locLine);
    Inc(p);
  end;
  locLine := //'    (Category : TUnicodeCategory.' + GetEnumName(pti,Ord(p^.Category)) + ';' +
             '    (CategoryData : ' + IntToStr(p^.CategoryData) + ';' +
             ' CCC : ' + IntToStr(p^.CCC) + ';' +
             ' NumericIndex : ' + IntToStr(p^.NumericIndex) + ';' +
             ' SimpleUpperCase : ' + UInt24ToStr(p^.SimpleUpperCase,AEndian) + ';' +
             ' SimpleLowerCase : ' + UInt24ToStr(p^.SimpleLowerCase,AEndian) + ';' +
             ' DecompositionID : ' + IntToStr(p^.DecompositionID) + ')';
  AddLine(locLine);
  AddLine('  );' + sLineBreak);
end;

procedure GenerateNumericTable(
        ADest         : TStream;
  const ANumList      : TNumericValueArray;
  const ACompleteUnit : Boolean
);

  procedure AddLine(const ALine : ansistring);
  var
    buffer : ansistring;
  begin
    buffer := ALine + sLineBreak;
    ADest.Write(buffer[1],Length(buffer));
  end;

var
  i : Integer;
  locLine : string;
  p : ^TNumericValue;
begin
  if ACompleteUnit then begin
    GenerateLicenceText(ADest);
    AddLine('unit unicodenumtable;');
    AddLine('interface');
    AddLine('');
  end;
  AddLine('');
  AddLine('const');
  AddLine('  UC_NUMERIC_COUNT = ' + IntToStr(Length(ANumList)) + ';');
  AddLine('  UC_NUMERIC_ARRAY : array[0..(UC_NUMERIC_COUNT-1)] of Double = (');
  locLine := '';
  p := @ANumList[0];
  for i := Low(ANumList) to High(ANumList) - 1 do begin
    locLine := locLine + FloatToStr(p^,FS) + ' ,';
    if (i > 0) and ((i mod 8) = 0) then begin
      AddLine('    ' + locLine);
      locLine := '';
    end;
    Inc(p);
  end;
  locLine := locLine + FloatToStr(p^,FS);
  AddLine('    ' + locLine);
  AddLine('  );' + sLineBreak);
  if ACompleteUnit then begin
    AddLine('');
    AddLine('implementation');
    AddLine('');
    AddLine('end.');
  end;
end;

procedure GenerateDecompositionBookTable(
        ADest   : TStream;
  const ABook   : TDecompositionBook;
  const AEndian : TEndianKind
);

  procedure AddLine(const ALine : ansistring);
  var
    buffer : ansistring;
  begin
    buffer := ALine + sLineBreak;
    ADest.Write(buffer[1],Length(buffer));
  end;

var
  i, k : Integer;
  p : ^TDecompositionIndexRec;
  cp : ^TUnicodeCodePoint;
  cp24 : UInt24;
  locLine : string;
begin
  AddLine('const');
  AddLine('  UC_DEC_BOOK_INDEX_LENGTH = ' + IntToStr(Length(ABook.Index)) + ';');
  AddLine('  UC_DEC_BOOK_DATA_LENGTH = ' + IntToStr(Length(ABook.CodePoints)) + ';');
  AddLine('type');
  AddLine('  TDecompositionIndexRec = packed record');
  AddLine('    StartPosition : Word;');
  AddLine('    Length        : Byte;');
  AddLine('  end;');
  AddLine('  TDecompositionBookRec = packed record');
  AddLine('    Index      : array[0..(UC_DEC_BOOK_INDEX_LENGTH-1)] of TDecompositionIndexRec;');
  AddLine('    CodePoints : array[0..(UC_DEC_BOOK_DATA_LENGTH-1)] of UInt24;');
  AddLine('  end;');
  AddLine('const');
  AddLine('  UC_DEC_BOOK_DATA : TDecompositionBookRec = (');
  p := @ABook.Index[0];
  AddLine('    Index : (// Index BEGIN');
  k := 0;
  locLine := '      ';
  for i := Low(ABook.Index) to High(ABook.Index) - 1 do begin
    locLine := locLine + '(StartPosition : ' + IntToStr(p^.StartPosition) + ';' +
               ' Length : ' + IntToStr(p^.Length)  + '), ';
    k := k + 1;
    if (k >= 2) then begin
      AddLine(locLine);
      locLine := '      ';
      k := 0;
    end;
    Inc(p);
  end;
  locLine := locLine + '(StartPosition : ' + IntToStr(p^.StartPosition) + ';' +
             ' Length : ' + IntToStr(p^.Length)  + ')';
  AddLine(locLine);
  AddLine('    ); // Index END');

  cp := @ABook.CodePoints[0];
  AddLine('    CodePoints : (// CodePoints BEGIN');
  k := 0;
  locLine := '      ';
  for i := Low(ABook.CodePoints) to High(ABook.CodePoints) - 1 do begin
    cp24 := cp^;
    locLine := locLine + Format('%s,',[UInt24ToStr(cp24,AEndian)]);
    Inc(k);
    if (k >= 16) then begin
      AddLine(locLine);
      k := 0;
      locLine := '      ';
    end;
    Inc(cp);
  end;
  cp24 := cp^;
  locLine := locLine + Format('%s',[UInt24ToStr(cp24,AEndian)]);
  AddLine(locLine);
  AddLine('    ); // CodePoints END');
  AddLine('  );' + sLineBreak);
end;

procedure GenerateOutBmpTable(
        ADest     : TStream;
  const AList : TDataLineRecArray
);
  procedure AddLine(const ALine : ansistring);
  var
    buffer : ansistring;
  begin
    buffer := ALine + sLineBreak;
    ADest.Write(buffer[1],Length(buffer));
  end;

var
  i, j : Integer;
  locLine : string;
  p : PDataLineRec;
begin
  AddLine('');
  //AddLine('  UC_PROP_REC_COUNT = ' + IntToStr(Length(APropList)) + ';');
  //AddLine('  UC_PROP_ARRAY : array[0..(UC_PROP_REC_COUNT-1)] of TUC_Prop = (');
  j := -1;
  p := @AList[0];
  for i := 0 to Length(AList) - 1 do begin
    if ((p^.LineType = 0) and (p^.CodePoint >$FFFF)) or
       (p^.StartCodePoint > $FFFF)
    then begin
      j := i;
      Break;
    end;
    Inc(p);
  end;
  if (j < 0) then
    exit;

  for i := j to Length(AList) - 2 do begin
    locLine := '    (PropID : ' + IntToStr(p^.PropID) + ';' +
               ' CodePoint : ' + IntToStr(p^.CodePoint) + ';' +
               ' RangeEnd : ' + IntToStr(p^.EndCodePoint) +  '),' ;
    AddLine(locLine);
    Inc(p);
  end;
  locLine := '    (PropID : ' + IntToStr(p^.PropID) + ';' +
             ' CodePoint : ' + IntToStr(p^.CodePoint) + ';' +
             ' RangeEnd : ' + IntToStr(p^.EndCodePoint) +  ')' ;
  AddLine(locLine);
  AddLine('  );' + sLineBreak);
end;

function Compress(const AData : TDataLineRecArray) : TDataLineRecArray;
var
  k, i, locResLen : Integer;
  q, p, pr : PDataLineRec;
  k_end : TUnicodeCodePoint;
begin
  locResLen := 1;
  SetLength(Result,Length(AData));
  FillChar(Result[0],Length(Result),#0);
  Result[0] := AData[0];
  q := @AData[0];
  k := 0;
  while (k < Length(AData)) do begin
    if (q^.LineType = 0) then
      k_end := q^.CodePoint
    else
      k_end := q^.EndCodePoint;
    if ((k+1) = Length(AData)) then begin
      i := k;
    end else begin
      p := @AData[k+1];
      i := k +1;
      while (i < (Length(AData) {- 1})) do begin
        if (p^.PropID <> q^.PropID) then begin
          i := i - 1;
          Break;
        end;
        if (p^.LineType = 0) then begin
          if (p^.CodePoint <> (k_end + 1)) then begin
            i := i - 1;
            Break;
          end;
          Inc(k_end);
        end else begin
          if (p^.StartCodePoint <> (k_end + 1)) then begin
            i := i - 1;
            Break;
          end;
          k_end := p^.EndCodePoint;
        end;
        Inc(i);
        Inc(p);
      end;
    end;
    {if (i = k) then begin
      Result[locResLen] := q^;
      Inc(locResLen);
    end else begin }
      p := @AData[i];
      pr := @Result[locResLen];
      pr^.PropID := q^.PropID;
      if (q^.LineType = 0) then
        pr^.StartCodePoint := q^.CodePoint
      else
        pr^.StartCodePoint := q^.StartCodePoint;
      pr^.LineType := 1;
      if (p^.LineType = 0) then
        pr^.EndCodePoint := p^.CodePoint
      else
        pr^.EndCodePoint := p^.EndCodePoint;
      Inc(locResLen);
    //end;
    k := i + 1;
    if (k = Length(AData)) then
      Break;
    q := @AData[k];
  end;
  SetLength(Result,locResLen);
end;

procedure ParseUCAFile(
      ADataAStream : TMemoryStream;
  var ABook        : TUCA_DataBook
);
const READ_BUFFER_LENGTH = 1024*8;
      LINE_LENGTH        = 1024;
      DATA_LENGTH        = 25000;
var
  p : PAnsiChar;
  actualDataLen : Integer;
  bufferLength, bufferPos, lineLength, linePos : Integer;
  line : ansistring;

  function NextLine() : Boolean;
  var
    k, locOldPos : Integer;
    locOldPointer : PAnsiChar;
  begin
    Result := False;
    locOldPointer := p;
    locOldPos := bufferPos;
    while (bufferPos < bufferLength) and (p^ <> #10) do begin
      Inc(p);
      Inc(bufferPos);
    end;
    if (locOldPos = bufferPos) and (p^ = #10) then begin
      lineLength := 0;
      Inc(p);
      Inc(bufferPos);
      linePos := 1;
      Result := True;
    end else  if (locOldPos < bufferPos) then begin
      lineLength := (bufferPos - locOldPos) + 1;
      Move(locOldPointer^,line[1],lineLength);
      if (p^ = #10) then begin
        Dec(lineLength);
        Inc(p);
        Inc(bufferPos);
      end;
      linePos := 1;
      Result := True;
    end;
  end;

  procedure SkipSpace();
  begin
    while (linePos < lineLength) and (line[linePos] in [' ',#9]) do
      Inc(linePos);
  end;

  function NextToken() : ansistring;
  const C_SEPARATORS  = [';','#','.','[',']','*','@'];
  var
    k : Integer;
  begin
    SkipSpace();
    k := linePos;
    if (linePos <= lineLength) and (line[linePos] in C_SEPARATORS) then begin
      Result := line[linePos];
      Inc(linePos);
      exit;
    end;
    while (linePos <= lineLength) and not(line[linePos] in (C_SEPARATORS+[' '])) do
      Inc(linePos);
    if (linePos > k) then begin
      if (line[Min(linePos,lineLength)] in C_SEPARATORS) then
        Result := Copy(line,k,(linePos-k))
      else
        Result := Copy(line,k,(linePos-k+1));
      Result := Trim(Result);
    end else begin
      Result := '';
    end;
  end;

  procedure CheckToken(const AToken : string);
  var
    a, b : string;
  begin
    a := LowerCase(Trim(AToken));
    b := LowerCase(Trim(NextToken()));
    if (a <> b) then
      raise Exception.CreateFmt('Expected token "%s" but found "%s".',[a,b]);
  end;

  function ReadWeightBlock(var ADest : TUCA_WeightRec) : Boolean;
  var
    s :AnsiString;
    k : Integer;
  begin
    Result := False;
    s := NextToken();
    if (s <> '[') then
      exit;
    s := NextToken();
    if (s = '.') then
      ADest.Variable := False
    else begin
      if (s <> '*') then
        raise Exception.CreateFmt('Expected "%s" but found "%s".',['*',s]);
      ADest.Variable := True;
    end;
    ADest.Weights[0] := StrToInt('$'+NextToken());
    for k := 1 to 3 do begin
      CheckToken('.');
      ADest.Weights[k] := StrToInt('$'+NextToken());
    end;
    CheckToken(']');
    Result := True;
  end;

  procedure ParseHeaderVar();
  var
    s,ss : string;
    k : Integer;
  begin
    s := NextToken();
    if (s = 'version') then begin
      ss := '';
      while True do begin
        s := NextToken();
        if (s = '') then
          Break;
        ss := ss + s;
      end;
      ABook.Version := ss;
    end else if (s = 'variable') then begin
      if (s = 'blanked') then
        ABook.VariableWeight := ucaBlanked
      else if (s = 'non-ignorable') then
        ABook.VariableWeight := ucaNonIgnorable
      else if (s = 'shifted') then
        ABook.VariableWeight := ucaShifted
      else if (s = 'shift-trimmed') then
        ABook.VariableWeight := ucaShiftedTrimmed
      else if (s = 'ignoresp') then
        ABook.VariableWeight := ucaIgnoreSP
      else
        raise Exception.CreateFmt('Unknown "@variable" type : "%s".',[s]);
    end else if (s = 'backwards') or (s = 'forwards') then begin
      ss := s;
      s := NextToken();
      k := StrToInt(s);
      if (k < 1) or (k > 4) then
        raise Exception.CreateFmt('Invalid "%s" position : %d.',[ss,s]);
      ABook.Backwards[k] := (s = 'backwards');
    end;
  end;

  procedure ParseLine();
  var
    locCP : Cardinal;
    locData : ^TUCA_LineRec;
    s : ansistring;
    kc : Integer;
  begin
    if (Length(ABook.Lines) <= actualDataLen) then
      SetLength(ABook.Lines,Length(ABook.Lines)*2);
    locData := @ABook.Lines[actualDataLen];
    s := NextToken();
    if (s = '') or (s[1] = '#') then
      exit;
    if (s[1] = '@') then begin
      ParseHeaderVar();
      exit;
    end;
    SetLength(locData^.CodePoints,10);
    locData^.CodePoints[0] := StrToInt('$'+s);
    kc := 1;
    while True do begin
      s := Trim(NextToken());
      if (s = '') then
        exit;
      if (s = ';') then
        Break;
      locData^.CodePoints[kc] := StrToInt('$'+s);
      Inc(kc);
    end;
    if (kc = 0) then
      exit;
    SetLength(locData^.CodePoints,kc);
    SetLength(locData^.Weights,24);
    kc := 0;
    while ReadWeightBlock(locData^.Weights[kc]) do begin
      Inc(kc);
    end;
    SetLength(locData^.Weights,kc);
    Inc(actualDataLen);
  end;

  procedure Prepare();
  var
    r : TPropRec;
    k : Integer;
  begin
    ABook.VariableWeight := ucaShifted;
    for k := Low(ABook.Backwards) to High(ABook.Backwards) do
      ABook.Backwards[k] := False;
    SetLength(ABook.Lines,DATA_LENGTH);
    actualDataLen := 0;
    bufferLength := ADataAStream.Size;
    bufferPos := 0;
    p := ADataAStream.Memory;
    lineLength := 0;
    SetLength(line,LINE_LENGTH);
  end;

begin
  Prepare();
  while NextLine() do
    ParseLine();
  SetLength(ABook.Lines,actualDataLen);
end;

procedure Dump(X : array of TUnicodeCodePoint; const ATitle : string = '');
var
  i : Integer;
begin
  Write(ATitle, ' ');
  for i := 0 to Length(X) - 1 do
    Write(X[i],' ');
  WriteLn();
end;

function IsGreaterThan(A, B : PUCA_LineRec) : Integer;
var
  i, hb : Integer;
begin
  if (A=B) then
    exit(0);
  Result := 1;
  hb := Length(B^.CodePoints) - 1;
  for i := 0 to Length(A^.CodePoints) - 1 do begin
    if (i > hb) then
      exit;
    if (A^.CodePoints[i] < B^.CodePoints[i]) then
      exit(-1);
    if (A^.CodePoints[i] > B^.CodePoints[i]) then
      exit(1);
  end;
  if (Length(A^.CodePoints) = Length(B^.CodePoints)) then
    exit(0);
  exit(-1);
end;

Procedure QuickSort(var AList: TUCA_DataBookIndex; L, R : Longint;
                     ABook : PUCA_DataBook);
var
  I, J : Longint;
  P, Q : Integer;
begin
 repeat
   I := L;
   J := R;
   P := AList[ (L + R) div 2 ];
   repeat
     while IsGreaterThan(@ABook^.Lines[P], @ABook^.Lines[AList[i]]) > 0 do
       I := I + 1;
     while IsGreaterThan(@ABook^.Lines[P], @ABook^.Lines[AList[J]]) < 0 do
       J := J - 1;
     If I <= J then
     begin
       Q := AList[I];
       AList[I] := AList[J];
       AList[J] := Q;
       I := I + 1;
       J := J - 1;
     end;
   until I > J;
   // sort the smaller range recursively
   // sort the bigger range via the loop
   // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
   if J - L < R - I then
   begin
     if L < J then
       QuickSort(AList, L, J, ABook);
     L := I;
   end
   else
   begin
     if I < R then
       QuickSort(AList, I, R, ABook);
     R := J;
   end;
 until L >= R;
end;

function CreateIndex(ABook : PUCA_DataBook) : TUCA_DataBookIndex;
var
  r : TUCA_DataBookIndex;
  i, c : Integer;
begin
  c := Length(ABook^.Lines);
  SetLength(r,c);
  for i := 0 to c - 1 do
    r[i] := i;
  QuickSort(r,0,c-1,ABook);
  Result := r;
end;

function ConstructContextTree(
  const AContext : PUCA_LineContextRec;
  var   ADestBuffer;
  const ADestBufferLength : Integer
) : PUCA_PropItemContextTreeRec;forward;
function ConstructItem(
        AItem         : PUCA_PropItemRec;
        ACodePoint    : Cardinal;
        AValid        : Byte;
        AChildCount   : Byte;
  const AWeights      : array of TUCA_WeightRec;
  const AStoreCP      : Boolean;
  const AContext      : PUCA_LineContextRec;
  const ADeleted      : Boolean
) : Integer;
var
  i, c : Integer;
  p : PUCA_PropItemRec;
  pw : PUCA_PropWeights;
  w : TUCA_WeightRec;
  pb : PByte;
  hasContext : Boolean;
  contextTree : PUCA_PropItemContextTreeRec;
begin
  p := AItem;
  {if AStoreCP then begin
    PUInt24(p)^ := ACodePoint;
    p := PUCA_PropItemRec(PtrUInt(p) + SizeOf(UInt24));
  end;  }
  p^.Flags := 0;
  p^.Valid := 0;
  SetBit(p^.Valid,BIT_POS_VALIDE,(AValid <> 0));
  p^.ChildCount := AChildCount;
  c := Length(AWeights);
  p^.WeightLength := c;
  if (c = 0) then begin
    Result := SizeOf(TUCA_PropItemRec);
    if ADeleted then
      SetBit(AItem^.Flags,AItem^.FLAG_DELETION,True);
  end else begin
    Result := SizeOf(TUCA_PropItemRec) + (c*SizeOf(TUCA_PropWeights));//PtrUInt(pw) - PtrUInt(AItem);
    //pw := PUCA_PropWeights(PtrUInt(p) + SizeOf(TUCA_PropItemRec));
    pb := PByte(PtrUInt(p) + SizeOf(TUCA_PropItemRec));
    PWord(pb)^ := AWeights[0].Weights[0];
    pb := pb + 2;
    if (AWeights[0].Weights[1] > High(Byte)) then begin
      SetBit(p^.Valid,(BIT_POS_COMPRESS_WEIGHT_1),True);
      PWord(pb)^ := AWeights[0].Weights[1];
      pb := pb + 2;
    end else begin
      pb^ := AWeights[0].Weights[1];
      pb := pb + 1;
      Result := Result - 1;
    end;
    if (AWeights[0].Weights[2] > High(Byte)) then begin
      SetBit(p^.Valid,(BIT_POS_COMPRESS_WEIGHT_2),True);
      PWord(pb)^ := AWeights[0].Weights[2];
      pb := pb + 2;
    end else begin
      pb^ := AWeights[0].Weights[2];
      pb := pb + 1;
      Result := Result - 1;
    end;
    pw := PUCA_PropWeights(pb);
    for i := 1 to c - 1 do begin
      pw^.Weights[0] := AWeights[i].Weights[0];
      pw^.Weights[1] := AWeights[i].Weights[1];
      pw^.Weights[2] := AWeights[i].Weights[2];
      //pw^.Variable := BoolToByte(AWeights[i].Variable);
      Inc(pw);
    end;
  end;
  hasContext := (AContext <> nil) and (Length(AContext^.Data) > 0);
  if AStoreCP or hasContext then begin
    PUInt24(PtrUInt(AItem)+Result)^ := ACodePoint;
    Result := Result + SizeOf(UInt24);
    SetBit(AItem^.Flags,AItem^.FLAG_CODEPOINT,True);
  end;
  if hasContext then begin
    contextTree := ConstructContextTree(AContext,Pointer(PtrUInt(AItem)+Result)^,-1);
    Result := Result + Cardinal(contextTree^.Size);
    SetBit(AItem^.Flags,AItem^.FLAG_CONTEXTUAL,True);
  end;
  p^.Size := Result;
end;

function CalcCharChildCount(
  const AChar           : Cardinal;
  const ASearchStartPos : Integer;
  const ALinePos        : Integer;
  const ABookLines      : PUCA_LineRec;
  const AMaxLength      : Integer;
  const ABookIndex      : TUCA_DataBookIndex;
  out   ALineCount      : Integer
) : Byte;
var
  locLinePos : Integer;
  p : PUCA_LineRec;

  procedure IncP();
  begin
    Inc(locLinePos);
    p := @ABookLines[ABookIndex[locLinePos]];
  end;

  procedure DoDump();
  var
    px : PUCA_LineRec;
    k, ki : Integer;
  begin
    WriteLn;
    WriteLn('Dump');
    for k := ALinePos to ALinePos + 15 do begin
      px := @ABookLines[ABookIndex[k]];
      for ki := 0 to Length(px^.CodePoints) -1 do
        Write(px^.CodePoints[ki],' ');
      WriteLn;
    end;
  end;

var
  i, locTargetLen, locTargetBufferSize, r : Integer;
  locTarget : array[0..127] of Cardinal;
  locLastChar : Cardinal;
begin
  locLinePos := ALinePos;
  p := @ABookLines[ABookIndex[locLinePos]];
  locTargetLen := ASearchStartPos;
  locTargetBufferSize := (locTargetLen*SizeOf(Cardinal));
  Move(p^.CodePoints[0],locTarget[0],locTargetBufferSize);
  if (Length(p^.CodePoints) = ASearchStartPos) then begin
    r := 0;
    locLastChar := High(Cardinal);
  end else begin
    r := 1;
    locLastChar := p^.CodePoints[ASearchStartPos];
  end;
  IncP();
  i := 1;
  while (i < AMaxLength) do begin
    if (Length(p^.CodePoints) < locTargetLen) then
      Break;
    if not CompareMem(@locTarget[0],@p^.CodePoints[0],locTargetBufferSize) then
      Break;
    if (p^.CodePoints[ASearchStartPos] <> locLastChar) then begin
      Inc(r);
      locLastChar := p^.CodePoints[ASearchStartPos];
    end;
    IncP();
    Inc(i);
  end;
  ALineCount := i;
  Result := r;
end;

function BuildTrie(
  const ALinePos        : Integer;
  const ABookLines      : PUCA_LineRec;
  const AMaxLength      : Integer;
  const ABookIndex      : TUCA_DataBookIndex
) : PTrieNode;
var
  p : PUCA_LineRec;
  root, n : PTrieNode;
  ki, k, i : Integer;
  key : array of TKeyType;
begin
  k := ABookIndex[ALinePos];
  p := @ABookLines[k];
  if (Length(p^.CodePoints) = 1) then
    root := CreateNode(p^.CodePoints[0],k)
  else
    root := CreateNode(p^.CodePoints[0]);

  for i := ALinePos to ALinePos + AMaxLength - 1 do begin
    k := ABookIndex[i];
    p := @ABookLines[k];
    if (Length(p^.CodePoints) = 1) then begin
      InsertWord(root,p^.CodePoints[0],k);
    end else begin
      SetLength(key,Length(p^.CodePoints));
      for ki := 0 to Length(p^.CodePoints) - 1 do
        key[ki] := p^.CodePoints[ki];
      InsertWord(root,key,k);
    end;
  end;
  Result := root;
end;

function BoolToByte(AValue : Boolean): Byte;inline;
begin
  if AValue then
    Result := 1
  else
    Result := 0;
end;

function InternalConstructFromTrie(
  const ATrie  : PTrieNode;
  const AItem  : PUCA_PropItemRec;
  const ALines : PUCA_LineRec;
  const AStoreCp : Boolean
) : Integer;
var
  i, size : Integer;
  p : PUCA_PropItemRec;
  n : PTrieNode;
begin
  if (ATrie = nil) then
    exit(0);
  p := AItem;
  n := ATrie;
  if n^.DataNode then
    size := ConstructItem(p,n^.Key,1,n^.ChildCount,ALines[n^.Data].Weights,AStoreCp,@(ALines[n^.Data].Context),ALines[n^.Data].Deleted)
  else
    size := ConstructItem(p,n^.Key,0,n^.ChildCount,[],AStoreCp,nil,False);
  Result := size;
  if (n^.ChildCount > 0) then begin
    for i := 0 to n^.ChildCount - 1 do begin
      p := PUCA_PropItemRec(PtrUInt(p) + size);
      size := InternalConstructFromTrie(n^.Children[i],p,ALines,True);
      Result := Result + size;
    end;
  end;
  AItem^.Size := Result;
end;

function ConstructFromTrie(
  const ATrie  : PTrieNode;
  const AItem  : PUCA_PropItemRec;
  const ALines : PUCA_LineRec
) : Integer;
begin
  Result := InternalConstructFromTrie(ATrie,AItem,ALines,False);
end;

procedure MakeUCA_Props(
        ABook         : PUCA_DataBook;
  out   AProps        : PUCA_PropBook
);
var
  propIndexCount : Integer;

  procedure CapturePropIndex(AItem : PUCA_PropItemRec; ACodePoint : Cardinal);
  begin
    AProps^.Index[propIndexCount].CodePoint := ACodePoint;
    AProps^.Index[propIndexCount].Position := PtrUInt(AItem) - PtrUInt(AProps^.Items);
    propIndexCount := propIndexCount + 1;
  end;

var
  locIndex : TUCA_DataBookIndex;
  i, c, k, kc : Integer;
  p, p1, p2 : PUCA_PropItemRec;
  lines, pl1, pl2 : PUCA_LineRec;
  uc : Cardinal;
  childCount, lineCount, size : Integer;
  trieRoot : PTrieNode;
  MaxChildCount, MaxSize : Integer;
begin
  locIndex := CreateIndex(ABook);
  i := Length(ABook^.Lines);
  i := 30 * i * (SizeOf(TUCA_PropItemRec) + SizeOf(TUCA_PropWeights));
  GetMem(AProps,SizeOf(TUCA_DataBook));
  AProps^.ItemSize := i;
  GetMem(AProps^.Items,i);
  propIndexCount := 0;
  SetLength(AProps^.Index,Length(ABook^.Lines));
  p := AProps^.Items;
  lines := @ABook^.Lines[0];
  c := Length(locIndex);
  i := 0;
  MaxChildCount := 0; MaxSize := 0;
  while (i < (c-1)) do begin
    pl1 := @lines[locIndex[i]];
    if not pl1^.Stored then begin
      i := i + 1;
      Continue;
    end;
    pl2 := @lines[locIndex[i+1]];
    if (pl1^.CodePoints[0] <> pl2^.CodePoints[0]) then begin
      if (Length(pl1^.CodePoints) = 1) then begin
        size := ConstructItem(p,pl1^.CodePoints[0],1,0,pl1^.Weights,False,@pl1^.Context,pl1^.Deleted);
        CapturePropIndex(p,pl1^.CodePoints[0]);
        p := PUCA_PropItemRec(PtrUInt(p) + size);
        if (size > MaxSize) then
          MaxSize := size;
      end else begin
        kc := Length(pl1^.CodePoints);
        for k := 0 to kc - 2 do begin
          size := ConstructItem(p,pl1^.CodePoints[k],0,1,[],(k>0),@pl1^.Context,pl1^.Deleted);
          if (k = 0) then
            CapturePropIndex(p,pl1^.CodePoints[k]);
          p := PUCA_PropItemRec(PtrUInt(p) + size);
        end;
        size := ConstructItem(p,pl1^.CodePoints[kc-1],1,0,pl1^.Weights,True,@pl1^.Context,pl1^.Deleted);
        p := PUCA_PropItemRec(PtrUInt(p) + size);
        p2 := p;
        for k := kc - 2 downto 0 do begin
          p1 := PUCA_PropItemRec(PtrUInt(p2) - p2^.Size);
          p1^.Size := p1^.Size + p2^.Size;
          p2 := p1;
        end;
        if (p1^.Size > MaxSize) then
          MaxSize := p1^.Size;
      end;
      lineCount := 1;
    end else begin
      childCount := CalcCharChildCount(pl1^.CodePoints[0],1,i,lines,c,locIndex,lineCount);
      if (childCount < 1) then
        raise Exception.CreateFmt('Expected "child count > 1" but found %d.',[childCount]);
      if (lineCount < 2) then
        raise Exception.CreateFmt('Expected "line count > 2" but found %d.',[lineCount]);
      if (childCount > MaxChildCount) then
        MaxChildCount := childCount;
      trieRoot := BuildTrie(i,lines,lineCount,locIndex);
      size := ConstructFromTrie(trieRoot,p,lines);
      CapturePropIndex(p,pl1^.CodePoints[0]);
      FreeNode(trieRoot);
      p := PUCA_PropItemRec(PtrUInt(p) + size);
      if (size > MaxSize) then
        MaxSize := size;
    end;
    i := i + lineCount;
  end;
  if (i = (c-1)) then begin
    pl1 := @lines[locIndex[i]];
    if (Length(pl1^.CodePoints) = 1) then begin
      size := ConstructItem(p,pl1^.CodePoints[0],1,0,pl1^.Weights,False,@pl1^.Context,pl1^.Deleted);
      CapturePropIndex(p,pl1^.CodePoints[0]);
      p := PUCA_PropItemRec(PtrUInt(p) + size);
      if (size > MaxSize) then
        MaxSize := size;
    end else begin
      kc := Length(pl1^.CodePoints);
      for k := 0 to kc - 2 do begin
        size := ConstructItem(p,pl1^.CodePoints[k],0,1,[],(k>0),@pl1^.Context,pl1^.Deleted);
        if (k = 0) then
          CapturePropIndex(p,pl1^.CodePoints[0]);
        p := PUCA_PropItemRec(PtrUInt(p) + size);
      end;
      size := ConstructItem(p,pl1^.CodePoints[kc-1],1,0,pl1^.Weights,True,@pl1^.Context,pl1^.Deleted);
      p := PUCA_PropItemRec(PtrUInt(p) + size);
      p2 := p;
      for k := kc - 2 downto 0 do begin
        p1 := PUCA_PropItemRec(PtrUInt(p2) - p2^.Size);
        p1^.Size := p1^.Size + p2^.Size;
        p2 := p1;
      end;
      if (size > MaxSize) then
        MaxSize := size;
    end;
  end;
  c := Int64(PtrUInt(p)) - Int64(PtrUInt(AProps^.Items));
  ReAllocMem(AProps^.Items,c);
  AProps^.ItemSize := c;
  SetLength(AProps^.Index,propIndexCount);

  k := 0;
  c := High(Word);
  for i := 0 to Length(ABook^.Lines) - 1 do begin
    if (Length(ABook^.Lines[i].Weights) > 0) then begin
      if (ABook^.Lines[i].Weights[0].Variable) then begin
        if (ABook^.Lines[i].Weights[0].Weights[0] > k) then
          k := ABook^.Lines[i].Weights[0].Weights[0];
        if (ABook^.Lines[i].Weights[0].Weights[0] < c) then
          c := ABook^.Lines[i].Weights[0].Weights[0];
      end;
    end;
  end;
  AProps^.VariableHighLimit := k;
  AProps^.VariableLowLimit := c;
end;

procedure FreeUcaBook(var ABook : PUCA_PropBook);
var
  p : PUCA_PropBook;
begin
  if (ABook = nil) then
    exit;
  p := ABook;
  ABook := nil;
  p^.Index := nil;
  FreeMem(p^.Items,p^.ItemSize);
  FreeMem(p,SizeOf(p^));
end;

function IndexOf(const ACodePoint : Cardinal; APropBook : PUCA_PropBook): Integer;overload;
var
  i : Integer;
begin
  for i := 0 to Length(APropBook^.Index) - 1 do begin
    if (ACodePoint = APropBook^.Index[i].CodePoint) then
      exit(i);
  end;
  Result := -1;
end;

type
  PucaBmpSecondTableItem = ^TucaBmpSecondTableItem;
function IndexOf(
  const AItem  : PucaBmpSecondTableItem;
  const ATable : TucaBmpSecondTable;
  const ATableActualLength : Integer
) : Integer;overload;
var
  i : Integer;
  p : PucaBmpSecondTableItem;
begin
  Result := -1;
  if (ATableActualLength > 0) then begin
    p := @ATable[0];
    for i := 0 to ATableActualLength - 1 do begin
      if CompareMem(p,AItem,SizeOf(TucaBmpSecondTableItem)) then begin
        Result := i;
        Break;
      end;
      Inc(p);
    end;
  end;
end;

procedure MakeUCA_BmpTables(
  var   AFirstTable   : TucaBmpFirstTable;
  var   ASecondTable  : TucaBmpSecondTable;
  const APropBook     : PUCA_PropBook
);
var
  locLowByte, locHighByte : Byte;
  locTableItem : TucaBmpSecondTableItem;
  locCP : TUnicodeCodePoint;
  i, locSecondActualLen : Integer;
  k : Integer;
begin
  SetLength(ASecondTable,120);
  locSecondActualLen := 0;
  for locHighByte := 0 to 255 do begin
    FillChar(locTableItem,SizeOf(locTableItem),#0);
    for locLowByte := 0 to 255 do begin
      locCP := (locHighByte * 256) + locLowByte;
      k := IndexOf(locCP,APropBook);
      if (k = -1) then
        k := 0
      else
        k := APropBook^.Index[k].Position + 1;
      locTableItem[locLowByte] := k;
    end;
    i := IndexOf(@locTableItem,ASecondTable,locSecondActualLen);
    if (i = -1) then begin
      if (locSecondActualLen = Length(ASecondTable)) then
        SetLength(ASecondTable,locSecondActualLen + 50);
      i := locSecondActualLen;
      ASecondTable[i] := locTableItem;
      Inc(locSecondActualLen);
    end;
    AFirstTable[locHighByte] := i;
  end;
  SetLength(ASecondTable,locSecondActualLen);
end;

function ToUCS4(const AHighS, ALowS : Word) : TUnicodeCodePoint; inline;
begin
  //copied from utf16toutf32
  Result := (UCS4Char(AHighS)-$d800) shl 10 + (UCS4Char(ALowS)-$dc00) + $10000;
end;

procedure FromUCS4(const AValue : TUnicodeCodePoint; var AHighS, ALowS : Word);
begin
  AHighS := Word((AValue - $10000) shr 10 + $d800);
  ALowS := Word((AValue - $10000) and $3ff + $dc00);
end;

type
  PucaOBmpSecondTableItem = ^TucaOBmpSecondTableItem;
function IndexOf(
  const AItem  : PucaOBmpSecondTableItem;
  const ATable : TucaOBmpSecondTable;
  const ATableActualLength : Integer
) : Integer;overload;
var
  i : Integer;
  p : PucaOBmpSecondTableItem;
begin
  Result := -1;
  if (ATableActualLength > 0) then begin
    p := @ATable[0];
    for i := 0 to ATableActualLength - 1 do begin
      if CompareMem(p,AItem,SizeOf(TucaOBmpSecondTableItem)) then begin
        Result := i;
        Break;
      end;
      Inc(p);
    end;
  end;
end;

procedure MakeUCA_OBmpTables(
  var   AFirstTable   : TucaOBmpFirstTable;
  var   ASecondTable  : TucaOBmpSecondTable;
  const APropBook     : PUCA_PropBook
);
var
  locLowByte, locHighByte : Word;
  locTableItem : TucaOBmpSecondTableItem;
  locCP : TUnicodeCodePoint;
  i, locSecondActualLen : Integer;
  k : Integer;
begin
  if (Length(ASecondTable) = 0) then
    SetLength(ASecondTable,2000);
  locSecondActualLen := 0;
  for locHighByte := 0 to HIGH_SURROGATE_COUNT - 1 do begin
    FillChar(locTableItem,SizeOf(locTableItem),#0);
    for locLowByte := 0 to LOW_SURROGATE_COUNT - 1 do begin
      locCP := ToUCS4(HIGH_SURROGATE_BEGIN + locHighByte,LOW_SURROGATE_BEGIN + locLowByte);
      k := IndexOf(locCP,APropBook);
      if (k = -1) then
        k := 0
      else
        k := APropBook^.Index[k].Position + 1;
      locTableItem[locLowByte] := k;
    end;
    i := IndexOf(@locTableItem,ASecondTable,locSecondActualLen);
    if (i = -1) then begin
      if (locSecondActualLen = Length(ASecondTable)) then
        SetLength(ASecondTable,locSecondActualLen + 50);
      i := locSecondActualLen;
      ASecondTable[i] := locTableItem;
      Inc(locSecondActualLen);
    end;
    AFirstTable[locHighByte] := i;
  end;
  SetLength(ASecondTable,locSecondActualLen);
end;

function GetPropPosition(
  const AHighS,
        ALowS         : Word;
  const AFirstTable   : PucaOBmpFirstTable;
  const ASecondTable  : PucaOBmpSecondTable
): Integer;inline;overload;
begin
  Result := ASecondTable^[AFirstTable^[AHighS-HIGH_SURROGATE_BEGIN]][ALowS-LOW_SURROGATE_BEGIN] - 1;
end;

procedure GenerateUCA_Head(
  ADest  : TStream;
  ABook  : PUCA_DataBook;
  AProps : PUCA_PropBook
);

  procedure AddLine(const ALine : ansistring);
  var
    buffer : ansistring;
  begin
    buffer := ALine + sLineBreak;
    ADest.Write(buffer[1],Length(buffer));
  end;

begin
  AddLine('const');
  AddLine('  VERSION_STRING = ' + QuotedStr(ABook^.Version) + ';');
  AddLine('  VARIABLE_LOW_LIMIT = ' + IntToStr(AProps^.VariableLowLimit) + ';');
  AddLine('  VARIABLE_HIGH_LIMIT = ' + IntToStr(AProps^.VariableHighLimit) + ';');
  AddLine('  VARIABLE_WEIGHT = ' + IntToStr(Ord(ABook^.VariableWeight)) + ';');
  AddLine('  BACKWARDS_0 = ' + BoolToStr(ABook^.Backwards[0],'True','False') + ';');
  AddLine('  BACKWARDS_1 = ' + BoolToStr(ABook^.Backwards[1],'True','False') + ';');
  AddLine('  BACKWARDS_2 = ' + BoolToStr(ABook^.Backwards[2],'True','False') + ';');
  AddLine('  BACKWARDS_3 = ' + BoolToStr(ABook^.Backwards[3],'True','False') + ';');
  AddLine('  PROP_COUNT  = ' + IntToStr(Ord(AProps^.ItemSize)) + ';');

  AddLine('');
end;

procedure GenerateUCA_BmpTables(
        AStream,
        ABinStream    : TStream;
  var   AFirstTable   : TucaBmpFirstTable;
  var   ASecondTable  : TucaBmpSecondTable;
  const AEndian       : TEndianKind
);

  procedure AddLine(AOut : TStream; const ALine : ansistring);
  var
    buffer : ansistring;
  begin
    buffer := ALine + sLineBreak;
    AOut.Write(buffer[1],Length(buffer));
  end;

var
  i, j, c : Integer;
  locLine : string;
  value : UInt24;
begin
  AddLine(AStream,'const');
  AddLine(AStream,'  UCA_TABLE_1 : array[0..255] of Byte = (');
  locLine := '';
  for i := Low(AFirstTable) to High(AFirstTable) - 1 do begin
    locLine := locLine + IntToStr(AFirstTable[i]) + ',';
    if (((i+1) mod 16) = 0) then begin
      locLine := '    ' + locLine;
      AddLine(AStream,locLine);
      locLine := '';
    end;
  end;
  locLine := locLine + IntToStr(AFirstTable[High(AFirstTable)]);
  locLine := '    ' + locLine;
  AddLine(AStream,locLine);
  AddLine(AStream,'  );' + sLineBreak);

  AddLine(ABinStream,'const');
  AddLine(ABinStream,'  UCA_TABLE_2 : array[0..(256*' + IntToStr(Length(ASecondTable)) +'-1)] of UInt24 =(');
  c := High(ASecondTable);
  for i := Low(ASecondTable) to c do begin
    locLine := '';
    for j := Low(TucaBmpSecondTableItem) to High(TucaBmpSecondTableItem) do begin
      value := ASecondTable[i][j];
      locLine := locLine + UInt24ToStr(value,AEndian) + ',';
      if (((j+1) mod 2) = 0) then begin
        if (i = c) and (j = 255) then
          Delete(locLine,Length(locLine),1);
        locLine := '    ' + locLine;
        AddLine(ABinStream,locLine);
        locLine := '';
      end;
    end;
  end;
  AddLine(ABinStream,'  );' + sLineBreak);
end;

procedure GenerateUCA_PropTable(
// WARNING : files must be generated for each endianess (Little / Big)
        ADest     : TStream;
  const APropBook : PUCA_PropBook
);
  procedure AddLine(const ALine : ansistring);
  var
    buffer : ansistring;
  begin
    buffer := ALine + sLineBreak;
    ADest.Write(buffer[1],Length(buffer));
  end;

var
  i, j, c : Integer;
  locLine : string;
  p : PByte;
begin
  c := APropBook^.ItemSize;
  AddLine('const');
  AddLine('  UCA_PROPS : array[0..' + IntToStr(c-1) + '] of Byte = (');
  locLine := '';
  p := PByte(APropBook^.Items);
  for i := 0 to c - 2 do begin
    locLine := locLine + IntToStr(p[i]) + ',';
    if (((i+1) mod 60) = 0) then begin
      locLine := '    ' + locLine;
      AddLine(locLine);
      locLine := '';
    end;
  end;
  locLine := locLine + IntToStr(p[c-1]);
  locLine := '    ' + locLine;
  AddLine(locLine);
  AddLine('  );' + sLineBreak);
end;

procedure GenerateUCA_OBmpTables(
        AStream,
        ABinStream    : TStream;
  var   AFirstTable   : TucaOBmpFirstTable;
  var   ASecondTable  : TucaOBmpSecondTable;
  const AEndian       : TEndianKind
);

  procedure AddLine(AOut : TStream; const ALine : ansistring);
  var
    buffer : ansistring;
  begin
    buffer := ALine + sLineBreak;
    AOut.Write(buffer[1],Length(buffer));
  end;

var
  i, j, c : Integer;
  locLine : string;
  value : UInt24;
begin
  AddLine(AStream,'const');
  AddLine(AStream,'  UCAO_TABLE_1 : array[0..' + IntToStr(HIGH_SURROGATE_COUNT-1) + '] of Word = (');
  locLine := '';
  for i := Low(AFirstTable) to High(AFirstTable) - 1 do begin
    locLine := locLine + IntToStr(AFirstTable[i]) + ',';
    if (((i+1) mod 16) = 0) then begin
      locLine := '    ' + locLine;
      AddLine(AStream,locLine);
      locLine := '';
    end;
  end;
  locLine := locLine + IntToStr(AFirstTable[High(AFirstTable)]);
  locLine := '    ' + locLine;
  AddLine(AStream,locLine);
  AddLine(AStream,'  );' + sLineBreak);

  AddLine(ABinStream,'  UCAO_TABLE_2 : array[0..('+IntToStr(LOW_SURROGATE_COUNT)+'*' + IntToStr(Length(ASecondTable)) +'-1)] of UInt24 =(');
  c := High(ASecondTable);
  for i := Low(ASecondTable) to c do begin
    locLine := '';
    for j := Low(TucaOBmpSecondTableItem) to High(TucaOBmpSecondTableItem) do begin
      value := ASecondTable[i][j];
      locLine := locLine + UInt24ToStr(value,AEndian) + ',';
      if (((j+1) mod 2) = 0) then begin
        if (i = c) and (j = High(TucaOBmpSecondTableItem)) then
          Delete(locLine,Length(locLine),1);
        locLine := '    ' + locLine;
        AddLine(ABinStream,locLine);
        locLine := '';
      end;
    end;
  end;
  AddLine(ABinStream,'  );' + sLineBreak);
end;

//-------------------------------------------

type
  POBmpSecondTableItem = ^TOBmpSecondTableItem;
function IndexOf(
  const AItem  : POBmpSecondTableItem;
  const ATable : TOBmpSecondTable;
  const ATableActualLength : Integer
) : Integer;overload;
var
  i : Integer;
  p : POBmpSecondTableItem;
begin
  Result := -1;
  if (ATableActualLength > 0) then begin
    p := @ATable[0];
    for i := 0 to ATableActualLength - 1 do begin
      if CompareMem(p,AItem,SizeOf(TOBmpSecondTableItem)) then begin
        Result := i;
        Break;
      end;
      Inc(p);
    end;
  end;
end;

procedure MakeOBmpTables(
  var   AFirstTable   : TOBmpFirstTable;
  var   ASecondTable  : TOBmpSecondTable;
  const ADataLineList : TDataLineRecArray
);
var
  locLowByte, locHighByte : Word;
  locTableItem : TOBmpSecondTableItem;
  locCP : TUnicodeCodePoint;
  i, locSecondActualLen : Integer;
begin
  SetLength(ASecondTable,2000);
  locSecondActualLen := 0;
  for locHighByte := 0 to HIGH_SURROGATE_COUNT - 1 do begin
    FillChar(locTableItem,SizeOf(locTableItem),#0);
    for locLowByte := 0 to LOW_SURROGATE_COUNT - 1 do begin
      locCP := ToUCS4(HIGH_SURROGATE_BEGIN + locHighByte,LOW_SURROGATE_BEGIN + locLowByte);
      locTableItem[locLowByte] := GetPropID(locCP,ADataLineList)// - 1;
    end;
    i := IndexOf(@locTableItem,ASecondTable,locSecondActualLen);
    if (i = -1) then begin
      if (locSecondActualLen = Length(ASecondTable)) then
        SetLength(ASecondTable,locSecondActualLen + 50);
      i := locSecondActualLen;
      ASecondTable[i] := locTableItem;
      Inc(locSecondActualLen);
    end;
    AFirstTable[locHighByte] := i;
  end;
  SetLength(ASecondTable,locSecondActualLen);
end;

type
  P3lvlOBmp3TableItem = ^T3lvlOBmp3TableItem;
function IndexOf(
  const AItem  : P3lvlOBmp3TableItem;
  const ATable : T3lvlOBmp3Table;
  const ATableActualLength : Integer
) : Integer;overload;
var
  i : Integer;
  p : P3lvlOBmp3TableItem;
begin
  Result := -1;
  if (ATableActualLength > 0) then begin
    p := @ATable[0];
    for i := 0 to ATableActualLength - 1 do begin
      if CompareMem(p,AItem,SizeOf(T3lvlOBmp3TableItem)) then begin
        Result := i;
        Break;
      end;
      Inc(p);
    end;
  end;
end;

type
  P3lvlOBmp2TableItem = ^T3lvlOBmp2TableItem;
function IndexOf(
  const AItem  : P3lvlOBmp2TableItem;
  const ATable : T3lvlOBmp2Table
) : Integer;overload;
var
  i : Integer;
  p : P3lvlOBmp2TableItem;
begin
  Result := -1;
  if (Length(ATable) > 0) then begin
    p := @ATable[0];
    for i := 0 to Length(ATable) - 1 do begin
      if CompareMem(p,AItem,SizeOf(T3lvlOBmp2TableItem)) then begin
        Result := i;
        Break;
      end;
      Inc(p);
    end;
  end;
end;
procedure MakeOBmpTables3Levels(
  var   AFirstTable   : T3lvlOBmp1Table;
  var   ASecondTable  : T3lvlOBmp2Table;
  var   AThirdTable  : T3lvlOBmp3Table;
  const ADataLineList : TDataLineRecArray
);
var
  locLowByte0, locLowByte1, locHighByte : Word;
  locTableItem2 : T3lvlOBmp2TableItem;
  locTableItem3 : T3lvlOBmp3TableItem;
  locCP : TUnicodeCodePoint;
  i, locThirdActualLen : Integer;
begin
  SetLength(AThirdTable,120);
  locThirdActualLen := 0;
  for locHighByte := 0 to 1023 do begin
    FillChar(locTableItem2,SizeOf(locTableItem2),#0);
    for locLowByte0 := 0 to 31 do begin
      FillChar(locTableItem3,SizeOf(locTableItem3),#0);
      for locLowByte1 := 0 to 31 do begin
        locCP := ToUCS4(HIGH_SURROGATE_BEGIN + locHighByte,LOW_SURROGATE_BEGIN + (locLowByte0*32) + locLowByte1);
        locTableItem3[locLowByte1] := GetPropID(locCP,ADataLineList);
      end;
      i := IndexOf(@locTableItem3,AThirdTable,locThirdActualLen);
      if (i = -1) then begin
        if (locThirdActualLen = Length(AThirdTable)) then
          SetLength(AThirdTable,locThirdActualLen + 50);
        i := locThirdActualLen;
        AThirdTable[i] := locTableItem3;
        Inc(locThirdActualLen);
      end;
      locTableItem2[locLowByte0] := i;
    end;
    i := IndexOf(@locTableItem2,ASecondTable);
    if (i = -1) then begin
      i := Length(ASecondTable);
      SetLength(ASecondTable,(i + 1));
      ASecondTable[i] := locTableItem2;
    end;
    AFirstTable[locHighByte] := i;
  end;
  SetLength(AThirdTable,locThirdActualLen);
end;

procedure GenerateOBmpTables(
        ADest : TStream;
  var   AFirstTable   : TOBmpFirstTable;
  var   ASecondTable  : TOBmpSecondTable
);
  procedure AddLine(const ALine : ansistring);
  var
    buffer : ansistring;
  begin
    buffer := ALine + sLineBreak;
    ADest.Write(buffer[1],Length(buffer));
  end;

var
  i, j, c : Integer;
  locLine : string;
begin
  AddLine('const');
  AddLine('  UCO_TABLE_1 : array[0..' + IntToStr(HIGH_SURROGATE_COUNT-1) + '] of Word = (');
  locLine := '';
  for i := Low(AFirstTable) to High(AFirstTable) - 1 do begin
    locLine := locLine + IntToStr(AFirstTable[i]) + ',';
    if (((i+1) mod 16) = 0) then begin
      locLine := '    ' + locLine;
      AddLine(locLine);
      locLine := '';
    end;
  end;
  locLine := locLine + IntToStr(AFirstTable[High(AFirstTable)]);
  locLine := '    ' + locLine;
  AddLine(locLine);
  AddLine('  );' + sLineBreak);

  AddLine('  UCO_TABLE_2 : array[0..('+IntToStr(LOW_SURROGATE_COUNT)+'*' + IntToStr(Length(ASecondTable)) +'-1)] of Word =(');
  c := High(ASecondTable);
  for i := Low(ASecondTable) to c do begin
    locLine := '';
    for j := Low(TOBmpSecondTableItem) to High(TOBmpSecondTableItem) do begin
      locLine := locLine + IntToStr(ASecondTable[i][j]) + ',';
      if (((j+1) mod 16) = 0) then begin
        if (i = c) and (j = High(TOBmpSecondTableItem)) then
          Delete(locLine,Length(locLine),1);
        locLine := '    ' + locLine;
        AddLine(locLine);
        locLine := '';
      end;
    end;
  end;
  AddLine('  );' + sLineBreak);
end;


//----------------------------------
procedure Generate3lvlOBmpTables(
        ADest : TStream;
  var   AFirstTable   : T3lvlOBmp1Table;
  var   ASecondTable  : T3lvlOBmp2Table;
  var   AThirdTable   : T3lvlOBmp3Table
);

  procedure AddLine(const ALine : ansistring);
  var
    buffer : ansistring;
  begin
    buffer := ALine + sLineBreak;
    ADest.Write(buffer[1],Length(buffer));
  end;

var
  i, j, c : Integer;
  locLine : string;
begin
  AddLine('const');
  AddLine('  UCO_TABLE_1 : array[0..1023] of Word = (');
  locLine := '';
  for i := Low(AFirstTable) to High(AFirstTable) - 1 do begin
    locLine := locLine + IntToStr(AFirstTable[i]) + ',';
    if (((i+1) mod 16) = 0) then begin
      locLine := '    ' + locLine;
      AddLine(locLine);
      locLine := '';
    end;
  end;
  locLine := locLine + IntToStr(AFirstTable[High(AFirstTable)]);
  locLine := '    ' + locLine;
  AddLine(locLine);
  AddLine('  );' + sLineBreak);

  AddLine('  UCO_TABLE_2 : array[0..' + IntToStr(Length(ASecondTable)-1) +'] of array[0..31] of Word = (');
  c := High(ASecondTable);
  for i := Low(ASecondTable) to c do begin
    locLine := '(';
    for j := Low(T3lvlOBmp2TableItem) to High(T3lvlOBmp2TableItem) do
      locLine := locLine + IntToStr(ASecondTable[i][j]) + ',';
    Delete(locLine,Length(locLine),1);
    locLine := '    ' + locLine + ')';
    if (i < c) then
      locLine := locLine + ',';
    AddLine(locLine);
  end;
  AddLine('  );' + sLineBreak);

  AddLine('  UCO_TABLE_3 : array[0..' + IntToStr(Length(AThirdTable)-1) +'] of array[0..31] of Word = (');
  c := High(AThirdTable);
  for i := Low(AThirdTable) to c do begin
    locLine := '(';
    for j := Low(T3lvlOBmp3TableItem) to High(T3lvlOBmp3TableItem) do
      locLine := locLine + IntToStr(AThirdTable[i][j]) + ',';
    Delete(locLine,Length(locLine),1);
    locLine := '    ' + locLine + ')';
    if (i < c) then
      locLine := locLine + ',';
    AddLine(locLine);
  end;
  AddLine('  );' + sLineBreak);
end;

function GetProp(
  const AHighS,
        ALowS         : Word;
  const AProps        : TPropRecArray;
  var   AFirstTable   : TOBmpFirstTable;
  var   ASecondTable  : TOBmpSecondTable
): PPropRec;
begin
  Result := @AProps[ASecondTable[AFirstTable[AHighS-HIGH_SURROGATE_BEGIN]][ALowS-LOW_SURROGATE_BEGIN]];
end;

function GetProp(
  const AHighS,
        ALowS         : Word;
  const AProps        : TPropRecArray;
  var   AFirstTable   : T3lvlOBmp1Table;
  var   ASecondTable  : T3lvlOBmp2Table;
  var   AThirdTable   : T3lvlOBmp3Table
): PPropRec;
begin
  Result := @AProps[AThirdTable[ASecondTable[AFirstTable[AHighS]][ALowS div 32]][ALowS mod 32]];
  //Result := @AProps[ASecondTable[AFirstTable[AHighS-HIGH_SURROGATE_BEGIN]][ALowS-LOW_SURROGATE_BEGIN]];
end;

{ TUCA_PropItemContextTreeRec }

function TUCA_PropItemContextTreeRec.GetData : PUCA_PropItemContextTreeNodeRec;
begin
  if (Size = 0) then
    Result := nil
  else
    Result := PUCA_PropItemContextTreeNodeRec(
                PtrUInt(
                  PtrUInt(@Self) + SizeOf(UInt24){Size}
                )
              );
end;

{ TUCA_LineContextRec }

procedure TUCA_LineContextRec.Clear;
begin
  Data := nil
end;

procedure TUCA_LineContextRec.Assign(ASource : TUCA_LineContextRec);
var
  c, i : Integer;
begin
  c := Length(ASource.Data);
  SetLength(Self.Data,c);
  for i := 0 to c-1 do
    Self.Data[i].Assign(ASource.Data[i]);
end;

function TUCA_LineContextRec.Clone : TUCA_LineContextRec;
begin
  Result.Clear();
  Result.Assign(Self);
end;

{ TUCA_LineContextItemRec }

procedure TUCA_LineContextItemRec.Clear();
begin
  CodePoints := nil;
  Weights := nil;
end;

procedure TUCA_LineContextItemRec.Assign(ASource : TUCA_LineContextItemRec);
begin
  Self.CodePoints := Copy(ASource.CodePoints);
  Self.Weights := Copy(ASource.Weights);
end;

function TUCA_LineContextItemRec.Clone() : TUCA_LineContextItemRec;
begin
  Result.Clear();
  Result.Assign(Self);
end;

{ TUCA_LineRec }

procedure TUCA_LineRec.Clear;
begin
  CodePoints := nil;
  Weights := nil;
  Deleted := False;
  Stored := False;
  Context.Clear();
end;

procedure TUCA_LineRec.Assign(ASource : TUCA_LineRec);
begin
  Self.CodePoints := Copy(ASource.CodePoints);
  Self.Weights := Copy(ASource.Weights);
  Self.Deleted := ASource.Deleted;
  Self.Stored := ASource.Stored;
  Self.Context.Assign(ASource.Context);
end;

function TUCA_LineRec.Clone : TUCA_LineRec;
begin
  Result.Clear();
  Result.Assign(Self);
end;

function TUCA_LineRec.HasContext() : Boolean;
begin
  Result := (Length(Context.Data) > 0);
end;

{ TPropRec }

function TPropRec.GetCategory: TUnicodeCategory;
begin
  Result := TUnicodeCategory((CategoryData and Byte($F8)) shr 3);
end;

procedure TPropRec.SetCategory(AValue: TUnicodeCategory);
var
  b : Byte;
begin
  b := Ord(AValue);
  b := b shl 3;
  CategoryData := CategoryData or b;
  //CategoryData := CategoryData or Byte(Byte(Ord(AValue)) shl 3);
end;

function TPropRec.GetWhiteSpace: Boolean;
begin
  Result := IsBitON(CategoryData,0);
end;

procedure TPropRec.SetWhiteSpace(AValue: Boolean);
begin
  SetBit(CategoryData,0,AValue);
end;

function TPropRec.GetHangulSyllable: Boolean;
begin
  Result := IsBitON(CategoryData,1);
end;

procedure TPropRec.SetHangulSyllable(AValue: Boolean);
begin
   SetBit(CategoryData,1,AValue);
end;

{ TUCA_PropItemRec }

function TUCA_PropItemRec.GetWeightLength: TWeightLength;
begin
  //Result := TWeightLength(Valid and Byte($FC) shr 3);
  Result := TWeightLength((Valid and Byte($F8)) shr 3);
end;

procedure TUCA_PropItemRec.SetWeightLength(AValue: TWeightLength);
begin
  Valid := Valid or Byte(Byte(AValue) shl 3);
end;

function TUCA_PropItemRec.GetWeightSize : Word;
var
  c : Integer;
begin
  c := WeightLength;
  if (c = 0) then
    exit(0);
  Result := c*SizeOf(TUCA_PropWeights);
  if IsBitON(Self.Valid,BIT_POS_COMPRESS_WEIGHT_1) then
    Result := Result - 1;
  if IsBitON(Self.Valid,BIT_POS_COMPRESS_WEIGHT_2) then
    Result := Result - 1;
end;

procedure TUCA_PropItemRec.GetWeightArray(ADest: PUCA_PropWeights);
var
  i, c : Integer;
  p : PByte;
  pd : PUCA_PropWeights;
begin
  c := WeightLength;
  p := PByte(PtrUInt(@Self) + SizeOf(TUCA_PropItemRec));
  pd := ADest;
  pd^.Weights[0] := PWord(p)^;
  p := p + 2;
  if IsBitON(Self.Valid,BIT_POS_COMPRESS_WEIGHT_1) then begin
    pd^.Weights[1] := PWord(p)^;
    p := p + 2;
  end else begin
    pd^.Weights[1] := p^;
    p := p + 1;
  end;
  if IsBitON(Self.Valid,BIT_POS_COMPRESS_WEIGHT_2) then begin
    pd^.Weights[2] := PWord(p)^;
    p := p + 2;
  end else begin
    pd^.Weights[2] := p^;
    p := p + 1;
  end;
  if (c > 1) then
    Move(p^, (pd+1)^, ((c-1)*SizeOf(TUCA_PropWeights)));
end;

function TUCA_PropItemRec.GetSelfOnlySize: Word;
begin
  Result := SizeOf(TUCA_PropItemRec);
  if (WeightLength > 0) then begin
    Result := Result + (WeightLength * Sizeof(TUCA_PropWeights));
    if not IsBitON(Self.Valid,BIT_POS_COMPRESS_WEIGHT_1) then
      Result := Result - 1;
    if not IsBitON(Self.Valid,BIT_POS_COMPRESS_WEIGHT_2) then
      Result := Result - 1;
  end;
end;

procedure TUCA_PropItemRec.SetContextual(AValue : Boolean);
begin
  SetBit(Flags,FLAG_CONTEXTUAL,AValue);
end;

function TUCA_PropItemRec.GetContextual : Boolean;
begin
  Result := IsBitON(Flags,FLAG_CONTEXTUAL);
end;

function TUCA_PropItemRec.GetContext() : PUCA_PropItemContextTreeRec;
var
  p : PtrUInt;
begin
  if not Contextual then
    exit(nil);
  p := PtrUInt(@Self) + SizeOf(TUCA_PropItemRec);
  if IsBitON(Flags,FLAG_CODEPOINT) then
    p := p + SizeOf(UInt24);
  Result := PUCA_PropItemContextTreeRec(p);
end;

procedure TUCA_PropItemRec.SetDeleted(AValue: Boolean);
begin
  SetBit(Flags,FLAG_DELETION,AValue);
end;

function TUCA_PropItemRec.IsDeleted: Boolean;
begin
  Result := IsBitON(Flags,FLAG_DELETION);
end;

function TUCA_PropItemRec.GetCodePoint: UInt24;
begin
  Result := PUInt24(PtrUInt(@Self) + Self.GetSelfOnlySize())^;
end;

function avl_CompareCodePoints(Item1, Item2: Pointer): Integer;
var
  a, b : PUCA_LineContextItemRec;
  i, hb : Integer;
begin
  if (Item1 = Item2) then
    exit(0);
  if (Item1 = nil) then
    exit(-1);
  if (Item2 = nil) then
    exit(1);
  a := Item1;
  b := Item2;
  if (a^.CodePoints = b^.CodePoints) then
    exit(0);
  Result := 1;
  hb := Length(b^.CodePoints) - 1;
  for i := 0 to Length(a^.CodePoints) - 1 do begin
    if (i > hb) then
      exit;
    if (a^.CodePoints[i] < b^.CodePoints[i]) then
      exit(-1);
    if (a^.CodePoints[i] > b^.CodePoints[i]) then
      exit(1);
  end;
  if (Length(a^.CodePoints) = Length(b^.CodePoints)) then
    exit(0);
  exit(-1);
end;

function ConstructAvlContextTree(AContext : PUCA_LineContextRec) : TAVLTree;
var
  r : TAVLTree;
  i : Integer;
begin
  r := TAVLTree.Create(@avl_CompareCodePoints);
  try
    for i := 0 to Length(AContext^.Data) - 1 do
      r.Add(@AContext^.Data[i]);
    Result := r;
  except
    FreeAndNil(r);
    raise;
  end;
end;

function ConstructContextTree(
  const AContext : PUCA_LineContextRec;
  var   ADestBuffer;
  const ADestBufferLength : Integer
) : PUCA_PropItemContextTreeRec;

  function CalcItemOnlySize(AItem : TAVLTreeNode) : Cardinal;
  var
    kc : Integer;
    kitem : PUCA_LineContextItemRec;
  begin
    if (AItem = nil) then
      exit(0);
    kitem := AItem.Data;
    Result := SizeOf(PUCA_PropItemContextTreeNodeRec^.Left) +
              SizeOf(PUCA_PropItemContextTreeNodeRec^.Right) +
              SizeOf(PUCA_PropItemContextRec^.CodePointCount) +
                (Length(kitem^.CodePoints)*SizeOf(UInt24)) +
              SizeOf(PUCA_PropItemContextRec^.WeightCount) +
                (Length(kitem^.Weights)*SizeOf(TUCA_PropWeights));
  end;

  function CalcItemSize(AItem : TAVLTreeNode) : Cardinal;
  begin
    if (AItem = nil) then
      exit(0);
    Result := CalcItemOnlySize(AItem);
    if (AItem.Left <> nil) then
      Result := Result + CalcItemSize(AItem.Left);
    if (AItem.Right <> nil) then
      Result := Result + CalcItemSize(AItem.Right);
  end;

  function CalcSize(AData : TAVLTree) : Cardinal;
  begin
    Result := SizeOf(PUCA_PropItemContextTreeRec^.Size) + CalcItemSize(AData.Root);
  end;

  function ConstructItem(ASource : TAVLTreeNode; ADest : PUCA_PropItemContextTreeNodeRec) : Cardinal;
  var
    k : Integer;
    kitem : PUCA_LineContextItemRec;
    kpcp : PUInt24;
    kpw : PUCA_PropWeights;
    pextra : PtrUInt;
    pnext : PUCA_PropItemContextTreeNodeRec;
  begin
    kitem := ASource.Data;
    ADest^.Data.CodePointCount := Length(kitem^.CodePoints);
    ADest^.Data.WeightCount := Length(kitem^.Weights);
    pextra := PtrUInt(ADest)+SizeOf(ADest^.Left)+SizeOf(ADest^.Right)+
              SizeOf(ADest^.Data.CodePointCount)+SizeOf(ADest^.Data.WeightCount);
    if (ADest^.Data.CodePointCount > 0) then begin
      kpcp := PUInt24(pextra);
      for k := 0 to ADest^.Data.CodePointCount - 1 do begin
        kpcp^ := kitem^.CodePoints[k];
        Inc(kpcp);
      end;
    end;
    if (ADest^.Data.WeightCount > 0) then begin
      kpw := PUCA_PropWeights(pextra + (ADest^.Data.CodePointCount*SizeOf(UInt24)));
      for k := 0 to ADest^.Data.WeightCount - 1 do begin
        kpw^.Weights[0] := kitem^.Weights[k].Weights[0];
        kpw^.Weights[1] := kitem^.Weights[k].Weights[1];
        kpw^.Weights[2] := kitem^.Weights[k].Weights[2];
        Inc(kpw);
      end;
    end;
    Result := CalcItemOnlySize(ASource);
    if (ASource.Left <> nil) then begin
      pnext := PUCA_PropItemContextTreeNodeRec(PtrUInt(ADest) + Result);
      ADest^.Left := Result;
      Result := Result + ConstructItem(ASource.Left,pnext);
    end else begin
      ADest^.Left := 0;
    end;
    if (ASource.Right <> nil) then begin
      pnext := PUCA_PropItemContextTreeNodeRec(PtrUInt(ADest) + Result);
      ADest^.Right := Result;
      Result := Result + ConstructItem(ASource.Right,pnext);
    end else begin
      ADest^.Right := 0;
    end;
  end;

var
  c : PtrUInt;
  r : PUCA_PropItemContextTreeRec;
  p : PUCA_PropItemContextTreeNodeRec;
  tempTree : TAVLTree;
begin
  tempTree := ConstructAvlContextTree(AContext);
  try
    c := CalcSize(tempTree);
    if (ADestBufferLength > 0) and (c > ADestBufferLength) then
      raise Exception.Create(SInsufficientMemoryBuffer);
    r := @ADestBuffer;
    r^.Size := c;
    p := PUCA_PropItemContextTreeNodeRec(PtrUInt(r) + SizeOf(r^.Size));
    ConstructItem(tempTree.Root,p);
  finally
    tempTree.Free();
  end;
  Result := r;
end;

initialization
  FS := DefaultFormatSettings;
  FS.DecimalSeparator := '.';

end.