Type=Class
Version=5.8
ModulesStructureVersion=1
B4A=true
@EndOfDesignText@

private Sub Class_Globals
	'Controls PersianReshaper if Conversion is needed.
	'Note: Set this method to <b>true</b> for Android 2.x devices or sooner, and set it to <b>false</b> for other.
	Public isFarsiConversionNeeded As Boolean = True
	
	Private Const szLamAndAlef As String = Chr(0xfedf) & Chr(0xfe8e) ' Lam + Alef
	Private Const szLamStickAndAlef As String = Chr(0xfee0) & Chr(0xfe8e) ' Lam (Sticky !!!)+ Alef
	Private Const szLa As String = Chr(0xfefb) ' La
	Private Const szLaStick As String = Chr(0xfefc) ' La (Sticky!!!)
	Private Const szLamAndAlefWoosim As String = Chr(0xe1) & Chr(0xbb) ' Lam + Alef
	Private Const szLamStickAndAlefWoosim As String = Chr(0x90) & Chr(0xbb) ' Lam (Sticky !!!)+ Alef
	Private Const szLaWoosim As String = Chr(0xd9) ' La
	Private Const szLaStickWoosim As String = Chr(0xd9) ' La (Sticky!!!)
	
	Type struc( character As Char,  endGlyph As Char,  iniGlyph As Char,  midGlyph As Char,  isoGlyph As Char)
	
	Private arrStruc() As struc = Array As struc (Newstruc(Chr(0x630), Chr(0xfeac), Chr(0xfeab), Chr(0xfeac), Chr(0xfeab)), _
											  Newstruc(Chr(0x62f), Chr(0xfeaa), Chr(0xfea9), Chr(0xfeaa), Chr(0xfea9)), _
											  Newstruc(Chr(0x62c), Chr(0xfe9e), Chr(0xfe9f), Chr(0xfea0), Chr(0xfe9d)), _
											  Newstruc(Chr(0x62d), Chr(0xfea2), Chr(0xfea3), Chr(0xfea4), Chr(0xfea1)), _
											  Newstruc(Chr(0x62e), Chr(0xfea6), Chr(0xfea7), Chr(0xfea8), Chr(0xfea5)), _
											  Newstruc(Chr(0x647), Chr(0xfeea), Chr(0xfeeb), Chr(0xfeec), Chr(0xfee9)), _
											  Newstruc(Chr(0x639), Chr(0xfeca), Chr(0xfecb), Chr(0xfecc), Chr(0xfec9)), _
											  Newstruc(Chr(0x63a), Chr(0xfece), Chr(0xfecf), Chr(0xfed0), Chr(0xfecd)), _
											  Newstruc(Chr(0x641), Chr(0xfed2), Chr(0xfed3), Chr(0xfed4), Chr(0xfed1)), _
											  Newstruc(Chr(0x642), Chr(0xfed6), Chr(0xfed7), Chr(0xfed8), Chr(0xfed5)), _
											  Newstruc(Chr(0x62b), Chr(0xfe9a), Chr(0xfe9b), Chr(0xfe9c), Chr(0xfe99)), _
											  Newstruc(Chr(0x635), Chr(0xfeba), Chr(0xfebb), Chr(0xfebc), Chr(0xfeb9)), _
											  Newstruc(Chr(0x636), Chr(0xfebe), Chr(0xfebf), Chr(0xfec0), Chr(0xfebd)), _
											  Newstruc(Chr(0x637), Chr(0xfec2), Chr(0xfec3), Chr(0xfec4), Chr(0xfec1)), _
											  Newstruc(Chr(0x643), Chr(0xfeda), Chr(0xfedb), Chr(0xfedc), Chr(0xfed9)), _
											  Newstruc(Chr(0x645), Chr(0xfee2), Chr(0xfee3), Chr(0xfee4), Chr(0xfee1)), _
											  Newstruc(Chr(0x646), Chr(0xfee6), Chr(0xfee7), Chr(0xfee8), Chr(0xfee5)), _
											  Newstruc(Chr(0x62a), Chr(0xfe96), Chr(0xfe97), Chr(0xfe98), Chr(0xfe95)), _
											  Newstruc(Chr(0x627), Chr(0xfe8e), Chr(0xfe8d), Chr(0xfe8e), Chr(0xfe8d)), _
											  Newstruc(Chr(0x644), Chr(0xfede), Chr(0xfedf), Chr(0xfee0), Chr(0xfedd)), _
											  Newstruc(Chr(0x628), Chr(0xfe90), Chr(0xfe91), Chr(0xfe92), Chr(0xfe8f)), _
											  Newstruc(Chr(0x64a), Chr(0xfef2), Chr(0xfef3), Chr(0xfef4), Chr(0xfef1)), _
											  Newstruc(Chr(0x633), Chr(0xfeb2), Chr(0xfeb3), Chr(0xfeb4), Chr(0xfeb1)), _
											  Newstruc(Chr(0x634), Chr(0xfeb6), Chr(0xfeb7), Chr(0xfeb8), Chr(0xfeb5)), _
											  Newstruc(Chr(0x638), Chr(0xfec6), Chr(0xfec7), Chr(0xfec8), Chr(0xfec5)), _
											  Newstruc(Chr(0x632), Chr(0xfeb0), Chr(0xfeaf), Chr(0xfeb0), Chr(0xfeaf)), _
											  Newstruc(Chr(0x648), Chr(0xfeee), Chr(0xfeed), Chr(0xfeee), Chr(0xfeed)), _
											  Newstruc(Chr(0x629), Chr(0xfe94), Chr(0xfe93), Chr(0xfe93), Chr(0xfe93)), _
											  Newstruc(Chr(0x649), Chr(0xfef0), Chr(0xfeef), Chr(0xfef0), Chr(0xfeef)), _
											  Newstruc(Chr(0x631), Chr(0xfeae), Chr(0xfead), Chr(0xfeae), Chr(0xfead)), _
											  Newstruc(Chr(0x624), Chr(0xfe86), Chr(0xfe85), Chr(0xfe86), Chr(0xfe85)), _
											  Newstruc(Chr(0x621), Chr(0xfe80), Chr(0xfe80), Chr(0xfe80), Chr(0xfe80)), _
											  Newstruc(Chr(0x626), Chr(0xfe8a), Chr(0xfe8b), Chr(0xfe8c), Chr(0xfe89)), _
											  Newstruc(Chr(0x623), Chr(0xfe84), Chr(0xfe83), Chr(0xfe84), Chr(0xfe83)), _
											  Newstruc(Chr(0x622), Chr(0xfe82), Chr(0xfe81), Chr(0xfe82), Chr(0xfe81)), _
											  Newstruc(Chr(0x625), Chr(0xfe88), Chr(0xfe87), Chr(0xfe88), Chr(0xfe87)), _
											  Newstruc(Chr(0x67e), Chr(0xfb57), Chr(0xfb58), Chr(0xfb59), Chr(0xfb56)), _
											  Newstruc(Chr(0x686), Chr(0xfb7b), Chr(0xfb7c), Chr(0xfb7d), Chr(0xfb7a)), _
											  Newstruc(Chr(0x698), Chr(0xfb8b), Chr(0xfb8a), Chr(0xfb8b), Chr(0xfb8a)), _
											  Newstruc(Chr(0x6a9), Chr(0xfb8f), Chr(0xfb90), Chr(0xfb91), Chr(0xfb8e)), _
											  Newstruc(Chr(0x6af), Chr(0xfb93), Chr(0xfb94), Chr(0xfb95), Chr(0xfb92)), _
											  Newstruc(Chr(0x6cc), Chr(0xfbfd), Chr(0xfef3), Chr(0xfef4), Chr(0xfbfc)), _
											  Newstruc(Chr(0x6c0), Chr(0xfba5), Chr(0xfba4), Chr(0xfba5), Chr(0xfba4)) )
			' new struc((char) 0x6cc, (char) 0xfbfd, (char) 0xfbfe,
			' (char) 0xfbff, (char) 0xfbfc), // Farsi yeh
	
	Private Const N_DISTINCT_CHARACTERS As Int = 43
	
