unit FarsiReshaper;
interface
uses System.Classes, System.Math;
type
TStruc = class sealed (TObject)
public
Character,
EndGlyph,
IniGlyph,
MidGlyph,
IsoGlyph: Char;
constructor Create(ACharacter, AEndGlyph, AIniGlyph, AMidGlyph, AIsoGlyph: Char);
end;
TFarsi = class sealed (TObject)
strict private
const N_DISTINCT_CHARACTERS = 43;
class var SzLamAndAlef: String;
class var SzLamStickAndAlef: String;
class var SzLa: String;
class var SzLaStick: String;
class var SzLamAndAlefWoosim: String;
class var SzLamStickAndAlefWoosim: String;
class var SzLaWoosim: String;
class var SzLaStickWoosim: String;
class var ArrStruc: array of TStruc;
class var ArrStrucWoosim: array of TStruc;
class var IsFarsiConversionNeeded : Boolean;
class function IsFarsiChar(Ch: Char): Boolean;
class function FarsiReverse(S: String): String;
class function IsFromTheSet1(Ch: Char): Boolean;
class function IsFromTheSet2(Ch: Char): Boolean;
class function CharIsLTR(Ch: Char): Boolean;
class function CharIsRTL(Ch: Char): Boolean;
class function ReorderWords(S: String): String;
class function ConvertWord(S: String): String;
public
class function Convert(S: String): String;
class function ConvertBackToRealFarsi(S: String): String;
class constructor Create;
end;
implementation
uses
System.StrUtils, System.SysUtils, System.Character;
{ TStruc }
constructor TStruc.Create(ACharacter, AEndGlyph, AIniGlyph, AMidGlyph, AIsoGlyph: Char);
begin
Character:= ACharacter;
EndGlyph:= AEndGlyph;
IniGlyph:= AIniGlyph;
MidGlyph:= AMidGlyph;
IsoGlyph:= AIsoGlyph;
end;
{ TFarsi }
class function TFarsi.FarsiReverse(S: String): String;
var
LRev: String;
I: Integer;
begin
Result:= EmptyStr;
LRev:= EmptyStr;
S:= ReverseString(S);
I:= 0;
while (I < S.Length) do
begin
if S.Chars[I].IsDigit then
begin
LRev:= EmptyStr;
while (I < S.Length) and (S.Chars[I].IsDigit or (S.Chars[I] = '/') or (S.Chars[I] = '.')) do
begin
LRev:= LRev + S.Chars[I];
Inc(I);
end;
LRev:= ReverseString(LRev);
Result:= Result + LRev;
end
else
begin
Result:= Result + S.Chars[I];
Inc(I);
end;
end;
end;
class function TFarsi.CharIsLTR(Ch: Char): Boolean;
begin
Result:= ((Ch >= Char(65)) and (Ch <= Char(122))) or Ch.IsDigit;
end;
class function TFarsi.CharIsRTL(Ch: Char): Boolean;
begin
Result:= (Ch >= Char($0621))
or
(Ch = Char($060C)) // ،
or
(Ch = Char($061B)) // ؛
or
(Ch = Char($061F)) // ؟
or
((Ch >= Char($0021)) and (Ch <= Char($002F)))
or
((Ch >= Char($003A)) and (Ch <= Char($003F)))
or
(Ch = Char($005B))
or
(Ch = Char($005D))
or
(Ch = Char($007B))
or
(Ch = Char($007D));
end;
class function TFarsi.ReorderWords(S: String): String;
const
ST_RTL = 0;
ST_LTR = 1;
var
LPrevWord: String;
LState, LPreState, I: Integer;
begin
Result:= EmptyStr;
LPrevWord:= EmptyStr;
LState:= ST_RTL;
LPreState:= ST_RTL;
I:= 0;
while (I < S.Length) do
begin
if CharIsLTR(S.Chars[I]) and (LState <> ST_LTR) then
begin
// State changed to LTR
LPreState:= ST_RTL;
LState:= ST_LTR;
Result:= Result + LPrevWord;
LPrevWord:= S.Chars[I];
end
else
if CharIsRTL(S.Chars[I]) and (LState <> ST_RTL) then
begin
// State changed to RTL
LPreState:= ST_LTR;
LState:= ST_RTL;
Result:= LPrevWord + Result;
LPrevWord:= S.Chars[I];
end
else
// State is not changed
begin
case LState of
ST_RTL: LPrevWord:= S.Chars[I] + LPrevWord;
ST_LTR: LPrevWord:= LPrevWord + S.Chars[I];
end;
//LPrevWord:= LPrevWord + S.Chars[I];
end;
Inc(I);
end;
// Result:= LPrevWord + Result;
case LPreState of
ST_RTL: Result:= LPrevWord + Result;
ST_LTR: Result:= Result + LPrevWord;
end;
end;
class function TFarsi.ConvertWord(S: String): String;
var
LLinkBefore, LLinkAfter: Boolean;
LIdx, I: Integer;
LChr: Char;
begin
Result:= DupeString(' ', S.Length);
LLinkBefore:= False;
LLinkAfter:= False;
I:= 0;
LIdx:= 0;
if (not TFarsi.IsFarsiConversionNeeded) or (S.IsEmpty) then
Exit(S);
while (I < S.Length) do
begin
if IsFarsiChar(S.Chars[I]) then
begin
LIdx:= 0;
LChr:= #0;
while (LIdx < N_DISTINCT_CHARACTERS) do
begin
if ArrStruc[LIdx].Character = S.Chars[I] then
Break;
Inc(LIdx);
end;
if (I = S.Length - 1) then
LLinkAfter:= False
else
LLinkAfter:= IsFromTheSet1(S.Chars[I + 1]) or IsFromTheSet2(S.Chars[I + 1]);
if I = 0 then
LLinkBefore:= False
else
LLinkBefore:= IsFromTheSet1(S.Chars[I - 1]);
if (LIdx < N_DISTINCT_CHARACTERS) then
begin
if LLinkBefore and LLinkAfter then
LChr:= ArrStruc[LIdx].MidGlyph
else
if LLinkBefore and not LLinkAfter then
LChr:= ArrStruc[LIdx].EndGlyph
else
if not LLinkBefore and LLinkAfter then
LChr:= ArrStruc[LIdx].IniGlyph
else
if not LLinkBefore and not LLinkAfter then
LChr:= ArrStruc[LIdx].IsoGlyph;
end
else
LChr:= S.Chars[I];
Result[I]:= LChr;
end
else
Result[I]:= S.Chars[I];
Inc(I);
end;
Result:= Result.Replace(Char($200c), ' '); // Change NO SPACE to SPACE
Result:= Result.Replace(szLamAndAlef, szLa); // Join 'Lam' and 'Alef' and make 'La'
Result:= Result.Replace(szLamStickAndAlef, szLaStick); // Join 'Lam Stick' and 'Alef' and make 'La Stick'
Result:= ReorderWords(Result);
end;
class function TFarsi.Convert(S: String): String;
var
LArrWords: TArray<String>;
I: Integer;
begin
// Result:= ConvertWord(S);
Result:= EmptyStr;
LArrWords:= S.Split([' ']);
for I := Low(LArrWords) to High(LArrWords) do
begin
LArrWords[I]:= ConvertWord(LArrWords[I]);
Result:= LArrWords[I] + ' ' + Result;
end;
end;
class function TFarsi.ConvertBackToRealFarsi(S: String): String;
var
LSB: TStringBuilder;
I, J: Integer;
LFound: Boolean;
begin
Result:= EmptyStr;
I:= 0;
J:= 0;
if not IsFarsiConversionNeeded then
Exit(S);
LSB:= TStringBuilder.Create(EmptyStr);
try
while (I < S.Length) do
begin
LFound:= False;
for J := Low(ArrStruc) to High(ArrStruc) do
begin
if (S.Chars[I] = ArrStruc[J].MidGlyph)
or
(S.Chars[I] = ArrStruc[J].IniGlyph)
or
(S.Chars[I] = ArrStruc[J].EndGlyph)
or
(S.Chars[I] = ArrStruc[J].IsoGlyph) then
begin
LSB.Append(ArrStruc[J].Character);
LFound:= True;
Break;
end;
end;
if not LFound then
LSB.Append(S.Chars[I]);
Inc(I);
end;
Result:= LSB.ToString;
Result:= Result.Replace(TFarsi.SzLa, 'لا');
Result:= Result.Replace(TFarsi.SzLaStick, 'لا');
//Result:= TFarsi.ReorderWords(Result);
finally
FreeAndNil(LSB);
end;
end;
class constructor TFarsi.Create;
begin
TFarsi.IsFarsiConversionNeeded:= True;
TFarsi.SzLamAndAlef := Char($FEDF) + Char($FE8E); // Lam + Alef
TFarsi.SzLamStickAndAlef := Char($FEE0) + Char($FE8E); // Lam (Sticky !!!)+
TFarsi.SzLa := Char($FEFB); // La
TFarsi.SzLaStick := Char($FEFC); // La (Sticky!!!)
TFarsi.SzLamAndAlefWoosim := Char($E1) + Char($BB); // Lam + Alef
TFarsi.SzLamStickAndAlefWoosim := Char($90) + Char($BB); // Lam (Sticky !!!)+ Alef
TFarsi.SzLaWoosim := Char($D9); // La
TFarsi.SzLaStickWoosim := Char($D9); // La
{Array}
TFarsi.ArrStruc:=
[
TStruc.Create(Char($630), Char($FEAC), Char($FEAB), Char($FEAC), Char($FEAB)),
TStruc.Create(Char($62F), Char($FEAA), Char($FEA9), Char($FEAA), Char($FEA9)),
TStruc.Create(Char($62C), Char($FE9E), Char($FE9F), Char($FEA0), Char($FE9D)),
TStruc.Create(Char($62D), Char($FEA2), Char($FEA3), Char($FEA4), Char($FEA1)),
TStruc.Create(Char($62E), Char($FEA6), Char($FEA7), Char($FEA8), Char($FEA5)),
TStruc.Create(Char($647), Char($FEEA), Char($FEEB), Char($FEEC), Char($FEE9)),
TStruc.Create(Char($639), Char($FECA), Char($FECB), Char($FECC), Char($FEC9)),
TStruc.Create(Char($63A), Char($FECE), Char($FECF), Char($FED0), Char($FECD)),
TStruc.Create(Char($641), Char($FED2), Char($FED3), Char($FED4), Char($FED1)),
TStruc.Create(Char($642), Char($FED6), Char($FED7), Char($FED8), Char($FED5)),
TStruc.Create(Char($62B), Char($FE9A), Char($FE9B), Char($FE9C), Char($FE99)),
TStruc.Create(Char($635), Char($FEBA), Char($FEBB), Char($FEBC), Char($FEB9)),
TStruc.Create(Char($636), Char($FEBE), Char($FEBF), Char($FEC0), Char($FEBD)),
TStruc.Create(Char($637), Char($FEC2), Char($FEC3), Char($FEC4), Char($FEC1)),
TStruc.Create(Char($643), Char($FEDA), Char($FEDB), Char($FEDC), Char($FED9)),
TStruc.Create(Char($645), Char($FEE2), Char($FEE3), Char($FEE4), Char($FEE1)),
TStruc.Create(Char($646), Char($FEE6), Char($FEE7), Char($FEE8), Char($FEE5)),
TStruc.Create(Char($62A), Char($FE96), Char($FE97), Char($FE98), Char($FE95)),
TStruc.Create(Char($627), Char($FE8E), Char($FE8D), Char($FE8E), Char($FE8D)),
TStruc.Create(Char($644), Char($FEDE), Char($FEDF), Char($FEE0), Char($FEDD)),
TStruc.Create(Char($628), Char($FE90), Char($FE91), Char($FE92), Char($FE8F)),
TStruc.Create(Char($64A), Char($FEF2), Char($FEF3), Char($FEF4), Char($FEF1)),
TStruc.Create(Char($633), Char($FEB2), Char($FEB3), Char($FEB4), Char($FEB1)),
TStruc.Create(Char($634), Char($FEB6), Char($FEB7), Char($FEB8), Char($FEB5)),
TStruc.Create(Char($638), Char($FEC6), Char($FEC7), Char($FEC8), Char($FEC5)),
TStruc.Create(Char($632), Char($FEB0), Char($FEAF), Char($FEB0), Char($FEAF)),
TStruc.Create(Char($648), Char($FEEE), Char($FEED), Char($FEEE), Char($FEED)),
TStruc.Create(Char($629), Char($FE94), Char($FE93), Char($FE93), Char($FE93)),
TStruc.Create(Char($649), Char($FEF0), Char($FEEF), Char($FEF0), Char($FEEF)),
TStruc.Create(Char($631), Char($FEAE), Char($FEAD), Char($FEAE), Char($FEAD)),
TStruc.Create(Char($624), Char($FE86), Char($FE85), Char($FE86), Char($FE85)),
TStruc.Create(Char($621), Char($FE80), Char($FE80), Char($FE80), Char($FE80)),
TStruc.Create(Char($626), Char($FE8A), Char($FE8B), Char($FE8C), Char($FE89)),
TStruc.Create(Char($623), Char($FE84), Char($FE83), Char($FE84), Char($FE83)),
TStruc.Create(Char($622), Char($FE82), Char($FE81), Char($FE82), Char($FE81)),
TStruc.Create(Char($625), Char($FE88), Char($FE87), Char($FE88), Char($FE87)),
TStruc.Create(Char($67E), Char($FB57), Char($FB58), Char($FB59), Char($FB56)),
TStruc.Create(Char($686), Char($FB7B), Char($FB7C), Char($FB7D), Char($FB7A)),
TStruc.Create(Char($698), Char($FB8B), Char($FB8A), Char($FB8B), Char($FB8A)),
TStruc.Create(Char($6A9), Char($FB8F), Char($FB90), Char($FB91), Char($FB8E)),
TStruc.Create(Char($6AF), Char($FB93), Char($FB94), Char($FB95), Char($FB92)),
TStruc.Create(Char($6CC), Char($FBFD), Char($FEF3), Char($FEF4), Char($FBFC)),
TStruc.Create(Char($6C0), Char($FBA5), Char($FBA4), Char($FBA5), Char($FBA4))
];
TFarsi.ArrStrucWoosim:=
[
TStruc.Create(Char($630), Char($B5), Char($82), Char($B5), Char($82)),
TStruc.Create(Char($62F), Char($B4), Char($81), Char($B4), Char($81)),
TStruc.Create(Char($62C), Char($9B), Char($B1), Char($F9), Char($BF)),
TStruc.Create(Char($62D), Char($9C), Char($B2), Char($FA), Char($C0)),
TStruc.Create(Char($62E), Char($9D), Char($B3), Char($FE), Char($C1)),
TStruc.Create(Char($647), Char($AC), Char($E4), Char($93), Char($D5)),
TStruc.Create(Char($639), Char($C9), Char($D3), Char($8B), Char($A4)),
TStruc.Create(Char($63A), Char($CA), Char($DD), Char($8C), Char($A5)),
TStruc.Create(Char($641), Char($A6), Char($DE), Char($8D), Char($CC)),
TStruc.Create(Char($642), Char($A7), Char($DF), Char($8E), Char($CE)),
TStruc.Create(Char($62B), Char($BD), Char($AF), Char($EA), Char($99)),
TStruc.Create(Char($635), Char($C4), Char($C8), Char($87), Char($A0)),
TStruc.Create(Char($636), Char($C5), Char($CB), Char($88), Char($A1)),
TStruc.Create(Char($637), Char($C6), Char($CD), Char($CD), Char($A2)),
TStruc.Create(Char($643), Char($CF), Char($E0), Char($8F), Char($A8)),
TStruc.Create(Char($645), Char($D2), Char($E2), Char($91), Char($AA)),
TStruc.Create(Char($646), Char($D4), Char($E3), Char($92), Char($AB)),
TStruc.Create(Char($62A), Char($BD), Char($AF), Char($EA), Char($99)),
TStruc.Create(Char($627), Char($BB), Char($80), Char($BB), Char($80)),
TStruc.Create(Char($644), Char($D1), Char($E1), Char($90), Char($A9)),
TStruc.Create(Char($628), Char($BC), Char($AE), Char($E9), Char($98)),
TStruc.Create(Char($64A), Char($DC), Char($E6), Char($95), Char($DC)),
TStruc.Create(Char($633), Char($C2), Char($B8), Char($B8), Char($9E)),
TStruc.Create(Char($634), Char($C3), Char($B9), Char($B9), Char($9F)),
TStruc.Create(Char($638), Char($C7), Char($CD), Char($CD), Char($C7)),
TStruc.Create(Char($632), Char($B7), Char($B7), Char($B7), Char($B7)),
TStruc.Create(Char($648), Char($94), Char($94), Char($94), Char($94)),
TStruc.Create(Char($629), Char($DA), Char($DA), Char($DA), Char($DA)),
TStruc.Create(Char($649), Char($DC), Char($E6), Char($95), Char($DC)),
TStruc.Create(Char($631), Char($B6), Char($B6), Char($B6), Char($B6)),
TStruc.Create(Char($624), Char($E7), Char($E7), Char($E7), Char($E7)),
TStruc.Create(Char($621), Char($BA), Char($BA), Char($BA), Char($BA)),
TStruc.Create(Char($626), Char($D7), Char($E8), Char($97), Char($D7)),
TStruc.Create(Char($623), Char($80), Char($80), Char($80), Char($80)),
TStruc.Create(Char($622), Char($80), Char($80), Char($80), Char($80)),
TStruc.Create(Char($625), Char($80), Char($80), Char($80), Char($80)),
TStruc.Create(Char($67E), Char($BC), Char($AE), Char($E9), Char($98)),
TStruc.Create(Char($686), Char($9B), Char($B1), Char($F9), Char($BF)),
TStruc.Create(Char($698), Char($B7), Char($B7), Char($B7), Char($B7)),
TStruc.Create(Char($6A9), Char($CF), Char($E0), Char($8F), Char($A8)),
TStruc.Create(Char($6AF), Char($CF), Char($E0), Char($8F), Char($A8)),
TStruc.Create(Char($6CC), Char($DC), Char($E6), Char($95), Char($DC)),
TStruc.Create(Char($6C0), Char($AC), Char($E4), Char($93), Char($D5))
];
end;
class function TFarsi.IsFarsiChar(Ch: Char): Boolean;
begin
Result:= ((Ch >= Char($0621)) and (Ch <= Char($064a)))
or
(Ch = Char($067e))
or
(Ch = Char($0686))
or
(Ch = Char($0698))
or
(Ch = Char($06a9))
or
(Ch = Char($06af))
or
(Ch = Char($06cc))
or
(Ch = Char($06c0));
end;
class function TFarsi.IsFromTheSet1(Ch: Char): Boolean;
var
LTheSet1: array of Char;
I: Integer;
begin
Result:= False;
I:= 0;
LTheSet1:= [
Char($62C), Char($62D), Char($62E), Char($647), Char($639), Char($63A),
Char($641), Char($642), Char($62B), Char($635), Char($636), Char($637),
Char($643), Char($645), Char($646), Char($62A), Char($644), Char($628),
Char($64A), Char($633), Char($634), Char($638), Char($67E), Char($686),
Char($6A9), Char($6AF), Char($6CC), Char($626)
];
while (I < 28) do
begin
if Ch = LTheSet1[I] then
Exit(True);
Inc(I);
end;
end;
class function TFarsi.IsFromTheSet2(Ch: Char): Boolean;
var
LTheSet2: array of Char;
I: Integer;
begin
Result:= False;
I:= 0;
LTheSet2:= [
Char($627), Char($623), Char($625), Char($622), Char($62F), Char($630),
Char($631), Char($632), Char($648), Char($624), Char($629), Char($649),
Char($698), Char($6C0)
];
while (I < 14) do
begin
if Ch = LTheSet2[I] then
Exit(True);
Inc(I);
end;
end;
end.
