macro to convert krutidev to Unicode

kruti_to_unicode.txt

original string:

izFke Js.kh]
¼U;k- dz- 6½] vdksyk-

expected string:

प्रथम श्रेणी,
(न्या. क्र. ६), अकोला.
_____

Sub ConvertSelection_KrutiToUnicode
    Dim oDoc As Object, oSel As Object, oCursor As Object
    Dim inputText As String, outputText As String

    oDoc = ThisComponent
    oSel = oDoc.CurrentSelection
    If oSel.getCount() = 0 Then
        MsgBox "Please select some text first."
        Exit Sub
    End If

    oCursor = oSel.getByIndex(0)
    inputText = oCursor.getString()
    outputText = KrutiToUnicodeText(inputText)
    oCursor.setString(outputText)
End Sub


Function KrutiToUnicodeText(inputText As String) As String
    Dim kruti() As String, uni() As String
    Dim kruti_punc() As String, uni_punc() As String
    Dim i As Integer, token As String, outputText As String
    Dim tokens() As String

    ' --- Initialize arrays ---
    kruti = Split("iz,Fk,e,Js,.kh,U;k,dz,v,dks,yk", ",")
    uni   = Split("प्र,थ,म,श्रे,णी,न्या,क्र,अ,को,ला", ",")

    ' Explicitly ReDim punctuation arrays to avoid "object variable" error
    ReDim kruti_punc(3)
    ReDim uni_punc(3)
    kruti_punc(0) = "]"
    kruti_punc(1) = "¼"
    kruti_punc(2) = "½"
    kruti_punc(3) = "-"
    uni_punc(0) = ","
    uni_punc(1) = "("
    uni_punc(2) = ")"
    uni_punc(3) = "."

    tokens = SplitWithSpaces(inputText)

    For Each token In tokens
        If IsSpaceOnly(token) Then
            outputText = outputText & token
        Else
            outputText = outputText & KrutiToUnicodeWord(token, kruti, uni, kruti_punc, uni_punc)
        End If
    Next token

    KrutiToUnicodeText = outputText
End Function


Function KrutiToUnicodeWord(word As String, kruti() As String, uni() As String, kruti_punc() As String, uni_punc() As String) As String
    Dim prefix As String, suffix As String
    Dim i As Integer, tempWord As String
    Dim changed As Boolean

    tempWord = word

    ' --- Handle all leading punctuation ---
    Do
        changed = False
        For i = LBound(kruti_punc) To UBound(kruti_punc)
            If Left(tempWord, Len(kruti_punc(i))) = kruti_punc(i) Then
                prefix = prefix & uni_punc(i)
                tempWord = Mid(tempWord, Len(kruti_punc(i)) + 1)
                changed = True
                Exit For
            End If
        Next i
    Loop While changed

    ' --- Handle all trailing punctuation ---
    Do
        changed = False
        For i = LBound(kruti_punc) To UBound(kruti_punc)
            If Right(tempWord, Len(kruti_punc(i))) = kruti_punc(i) Then
                suffix = uni_punc(i) & suffix
                tempWord = Left(tempWord, Len(tempWord) - Len(kruti_punc(i)))
                changed = True
                Exit For
            End If
        Next i
    Loop While changed

    ' --- Replace Kruti patterns (longest first) ---
    Dim order() As Integer
    order = SortByLengthDesc(kruti)

    For i = LBound(order) To UBound(order)
        tempWord = Replace(tempWord, kruti(order(i)), uni(order(i)))
    Next i

    KrutiToUnicodeWord = prefix & tempWord & suffix
End Function


' --- Helper: sort index by string length descending ---
Function SortByLengthDesc(arr() As String) As Variant
    Dim i As Integer, j As Integer, n As Integer, temp As Integer
    n = UBound(arr)
    Dim idx() As Integer
    ReDim idx(n)
    For i = 0 To n
        idx(i) = i
    Next i
    For i = 0 To n - 1
        For j = i + 1 To n
            If Len(arr(idx(i))) < Len(arr(idx(j))) Then
                temp = idx(i)
                idx(i) = idx(j)
                idx(j) = temp
            End If
        Next j
    Next i
    SortByLengthDesc = idx
End Function


' --- Helper: Split text preserving spaces ---
Function SplitWithSpaces(text As String) As Variant
    Dim result() As String
    Dim i As Long, ch As String
    Dim mode As String, count As Long
    ReDim result(0)

    For i = 1 To Len(text)
        ch = Mid(text, i, 1)
        If ch = " " Or ch = Chr(9) Or ch = Chr(10) Then
            If mode <> "space" Then
                count = count + 1
                ReDim Preserve result(count)
                result(count) = ""
                mode = "space"
            End If
            result(count) = result(count) & ch
        Else
            If mode <> "word" Then
                count = count + 1
                ReDim Preserve result(count)
                result(count) = ""
                mode = "word"
            End If
            result(count) = result(count) & ch
        End If
    Next i

    SplitWithSpaces = result
End Function


' --- Helper: Check if token is only spaces ---
Function IsSpaceOnly(s As String) As Boolean
    Dim i As Long, ch As String
    For i = 1 To Len(s)
        ch = Mid(s, i, 1)
        If ch <> " " And ch <> Chr(9) And ch <> Chr(10) Then
            IsSpaceOnly = False
            Exit Function
        End If
    Next i
    IsSpaceOnly = True
End Function