End Sub

'Initializes the FarsiReshaper object.
Public Sub Initialize
	Class_Globals
End Sub

private Sub Newstruc( Char2 As Char,  EndGlyph As Char,  IniGlyph As Char,  MidGlyph As Char,  IsoGlyph As Char) As struc
			Dim tmp As struc
			tmp.Initialize
			tmp.character = Char2
			tmp.EndGlyph = EndGlyph
			tmp.IniGlyph = IniGlyph
			tmp.MidGlyph = MidGlyph
			tmp.IsoGlyph = IsoGlyph
			Return tmp
End Sub 

Private Sub isFromTheSet1(ch As Char) As Boolean
		Dim theSet1() As Char = Array As Char(Chr(0x62c), Chr(0x62d), Chr(0x62e), Chr(0x647), Chr(0x639), Chr(0x63a), Chr(0x641), Chr(0x642), Chr(0x62b), Chr(0x635), Chr(0x636), Chr(0x637), Chr(0x643), Chr(0x645), Chr(0x646), Chr(0x62a), Chr(0x644), Chr(0x628), Chr(0x64a), Chr(0x633), Chr(0x634), Chr(0x638), Chr(0x67e), Chr(0x686), Chr(0x6a9), Chr(0x6af), Chr(0x6cc), Chr(0x626) )
		Dim i As Int = 0
		Do While i < 28
			If ch = theSet1(i) Then
				Return True
			End If
			i = i+1
		Loop
		Return False
