Sub DevUni2RomUni()

'

' Insert this whole text into your NORMAL.DOT (select the whole text; copy
it [ctrl-C];

' from the Tools menu select Macros, then Edit; paste the text to the end
[ctrl-V]).

' You may also want to create a keyboard shortcut.



' It converts the Unicode-encoded Devanagari part of the text selected into
romanized Unicode.

' The default Roman font will be Times Ext Roman; it can be changed in the
line before the last.



' Vedic accents are not understood; they produce unpredictable results.



' 01 feb 2006 by Ferenc Ruzsa

'



Dim a As String, b As String, c As String, r As String, s As String

Dim i As Long, j As Long, k As Long

Dim gt As String, ht As String

Dim cons As String, consd As String, vow As String, vowd As String, vowdin
As String

Dim virama As String, v_x As String, vin_xd As String



gt = "kgcj" & ChrW(7789) & ChrW(7693) & "tdpb"  ' may have aspiration

ht = "KGCJ" & ChrW(7788) & ChrW(7692) & "TDPB"  ' aspirates

cons = "smtnvyrdk" & ChrW(7779) & ChrW(7751) & "gbpTDlśhKGBcCjP" &
ChrW(7749) & ChrW(241) & _

   ChrW(7789) & ChrW(7788) & ChrW(7693) & ChrW(7692) & "J" & ChrW(7739)
' consonants

consd = ChrW(2360) & ChrW(2350) & ChrW(2340) & ChrW(2344) & ChrW(2357) &
ChrW(2351) & _

   ChrW(2352) & ChrW(2342) & ChrW(2325) & ChrW(2359) & ChrW(2339) &
ChrW(2327) & ChrW(2348) & _

   ChrW(2346) & ChrW(2341) & ChrW(2343) & ChrW(2354) & ChrW(2358) &
ChrW(2361) & ChrW(2326) & _

   ChrW(2328) & ChrW(2349) & ChrW(2330) & ChrW(2331) & ChrW(2332) &
ChrW(2347) & ChrW(2329) & _

   ChrW(2334) & ChrW(2335) & ChrW(2336) & ChrW(2337) & ChrW(2338) &
ChrW(2333) & ChrW(2355)

vow = "a" & ChrW(257) & "i" & ChrW(299) & "u" & ChrW(363) & "eoE" &
ChrW(7771) & "O" & _

   ChrW(7773) & ChrW(7735) & ChrW(7737)        ' vowels

virama = ChrW(2381)

vowd = virama & ChrW(2366) & ChrW(2367) & ChrW(2368) & ChrW(2369) &
ChrW(2370) & ChrW(2375) & _

   ChrW(2379) & ChrW(2376) & ChrW(2371) & ChrW(2380) & ChrW(2372) &
ChrW(2402) & ChrW(2403)

vowdin = ChrW(2309) & ChrW(2310) & ChrW(2311) & ChrW(2312) & ChrW(2313) &
ChrW(2314) & _

   ChrW(2319) & ChrW(2323) & ChrW(2320) & ChrW(2315) & ChrW(2324) &
ChrW(2400) & ChrW(2316) & _

   ChrW(2401)

'xtra = "MH|'X0123456789x-"                      ' other - anusvara,
visarga, danda, avagraha,

                                               ' double danda, numbers,
anunaasika, hyphen

'xtrad = ChrW(2306) & ChrW(2307) & ChrW(2404) & ChrW(2365) & ChrW(2405) &
ChrW(2406) & _

   ChrW(2407) & ChrW(2408) & ChrW(2409) & ChrW(2410) & ChrW(2411) &
ChrW(2412) & ChrW(2413) & _

   ChrW(2414) & ChrW(2415) & ChrW(2305) & ChrW(2416)



'v_x = "aAiIuUeoEáOÁúÚMH|'X0123456789x-"         ' vowels + other

v_x = "a" & ChrW(257) & "i" & ChrW(299) & "u" & ChrW(363) & "eoE" &
ChrW(7771) & "O" & _

   ChrW(7773) & ChrW(7735) & ChrW(7737) & ChrW(7747) & ChrW(7717) &
"|'X0123456789" & _

   ChrW(7745) & "-"                            ' vowels + other

vin_xd = ChrW(2309) & ChrW(2310) & ChrW(2311) & ChrW(2312) & ChrW(2313) &
ChrW(2314) & _

   ChrW(2319) & ChrW(2323) & ChrW(2320) & ChrW(2315) & ChrW(2324) &
ChrW(2400) & ChrW(2316) & _

   ChrW(2401) & ChrW(2306) & ChrW(2307) & ChrW(2404) & ChrW(2365) &
ChrW(2405) & ChrW(2406) & _

   ChrW(2407) & ChrW(2408) & ChrW(2409) & ChrW(2410) & ChrW(2411) &
ChrW(2412) & ChrW(2413) & _

   ChrW(2414) & ChrW(2415) & ChrW(2305) & ChrW(2416)



r = Selection.Text

s = ""

c = ""

j = Len(r)

For i = 1 To j

   a = Mid(r, i, 1)

   k = InStr(1, vin_xd, a, 0)          ' initial vowel or unproblematic
sign

   If k > 0 Then

       b = Mid(v_x, k, 1)

       If Right(c, 1) = "a" Then

           If b = "i" Then

               b = ChrW(239)          'i-umlaut

           ElseIf b = "u" Then

               b = "ü"

           End If

       End If

       If b = "E" Then

           b = "ai"

       ElseIf b = "O" Then

           b = "au"

       ElseIf b = "X" Then

           b = "||"

       End If

       GoTo AddTo_s

   End If

   k = InStr(1, consd, a, 0)

   If k > 0 Then

       b = Mid(cons, k, 1)

       k = InStr(1, ht, b, 0)

       If k > 0 Then

           b = Mid(gt, k, 1) + "h"

       End If

       b = b + "a"

       GoTo AddTo_s

   End If

   k = InStr(1, vowd, a, 0)

   If k > 0 Then

       If k = 1 Then                  'virama

           b = ""

       Else

           b = Mid(vow, k, 1)

           If b = "E" Then

               b = "ai"

           ElseIf b = "O" Then

               b = "au"

           End If

       End If

       c = Left(c, Len(c) - 1)

       GoTo AddTo_s

   End If

   b = a

AddTo_s:

   s = s + c

   c = b

Next i

s = s + c



Selection.Text = s

Selection.Font.Name = "Times Ext Roman"

End Sub