Macro for transliterating from Greek to "english"

[Original_Memory6188]

I am trying to set up a macro to substitute the Latin alphabet equivalent to the Greek letters in a text. I am not sure but I think that is something on the order of at least 50 pairs of changes.
Below s the code generated when recording the find and replace for the first pair (Pi and Cap P). I edited the code some (cut out some lines), it is all of 1060 characters, of which 2 {0.19%) are of import to me). I need to change the two characters (ά → a) for the next iteration, later rinse repeat. Due to accent marks, vowels have at least two forms (e.g., ά, α, ἁ will all map to a), so there will be many “special cases” which if I was doing this manually would be merely tedious.

What I want to know is if there is a “simple” way to feed a paired list “Grk, Latin” to a loop which will replace content of VarA with contents of VarB, until the list runs out. Or count >N for what ever value of N tbd.
Could this be done with a table?

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:GoToStartOfDoc", "", 0, Array())

rem ----------------------------------------------------------------------
dim args2(21) as new com.sun.star.beans.PropertyValue
args2(0).Name = "SearchItem.StyleFamily"
args2(0).Value = 2
args2(9).Name = "SearchItem.AlgorithmType"
args2(9).Value = 0
args2(10).Name = "SearchItem.SearchFlags"
args2(10).Value = 65536
args2(11).Name = "SearchItem.SearchString"   <<=====
args2(11).Value = "Π"                        <<=====
args2(12).Name = "SearchItem.ReplaceString"  <<=====
args2(12).Value = "P"                        <<=====
args2(13).Name = "SearchItem.Locale"
args2(13).Value = 255
args2(14).Name = "SearchItem.ChangedChars"
args2(14).Value = 2
args2(15).Name = "SearchItem.DeletedChars"
args2(15).Value = 2
args2(16).Name = "SearchItem.InsertedChars"
args2(16).Value = 2
args2(17).Name = "SearchItem.TransliterateFlags"
args2(17).Value = 1073742848
args2(18).Name = "SearchItem.Command"
args2(18).Value = 3
args2(19).Name = "SearchItem.SearchFormatted"
args2(19).Value = false
args2(20).Name = "SearchItem.AlgorithmType2"
args2(20).Value = 1
args2(21).Name = "Quiet"
args2(21).Value = true

dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args2())

[Zizi64]

Function Greek2Latin(sText as string) as string
 dim sResult, sChar as string
 dim iPos as integer
 
	sLatin = "ABGDEZHQIKLMNXOPRSTYFCUWabgdezhqiklmnxoprstyfcuw"
	sGreek = "ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩαβγδεζηθικλμνξοπρστυφχψω"
	sResult = ""
	
	for i = 1 to len(sText)
		sChar = Mid(sText,i,1)		
		iPos = Instr(1,sGreek,sChar,0)
		if iPos<>0 then
			sResult = SResult + Mid(sLatin,iPos,1)
		else
			sResult = SResult + sChar
		end if
	next i

 Greek2Latin = sResult
End function
'_________________________________________________________________


Function Latin2Greek(sText as string) as string

 dim sResult, sChar as string
 dim iPos as integer
 
	sLatin = "ABGDEZHQIKLMNXOPRSTYFCUWabgdezhqiklmnxoprstyfcuw"
	sGreek = "ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩαβγδεζηθικλμνξοπρστυφχψω"
	sResult = ""
	
	for i = 1 to len(sText)
		sChar = Mid(sText,i,1)		
		iPos = Instr(1,sLatin,sChar,0)
		if iPos<>0 then
			sResult = SResult + Mid(sGreek,iPos,1)
		else
			sResult = SResult + sChar
		end if
	next i

 Latin2Greek = sResult
End function
'_________________________________________________________________

LatinGreek.ods (17.5 KB)

[mikekaganski]

Note that using Replace would likely be more performant: you just iterate over the sGreek, and perform the Replace for each. That would execute a single C++ optimized function once per alphabet character, instead of a bunch of Basic calls (InStr, If, Mid, concatenation) per each text character.

[Lupp]

Asking for disambiguation:
Is the question actually targetting at a transliteration or was a transcription wanted?
Replacing a "Θ" with a "Q" (e.g.) has its origin in the ASCII times (1970) and may be a kind of keyboard mapping. Donno. Originally "*Q" (with the asterisk) was used. Anyway, its a transliteration, but has no specific relation to “English”. The term transliteration is generally applied to the purely formal replacement of (possibly grouped) character(s) from one script (alphabet/abjad) to a different one. There is more than one “standard” that might be applied. The transliteration for "Θ" from ancient Greek to Latin is "Th" following ALA-LC.