End Sub

Private Sub isFromTheSet2(ch As Char) As Boolean
		Dim theSet2() As Char = Array As Char(Chr(0x627), Chr(0x623), Chr(0x625), Chr(0x622), Chr(0x62f), Chr(0x630), Chr(0x631), Chr(0x632), Chr(0x648), Chr(0x624), Chr(0x629), Chr(0x649), Chr(0x698), Chr(0x6c0) )
		Dim i As Int = 0
		Do While i < 14
			If ch = theSet2(i) Then
				Return True
			End If
			i = i+1
		Loop
		Return False
End Sub

 
'<summary>Converts back a reshaped string to real Persian.</summary>
'
'<param name="In"><b><code>In:</code></b> A reshaped string</param>
'
'Example:<code>
'	Dim farsi As FarsiReshaper
'	farsi.Initialize
'	farsi.ConvertBackToRealFarsi("سلام دنیا")</code>     
Public Sub ConvertBackToRealFarsi(In As String) As String

		If (Not (isFarsiConversionNeeded)) Then
			Return In
		End If

		Dim strOut As String = ""
		Dim strBuilder As StringBuilder
		strBuilder.Initialize
		Dim i As Int = 0
		Dim j As Int = 0
		Dim chIn(In.Length) As Char
		For chi=0 To chIn.Length-1
			chIn(chi)=In.CharAt(chi)
		Next
		'chIn = In.ToCharArray()

		For i = 0 To In.Length - 1
			Dim found As Boolean = False
			For j = 0 To arrStruc.length - 1
				If chIn(i) = arrStruc(j).midGlyph Or chIn(i) = arrStruc(j).iniGlyph Or chIn(i) = arrStruc(j).endGlyph Or chIn(i) = arrStruc(j).isoGlyph Then
					strBuilder.Append(arrStruc(j).character)
					found = True
					Exit
				End If
			Next 
			If (Not (found)) Then
				strBuilder.Append(chIn(i))
			End If
		Next 

		strOut = strBuilder.ToString()
	strOut = strOut.Replace(szLa, "لا")
	strOut = strOut.Replace(szLaStick, "لا")

		Return strOut
End Sub
	
