unit minibidi;

{**

* This file is part of the "Mini Library"

*

* @license MIT

*

* @author Zaher Dirkey

*}

{$IFDEF FPC}

{$MODE objfpc}

{$ELSE}

{$ENDIF}

{$H+}

(************************************************************************

* Ported from minibidi.c

* Original header

* ------------

* Description:

* ------------

* This is an implemention of Unicode's Bidirectional Algorithm

* (known as UAX #9).

*

* http://www.unicode.org/reports/tr9/

*

* Author: Ahmad Khalifa

*

************************************************************************)

{

* Ported with improvements to Pascal by: Zaher Dirkey, zaher at gmail.com

* License under MIT license

*}

{***********************************************************************

http://cvs.arabeyes.org/viewcvs/projects/adawat/minibidi

http://svn.tartarus.org/sgt/putty/minibidi.c?r1=8097&view=log

///http://portaputty.googlecode.com/svn-history/r6/trunk/minibidi.c

http://www.unicode.org/Public/PROGRAMS/BidiReferenceCpp/

http://unicode.org/cldr/utility/bidi.jsp

https://unicode-table.com/en/blocks/arabic-presentation-forms-a/

https://unicode-table.com/en/blocks/arabic-presentation-forms-b/

***********************************************************************}

{

Bugs

* 'arabic words #13#10'

when Start is Default or RightToLeft, converted to:

'#13#10 words arabic'

the problem the control chars moved to the first

* search for '- 1]' for Types[i - 1], there is no -1 element, it is give range check error

test ET chars

}

interface

uses

Classes, SysUtils;

type

TBidiParagraph = (bdpDefault, bdpLeftToRight, bdpRightToLeft);

TBidiNumbers = (bdnContext, bdnLatin, bdnArabic); //TODO or Latin =Arabic, and Arabic =Hindi, but for me it names Arabic1, Arabic2 it is not Hindi, need to extended mirror

TBidiOptions = set of (bdoApplyShape, bdoReorderCombining);

TBidiLigatures = (bdlComplex, bdlSimple, bdlNone);

function BidiString(const Text: UnicodeString; Options: TBidiOptions = [bdoApplyShape]; Numbers: TBidiNumbers = bdnContext; Start: TBidiParagraph = bdpDefault; Ligatures: TBidiLigatures = bdlComplex): UnicodeString;

function BidiText(Line: PWideChar; Count: Integer; Options: TBidiOptions = [bdoApplyShape]; Numbers: TBidiNumbers = bdnContext; Start: TBidiParagraph = bdpDefault; Ligatures: TBidiLigatures = bdlComplex): Integer;

implementation

const

{$IFDEF FPC}

{$ELSE}

cMAX = MaxInt div sizeof(Integer) - 1;

{$ENDIF}

MAX_STACK = 60;

LMASK = $3F; { Embedding Level mask }

OMASK = $C0; { Override mask }

OISL = $80; { Override is L }

OISR = $40; { Override is R }

type

{ Shaping Types }

TShapeType =

(

stSL, { Left-Joining, doesnt exist in U+0600 - U+06FF }

stSR, { Right-Joining, ie has Isolated, Final }

stSD, { Dual-Joining, ie has Isolated, Final, Initial, Medial }

stSU, { Non-Joining }

stSC { Join-Causing, like U+0640 (TATWEEL) }

);

{ character Types }

TCharacterType =

(

{ Strong Char Types }

ctL, { Left-to-Right char }

ctLRE, { Left-to-Right Embedding }

ctLRO, { Left-to-Right Override }

ctR, { Right-to-Left char }

ctAL, { Right-to-Left Arabic char }

ctRLE, { Right-to-Left Embedding }

ctRLO, { Right-to-Left Override }

{ Weak Char Types }

ctPDF, { Pop Directional Format }

ctEN, { European Number }

ctES, { European Number Separator }

ctET, { European Number Terminator }

ctAN, { Arabic Number }

ctCS, { Common Number Separator }

ctNSM, { Non Spacing Mark }

ctBN, { Boundary Neutral }

{ Neutral Char Types }

ctB, { Paragraph Separator }

ctS, { Segment Separator }

ctWS, { Whitespace }

ctON { Other Neutrals }

);

{$IFDEF FPC}

PCharacterType = ^TCharacterType;

{$ELSE}

TCharacterTypes = array[0..cMAX] of TCharacterType;

PCharacterType = ^TCharacterTypes;

{$ENDIF}

// PShapeType = ^TShapeType;

TLevel = Integer;

{$IFDEF FPC}

PLevel = ^TLevel;

{$ELSE}

TLevels = array[0..cMAX] of TLevel;

PLevel = ^TLevels;

{$ENDIF}

{$I minibidi.inc}

function BidiString(const Text: UnicodeString; Options: TBidiOptions; Numbers: TBidiNumbers; Start: TBidiParagraph; Ligatures: TBidiLigatures): UnicodeString;

var

l: Integer;

begin

Result := UnicodeString(Text); //for new string can be changed safe by BidiText

l := BidiText(PWideChar(Result), Length(Result), Options, Numbers, Start, Ligatures);

SetLength(Result, l);

end;

{

from here minibidi.c

}

{ Returns the first odd/even value greater than x }

function even(x: Integer): Boolean;

begin

Result := not Odd(x);

end;

function LeastGreaterOdd(x: Integer): Integer;

begin

if odd(x) then

Result := (x + 2)

else

Result := (x + 1);

end;

function LeastGreaterEven(x: Integer): Integer;

begin

if odd(x) then

Result := (x + 1)

else

Result := (x + 2);

end;

{ Shaping Helpers }

function ShapeType(xh: WideChar): TShapeType;

begin

if ((xh >= SHAPE_FIRST) and (xh <= SHAPE_LAST)) then

Result := ShapeTypes[ord(xh) - ord(SHAPE_FIRST)].ST

else

Result := stSU;

end;

function SISOLATED(xh: WideChar): WideChar;

begin

Result := ShapeTypes[Ord(xh) - ord(SHAPE_FIRST)].CH;

end;

function SFINAL(xh: WideChar): WideChar;

begin

Result := WideChar(Ord(xh) + 1);

end;

function SINITIAL(xh: WideChar): WideChar;

begin

Result := WideChar(Ord(xh) + 2);

end;

function SMEDIAL(xh: WideChar): WideChar;

begin

Result := WideChar(Ord(xh) + 3);

end;

{ function GetType

* Return the type of char using CharLookup array

}

function GetType(ch: WideChar): TCharacterType;

var

i, j, k: Integer;

begin

i := -1;

j := Length(CharLookup);

Result := ctON;

while (j - i > 1) do

begin

k := (i + j) div 2;

if (ch < CharLookup[k].Fr) then

j := k

else if (ch > CharLookup[k].Lt) then

i := k

else

begin

Result := CharLookup[k].CT;

break;

end;

end;

{*

* If we reach here, the character was not in any of the

* intervals listed in the lookup table. This means we return

* ON (`Other Neutrals'). This is the appropriate code for any

* character genuinely not listed in the Unicode table, and

* also the table above has deliberately left out any

* characters _explicitly_ listed as ON (to save space!).

*}

end;

{ Finds the index of a run with level equals tlevel }

function FindIndexOfRun(const Levels: PLevel; Start, Count: Integer; Level: TLevel): Integer;

var

i: Integer;

begin

Result := Count;

for i := Start to Count - 1 do

begin

if (Level <= Levels[i]) then

begin

Result := i;

break;

end;

end;

end;

{*

* Flips the text buffer, according to max level, and

* all higher Levels

*

* Input:

* Line: text buffer, on which to apply flipping

* Levels: resolved Levels buffer

* Max: the maximum level found in this Line (should be unsigned char)

* Count: Line size in wchar_t

*}

procedure FlipThisRun(Line: PWideChar; Levels: PLevel; Max, Count: Integer);

var

i, j, k: Integer;

Level: TLevel;

temp: WideChar;

begin

j := 0;

i := 0;

while (i < Count) and (j < Count) do

begin

{ find the start of the run of level=max }

Level := Max;

i := FindIndexOfRun(Levels, i, Count, Max);

j := i;

{ find the end of the run }

while ((i < Count) and (Level <= Levels[i])) do

Inc(i);

k := i - 1;

while (k > j) do

begin

temp := Line[k];

Line[k] := Line[j];

Line[j] := temp;

Dec(k);

Inc(j);

end;

end;

end;

function GetParagraphLevel(OrigTypes: PCharacterType; Count: Integer): TLevel;

var

i: Integer;

begin

Result := 0;

for i := 0 to Count - 1 do

begin

case OrigTypes[i] of

ctR, ctAL:

begin

Result := 1;

exit;

end;

ctL:

begin

Result := 0;

exit;

end;

end;

end;

end;

{*

* Returns character type of ch, by calling RLE table lookup

* function

*}

function getCAPRtl(ch: WideChar): TCharacterType;

{ CAPRtl Charset }

const

cTypesFromChar: array[0..127] of TCharacterType =

(

ctON, ctON, ctON, ctON, ctL, ctR, ctON, ctON, ctON, ctON, ctON, ctON, ctON, ctB, ctRLO, ctRLE, { 00-0f }

ctLRO, ctLRE, ctPDF, ctWS, ctON, ctON, ctON, ctON, ctON, ctON, ctON, ctON, ctON, ctON, ctON, ctON, { 10-1f }

ctWS, ctON, ctON, ctON, ctET, ctON, ctON, ctON, ctON, ctON, ctON, ctET, ctCS, ctON, ctES, ctES, { 20-2f }

ctEN, ctEN, ctEN, ctEN, ctEN, ctEN, ctAN, ctAN, ctAN, ctAN, ctLRE, ctRLE, ctRLO, ctPDF, ctLRO, ctON, { 30-3f }

// ctEN, ctEN, ctEN, ctEN, ctEN, ctEN, ctAN, ctAN, ctAN, ctAN, ctCS, ctON, ctON, ctON, ctON, ctON, { 30-3f }

ctR, ctAL, ctAL, ctAL, ctAL, ctAL, ctAL, ctR, ctR, ctR, ctR, ctR, ctR, ctR, ctR, ctR, { 40-4f }

ctR, ctR, ctR, ctR, ctR, ctR, ctR, ctR, ctR, ctR, ctR, ctON, ctB, ctON, ctON, ctON, { 50-5f }

ctNSM, ctL, ctL, ctL, ctL, ctL, ctL, ctL, ctL, ctL, ctL, ctL, ctL, ctL, ctL, ctL, { 60-6f }

ctL, ctL, ctL, ctL, ctL, ctL, ctL, ctL, ctL, ctL, ctL, ctON, ctS, ctON, ctON, ctON { 70-7f }

);

begin

if (ch < #$007F) then

Result := cTypesFromChar[ord(ch)]

else

Result := ctR;

end;

{

* takes a pointer to a character that is checked for

* having a mirror glyph, and replaced on the spot

}

procedure DoMirror(var ch: WideChar);

var

i, j, k: Integer;

begin

i := -1;

j := Length(MirrorLookup);

while (j - i > 1) do

begin

k := (i + j) div 2;

if (ch < MirrorLookup[k].Idx) then

j := k

else if (ch > MirrorLookup[k].Idx) then

i := k

else if (ch = MirrorLookup[k].Idx) then

begin

ch := MirrorLookup[k].Mr;

break;

end;

end;

end;

{* The Main shaping function, and the only one to be used

* by the outside world.

*

* Line: buffer to apply shaping to. this must be passed by doBidi() first

* ToLine: output buffer for the shaped data

* from: start bidi at this index

* Count: number of characters in Line

*}

function DoShape(Line: PWideChar; var ToLine: PWideChar; From: Integer; Count: Integer; Ligatures: TBidiLigatures; OrigTypes: PCharacterType): Integer;

var

i, j: Integer;

ligFlag: Boolean;

prevTemp, nextTemp: TShapeType;

nWC: WideChar;

begin

ligFlag := False;

i := From;

while i < Count do

begin

{ Get Previous and next Characters type }

j := i - 1;

while (j >= 0) and (OrigTypes[j] = ctNSM) do

Dec(j);

if j >= 0 then

prevTemp := ShapeType(Line[j])

else

prevTemp := stSU;

j := i + 1;

while (j < Count) and (OrigTypes[j] = ctNSM) do

Inc(j);

if j < Count then

nextTemp := ShapeType(Line[j])

else

nextTemp := stSU;

case (ShapeType(Line[i])) of

stSC, stSU:

ToLine[i] := Line[i];

stSR:

if (prevTemp = stSD) or (prevTemp = stSC) then

ToLine[i] := SFINAL(SISOLATED(Line[i]))

else

ToLine[i] := SISOLATED(Line[i]);

stSD:

begin

{ Make Ligatures }

if (Line[i] = #$0644) then //{LAM}

begin

nWC := #0;

j := i + 1;

while (j < Count) and (OrigTypes[j] = ctNSM) do

Inc(j);

if j < Count then

nWC := Line[j];

case (nWC) of

#$0622: //{ALEF WITH MADDA ABOVE}

begin

ligFlag := True;

if (prevTemp = stSD) or (prevTemp = stSC) then

ToLine[i] := #$FEF6

else

ToLine[i] := #$FEF5;

end;

#$623: //{ALEF WITH HAMZA ABOVE}

begin

ligFlag := True;

if (prevTemp = stSD) or (prevTemp = stSC) then

ToLine[i] := #$FEF8

else

ToLine[i] := #$FEF7;

end;

#$625: {ALEF WITH HAMZA BELOW}

begin

ligFlag := True;

if (prevTemp = stSD) or (prevTemp = stSC) then

ToLine[i] := #$FEFA

else

ToLine[i] := #$FEF9;

end;

#$627: //{ALEF}

begin

ligFlag := True;

if (prevTemp = stSD) or (prevTemp = stSC) then

ToLine[i] := #$FEFC

else

ToLine[i] := #$FEFB;

end;

end;

end; //end of {if (Line[i] = #$0644) then}

if ligFlag then

begin

if Ligatures = bdlSimple then

ToLine[j] := #$20

else

ToLine[j] := #$0; //dead char for delete

i := j;

ligFlag := False;

end

else if ((prevTemp = stSD) or (prevTemp = stSC)) then

begin

if (nextTemp = stSR) or (nextTemp = stSD) or (nextTemp = stSC) then

ToLine[i] := SMEDIAL(SISOLATED(Line[i]))

else

ToLine[i] := SFINAL(SISOLATED(Line[i]));

end

else

begin

if (nextTemp = stSR) or (nextTemp = stSD) or (nextTemp = stSC) then

ToLine[i] := SINITIAL(SISOLATED(Line[i]))

else

ToLine[i] := SISOLATED(Line[i]);

end;

end;

end; //case ShapeType

Inc(i);

end;

Result := i;

end;

{

Rule (X1), (X2), (X3), (X4), (X5), (X6), (X7), (X8), (X9)

returns the length of the string without explicit marks

}

function DoTypes(Line: PWideChar; ParagraphLevel: TLevel; Types: PCharacterType; Levels: PLevel; Count: Integer; fX: Boolean; OrigTypes: PCharacterType): Integer;

var

tempType: TCharacterType;

CurrentEmbedding: Integer;

CurrentOverride: TCharacterType;

LevelStack: array[0..MAX_STACK + 2] of TLevel;

OverrideStack: array[0..MAX_STACK + 2] of TCharacterType;

StackTop: Integer;

i, j: Integer;

begin

CurrentEmbedding := ParagraphLevel;

CurrentOverride := ctON;

StackTop := 0;

if fX then

begin

j := 0;

for i := 0 to Count - 1 do

begin

tempType := OrigTypes[i];

case tempType of

ctRLE:

if (stackTop < MAX_STACK) then

begin

LevelStack[stackTop] := CurrentEmbedding;

OverrideStack[stackTop] := currentOverride;

Inc(StackTop);

CurrentEmbedding := LeastGreaterOdd(currentEmbedding);

CurrentOverride := ctON;

end;

ctLRE:

if (stackTop < MAX_STACK) then

begin

LevelStack[stackTop] := CurrentEmbedding;

OverrideStack[stackTop] := CurrentOverride;

Inc(StackTop);

CurrentEmbedding := LeastGreaterEven(CurrentEmbedding);

CurrentOverride := ctON;

end;

ctRLO:

if (stackTop < MAX_STACK) then

begin

LevelStack[stackTop] := CurrentEmbedding;

overrideStack[stackTop] := CurrentOverride;

Inc(StackTop);

CurrentEmbedding := leastGreaterOdd(CurrentEmbedding);

CurrentOverride := ctR;

end;

ctLRO:

if (stackTop <= MAX_STACK) then

begin

LevelStack[stackTop] := CurrentEmbedding;

OverrideStack[stackTop] := CurrentOverride;

Inc(StackTop);

CurrentEmbedding := LeastGreaterEven(CurrentEmbedding);

CurrentOverride := ctL;

end;

ctPDF:

if (stackTop > 0) then

begin

CurrentEmbedding := LevelStack[StackTop - 1];

CurrentOverride := OverrideStack[StackTop - 1];

Dec(StackTop);

end;

{ Whitespace is treated as neutral for now }

ctWS, ctB, ctS:

begin

Line[j] := Line[i];

OrigTypes[j] := OrigTypes[i];

Levels[j] := CurrentEmbedding;

tempType := ctON;

if (currentOverride <> ctON) then

tempType := CurrentOverride;

Types[j] := TempType;

Inc(j);

end;

else

begin

Line[j] := Line[i];

OrigTypes[j] := OrigTypes[i];

Levels[j] := CurrentEmbedding;

if (currentOverride <> ctON) then

tempType := CurrentOverride;

Types[j] := tempType;

Inc(j);

end;

end;

end;

end

else

begin

for i := 0 to Count - 1 do

begin

tempType := OrigTypes[i];

if (tempType = ctWS) or (tempType = ctB) or (tempType = ctS) then

tempType := ctON;

if (CurrentOverride <> ctON) then

tempType := CurrentOverride;

Levels[i] := CurrentEmbedding;

Types[i] := tempType;

end;

end;

if fX then

Result := j

else

Result := Count;

end;

{ Rule (W3) }

procedure DoALtoR(Types: PCharacterType; Count: integer);

var

i: Integer;

begin

for i := 0 to Count - 1 do

begin

if (Types[i] = ctAL) then

Types[i] := ctR;

end;

end;

{

* The Main Bidi Function, and the only function that should

* be used by the outside world.

*

* Line: a buffer of size Count containing text to apply

* the Bidirectional algorithm to.

}

function BidiText(Line: PWideChar; Count: Integer; Options: TBidiOptions; Numbers: TBidiNumbers; Start: TBidiParagraph; Ligatures: TBidiLigatures): Integer;

var

Types: PCharacterType;

Levels: PLevel;

OrigTypes: PCharacterType;

ParagraphLevel: TLevel;

tempType, tempTypeSec: TCharacterType;

tempLevel: TLevel;

temp: WideChar;

i, j: Integer;

it: Integer;

fX, fAL, fET, fNSM: Boolean;

ShapeTo: PWideChar;

NewCount: Integer;

begin

// Result := 0;

if Count <= 0 then

begin

Result := 0;

exit;

end;

OrigTypes := AllocMem(SizeOf(TCharacterType) * Count);

try

for i := 0 to Count - 1 do

OrigTypes[i] := GetType(Line[i]);

fX := False;

fAL := False;

fET := False;

fNSM := False;

for i := 0 to Count - 1 do

begin

case OrigTypes[i] of

ctAL, ctR:

fAL := True;

ctLRE, ctLRO, ctRLE, ctRLO, ctPDF, ctBN:

fX := True;

ctET:

fET := True;

ctNSM:

fNSM := True;

end

end;

if (not fAL) and (not fX) then

begin

Result := Count;

exit; //nothing todo

end;

{ Initialize Types, Levels }

Types := AllocMem(SizeOf(TCharacterType) * Count);

Levels := AllocMem(SizeOf(TLevel) * Count);

try

{ Rule (P1) NOT IMPLEMENTED

* P1. Split the text into separate paragraphs. A paragraph separator is

* kept with the previous paragraph. Within each paragraph, apply all the

* other rules of this algorithm.

}

{ Rule (P2), (P3)

* P2. In each paragraph, find the first character of type L, AL, or R.

* P3. If a character is found in P2 and it is of type AL or R, then set

* the paragraph embedding level to one; otherwise, set it to zero.

}

case Start of

bdpLeftToRight:

ParagraphLevel := 0;

bdpRightToLeft:

ParagraphLevel := 1;

else

ParagraphLevel := GetParagraphLevel(OrigTypes, Count);

end;

{ Rule (X1), (X2), (X3), (X4), (X5), (X6), (X7), (X8), (X9)

* X1. Begin by setting the current embedding level to the paragraph

* embedding level. Set the directional override status to neutral.

* X2. With each RLE, compute the least greater odd embedding level.

* X3. With each LRE, compute the least greater even embedding level.

* X4. With each RLO, compute the least greater odd embedding level.

* X5. With each LRO, compute the least greater even embedding level.

* X6. For all Types besides RLE, LRE, RLO, LRO, and PDF:

* a. Set the level of the current character to the current

* embedding level.

* b. Whenever the directional override status is not neutral,

* reset the current character type to the directional

* override status.

* X7. With each PDF, determine the matching embedding or override code.

* If there was a valid matching code, restore (pop) the last

* remembered (pushed) embedding level and directional override.

* X8. All explicit directional embeddings and overrides are completely

* terminated at the end of each paragraph. Paragraph separators are not

* included in the embedding. (Useless here) NOT IMPLEMENTED

* X9. Remove all RLE, LRE, RLO, LRO, PDF, and BN codes.

* Here, they're converted to BN.

}

NewCount := DoTypes(Line, ParagraphLevel, Types, Levels, Count, fX, OrigTypes);

if NewCount < Count then

Count := NewCount;

if Count = 0 then

begin

Result := 0;

exit;

end;

{ Rule (W1)

* W1. Examine each non-spacing mark (NSM) in the level run, and change

* the type of the NSM to the type of the previous character. If the NSM

* is at the start of the level run, it will get the type of sor.

}

if (fNSM) then

begin

if (Types[0] = ctNSM) then

Types[0] := TCharacterType(ParagraphLevel); //TODO: wrong assign

for i := 1 to Count - 1 do //*

begin

if (Types[i] = ctNSM) then

Types[i] := Types[i - 1];

{ Is this a safe assumption?

* I assumed the previous, IS a character.

}

end

end;

{ Rule (W2)

* W2. Search backwards from each instance of a European number until the

* first strong type (R, L, AL, or sor) is found. If an AL is found,

* change the type of the European number to Arabic number.

}

for i := 0 to Count - 1 do

begin

if (Types[i] = ctEN) then

begin

tempLevel := Levels[i]; //zaher tempType -> tempLevel

j := i;

Dec(j);

while (j >= 0) and (Levels[j] = tempLevel) do

begin

if (Types[j] = ctAL) then

begin

Types[i] := ctAN;

break;

end

else if (Types[j] = ctR) or (Types[j] = ctL) then

begin

break;

end;

Dec(j);

end

end

end;

{ Rule (W3)

* W3. Change all ALs to R.

*

* Optimization: on Rule Xn, we might set a flag on AL type

* to prevent this loop in L R lines only...

}

doALtoR(Types, Count);

{ Rule (W4)

* W4. A single European separator between two European numbers changes

* to a European number. A single common separator between two numbers

* of the same type changes to that type.

}

//TODO: what if is the last char and after european number?

for i := 1 to Count - 2 do //1..count-2 for use [i - 1] [i + 1]

begin

if (Types[i] = ctES) then

begin

if (Types[i - 1] = ctEN) and (Types[i + 1] = ctEN) then

Types[i] := ctEN;

end else if (Types[i] = ctCS) then

begin

if (Types[i - 1] = ctEN) and (Types[i + 1] = ctEN) then

Types[i] := ctEN

else if (Types[i - 1] = ctAN) and (Types[i + 1] = ctAN) then

Types[i] := ctAN;

end

end;

{ Rule (W5)

* W5. A sequence of European terminators adjacent to European numbers

* changes to all European numbers.

*

* Optimization: lots here... else ifs need rearrangement

}

if (fET) then

begin

for i := 0 to Count - 1 do

begin

if (Types[i] = ctET) then

begin

if (i > 0) and (Types[i - 1] = ctEN) then

begin

Types[i] := ctEN;

//continue;//do we need it?

end

else if (i < Count - 2) and (Types[i + 1] = ctEN) then

begin

Types[i] := ctEN;

//continue;//do we need it?

end

else if (i < Count - 2) and (Types[i + 1] = ctET) then

begin

j := i + 1;

while (j < Count) and (Types[j] = ctET) do

Inc(j);

if (j < Count) and (Types[j] = ctEN) then

Types[i] := ctEN;

end

end

end

end;

{ Rule (W6)

* W6. Otherwise, separators and terminators change to Other Neutral:

}

for i := 0 to Count - 1 do

begin

case Types[i] of

ctES, ctET, ctCS:

Types[i] := ctON;

end

end;

{ Rule (W7)

* W7. Search backwards from each instance of a European number until

* the first strong type (R, L, or sor) is found. If an L is found,

* then change the type of the European number to L.

}

//TODO

for i := 0 to Count - 1 do

begin

if (Types[i] = ctEN) then

begin

tempLevel := Levels[i];

j := i;

Dec(j);

while (j >= 0) and (Levels[j] = tempLevel) do

begin

if (Types[j] = ctL) then

begin

Types[i] := ctL;

break;

end

else

if (Types[j] = ctR) or (Types[j] = ctAL) then

break;

Dec(j);

end

end

end;

{ Rule (N1)

* N1. A sequence of neutrals takes the direction of the surrounding

* strong text if the text on both sides has the same direction. European

* and Arabic numbers are treated as though they were R.

}

i := 0;

while i < Count - 1 do

begin

if (Types[i] = ctON) then

begin

if i = 0 then

tempType := ctR

else if (Types[i - 1] = ctR) or (Types[i - 1] = ctEN) or (Types[i - 1] = ctAN) then//TODO: bug '- 1]'

tempType := ctR

else

tempType := ctL;

tempTypeSec := ctL;

j := i;

while (j < Count) do

begin

tempTypeSec := Types[j];

if (tempTypeSec = ctON) then

Inc(j)

else

break;

end;

if (j = Count) then

begin

if odd(ParagraphLevel) then

tempTypeSec := ctR

else

tempTypeSec := ctL;

end;

if (((tempTypeSec = ctL) or (tempTypeSec = ctLRE)) and (tempType = ctL)) or

(((tempTypeSec = ctR) or (tempTypeSec = ctEN) or (tempTypeSec = ctAN)) and (tempType = ctR)) then

begin

while (i < j) do

begin

Types[i] := tempType;

inc(i);

end

end

else

i := j;

end;

inc(i);

end;

{ Rule (N2)

* N2. Any remaining neutrals take the embedding direction.

}

for i := 0 to Count - 1 do

begin

if (Types[i] = ctON) then

begin

if even(Levels[i]) then

Types[i] := ctL

else

Types[i] := ctR;

end

end;

{ Rule (I1) & (I2)

* I1. For all characters with an even (left-to-right) embedding

* direction, those of type R go up one level and those of type AN or

* EN go up two Levels.

* I2. For all characters with an odd (right-to-left) embedding direction,

* those of type L, EN or AN go up one level.

}

for i := 0 to Count - 1 do

begin

if Odd(Levels[i]) then

begin

if (Types[i] = ctL) or (Types[i] = ctEN) or (Types[i] = ctAN) then

Inc(Levels[i]);

end

else

begin

if (Types[i] = ctR) then

Inc(Levels[i])

else if (Types[i] = ctAN) or (Types[i] = ctEN) then

Levels[i] := Levels[i] + 2;

end

end;

{ Rule (L1)

* L1. On each Line, reset the embedding level of the following characters

* to the paragraph embedding level:

* (1)segment separators, (2)paragraph separators,

* (3)any sequence of whitespace characters preceding

* a segment separator or paragraph separator,

* (4)and any sequence of white space characters

* at the end of the Line.

* The Types of characters used here are the original Types, not those

* modified by the previous phase.

}