For a move from a language written in a possible different script to the target language (using its own script) trying to regard the pronounciation can hardly be clear standards based on the typeset text allone.
Transcriptions do so, however, also in cases where source scripts and target script are both Latin. There is a one-way standard transcription applicable to every(?) human language, known as IPA. The IPA uses an abundance of special characters and diacritical additions and is thus unmanageable for me. It is based on European writing systems.

[Original_Memory6188]

I am after a transliteration: replacing the Greek letters with Latin equivalent. I can’t yet decipher the Greek alphabet fast enough to sing along with the choir, iwth the transliteration I can fake it.

There are, according to Libre Office “Special Characters” some 302 greek letter and ‘diacritical’ combinations (accents, stresses, breathing, and combinations of the two.)
eg:

Πάτερ ἡμῶν ὁ ἐν τοῖς οὐρανοῖς ἁγιασθήτω τό ὄνομά σου,
ἐλθέτω ἡ βασιλεία σου, γενηθήτω τό θέλημά σου, ὡς

ἁγιασθήτω has two letter αs, one with and one without an accent.
What I was trying to do was find an easier way to “lookup” α (and Α) with it’s numerous (12, I think) diacriticals and replace them with one latin (english) equivalent. Thus every variation on Α become A, every α become an ‘a’, and so until Omega is ‘OO’ or ‘oo’ depending on case.

I did find a solution,

The following example demonstrates the use of ReplaceDescriptors for a search within a LibreOffice document.

Dim I As Long
Dim Doc As Object
Dim Replace As Object
Dim BritishWords(5) As String
Dim USWords(5) As String

BritishWords() = Array(“colour”, “neighbour”, “centre”, “behaviour”, _
“metre”, “through”)
USWords() = Array(“color”, “neighbor”, “center”, “behavior”, _
“meter”, “thru”)

Doc = ThisComponent
Replace = Doc.createReplaceDescriptor

For I = 0 To 5
Replace.SearchString = BritishWords(I)
Replace.ReplaceString = USWords(I)
Doc.replaceAll(Replace)
Next I

By replacing the array of British words with Greek Letters, and USWords with Latin letters, it worked. Mostly. There are a couple spots where I think that somewhere along the line a program decided to be helpful and autocorrect a couple letters.

[Original_Memory6188]

Thanks for all the suggestions
I found a solution which works for me: uses Basic and is practically a cut and past from the reference.

The following example demonstrates the use of ReplaceDescriptors for a search within a LibreOffice document.

Dim I As Long
Dim Doc As Object
Dim Replace As Object
Dim BritishWords(5) As String
Dim USWords(5) As String

BritishWords() = Array(“colour”, “neighbour”, “centre”, “behaviour”, _
“metre”, “through”)
USWords() = Array(“color”, “neighbor”, “center”, “behavior”, _
“meter”, “thru”)

Doc = ThisComponent
Replace = Doc.createReplaceDescriptor

For I = 0 To 5
Replace.SearchString = BritishWords(I)
Replace.ReplaceString = USWords(I)
Doc.replaceAll(Replace)
Next I

By replacing the array of British words with Greek Letters, and USWords with Latin letters, it worked. Mostly. There are a couple spots where I think that somewhere along the line a program decided to be helpful and autocorrect a couple letters.

[karolus]

Hm:

sLatin = "ABGDEZHQIKLMNXOPRSTYFCUWabgdezhqiklmnxoprstyfcuw"
sGreek = "ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩαβγδεζηθικλμνξοπρστυφχψω"

teststring = f"{sLatin}{sGreek}"

_to_latin = str.maketrans(sGreek, sLatin)
_to_greek = str.maketrans(sLatin, sGreek)

def translate( someString, direction):
    return someString.translate(direction)

def main():
    print( translate( teststring, _to_latin))
    print( translate( teststring, _to_greek))

[Original_Memory6188]

One way to do it.

The solution I did find took a different route, just search and replace every letter in the Greek whether it is in the text or not. Brute force, but “it works”.

The following example demonstrates the use of ReplaceDescriptors for a search within a LibreOffice document.

Dim I As Long
Dim Doc As Object
Dim Replace As Object
Dim BritishWords(5) As String
Dim USWords(5) As String

BritishWords() = Array(“colour”, “neighbour”, “centre”, “behaviour”, _
“metre”, “through”)
USWords() = Array(“color”, “neighbor”, “center”, “behavior”, _
“meter”, “thru”)

Doc = ThisComponent
Replace = Doc.createReplaceDescriptor

For I = 0 To 5
Replace.SearchString = BritishWords(I)
Replace.ReplaceString = USWords(I)
Doc.replaceAll(Replace)
Next I

By replacing the array of British words with Greek Letters, and USWords with Latin letters, it worked. Mostly. There are a couple spots where I think that somewhere along the line a program decided to be helpful and autocorrect a couple letters.