'
'<summary>Convrts an input string to reshaped string.</summary>
'
'<param name="In"><b><code>In:</code></b> A real Persian string</param>
'
'Exaple:<code>
'	Dim farsi As FarsiReshaper
'	farsi.Initialize
'	farsi.Convert("سلام دنیا")</code>
Public Sub Convert(In As String) As String

		If (Not (isFarsiConversionNeeded)) Then
			Return In
		End If

		If In = "" Then
			Return ""
		End If

		Dim linkBefore, linkAfter As Boolean
		Dim Out As String = In
		Dim chOut(Out.Length) As Char
		For chi=0 To chOut.Length-1
			chOut(chi)=Out.CharAt(chi)
		Next
		'chOut = Out.ToCharArray()
		
		Dim chIn(In.Length) As Char
		For chi=0 To chIn.Length-1
			chIn(chi)=In.CharAt(chi)
		Next
		'chIn = In.ToCharArray()

		For i = 0 To In.Length - 1
			' WCHAR 
			Dim ch As Char = chIn(i)
			If (Asc(ch) >= Asc(Chr(0x0621)) And Asc(ch) <= Asc(Chr(0x064a))) Or (ch = Chr(0x067e)) Or (ch = Chr(0x0686)) Or (ch = Chr(0x0698)) Or (ch = Chr(0x06a9)) Or (ch = Chr(0x06af)) Or (ch = Chr(0x06cc)) Or (ch = Chr(0x06c0)) Then ' is a Farsi character?
				Dim idx As Int = 0
				Do While idx < N_DISTINCT_CHARACTERS
					If arrStruc(idx).character = chIn(i) Then
						Exit 
					End If
					idx = idx+1
				Loop

				If i = In.Length - 1 Then
					linkAfter = False
				Else
					linkAfter = (isFromTheSet1(chIn(i + 1)) Or isFromTheSet2(chIn(i + 1)))
				End If
				If i = 0 Then
					linkBefore = False
				Else
					linkBefore = isFromTheSet1(chIn(i - 1))
				End If
				If idx < N_DISTINCT_CHARACTERS Then
					If linkBefore And linkAfter Then
						chOut(i) = arrStruc(idx).midGlyph
					End If
					If linkBefore And (Not (linkAfter)) Then
						chOut(i) = arrStruc(idx).endGlyph
					End If
					If (Not (linkBefore)) And linkAfter Then
						chOut(i) = arrStruc(idx).iniGlyph
					End If
					If (Not (linkBefore)) And (Not (linkAfter)) Then
						chOut(i) = arrStruc(idx).isoGlyph
					End If
				Else
					chOut(i) = chIn(i)
				End If
			Else
				chOut(i) = chIn(i)
			End If
		Next
		Out = ""
		For j = 0 To chOut.Length - 1
			Out = Out & chOut(j)
		Next 
		' Out = ArabicReverse(Out);

		Out = Out.Replace(Chr(0x200c), " ") ' Change NO SPACE to SPACE

		Out = Out.Replace(szLamAndAlef, szLa) ' Join 'Lam' and 'Alef' and
												' make 'La'
		Out = Out.Replace(szLamStickAndAlef, szLaStick) ' Join 'Lam Stick' and 'Alef' and make 'La Stick'

		Return reorderWords(Out)

End Sub
	
Private  Sub reorderWords(strIn As String) As String

		Private Const ST_RTL As Int = 0
		Private Const ST_LTR As Int = 1

		Dim strOut As String = ""
		Dim prevWord As String = ""
		Dim state As Int = ST_RTL
		Dim arr(strIn.Length) As Char 
		For chi=0 To arr.Length-1
			arr(chi)=strIn.CharAt(chi)
		Next
		'= strIn.ToCharArray()
		Dim i As Int = 0
		Do While i < arr.Length
			If charIsLTR(arr(i)) And state <> ST_LTR Then
				' state changed to LTR
				state = ST_LTR
				strOut = prevWord & strOut
				prevWord = ""
				prevWord = prevWord & arr(i)
			Else If charIsRTL(arr(i)) And state <> ST_RTL Then
				' state changed to RTL
				state = ST_RTL
				strOut = prevWord & strOut
				prevWord = ""
				prevWord = prevWord & arr(i)
			Else
				' state is not changed
				prevWord = prevWord & arr(i)
			End If
			i = i+1
		Loop

		strOut = prevWord & strOut

		Return strOut

End Sub

Private Sub charIsLTR(ch As Char) As Boolean
		Return (Asc(ch) >= Asc(Chr(65)) And Asc(ch) <= Asc(Chr(122))) Or IsNumber(ch)
End Sub

Private Sub charIsRTL(ch As Char) As Boolean
		Return Asc(ch) >= Asc(Chr(0x0621))
End Sub