Die internationale Sprache Esperanto

Esperanto ist eine neutrale und sehr leicht zu erlernende internationale Sprache, die in über 110 Länder der Erde gesprochen wird.

### Skript 111
# Uebersetzungsprogramm Esperanto --> Deutsch
### por ZTE
# cd /sdcard/Vortaro
### por Coby
# cd /mnt/ext_sd/Vortaro

global clialt cli nursolaj stop Inhalt Inhalt2 Richtung nevortoj nurkomence 
destroy .b5
destroy .b8
### encoding system utf-8

proc aldon {} {
### if {[file exists aldonoj] == 0} {}
set h [open aldonoj w+]
puts $h "######aldonoj######\r\n###  ĉ  ĝ  ĥ  ĵ  ŝ  ŭ ###\r\n~j ;Endung für Plural (Mehrzahl) bei Haupt- und Eigenschaftswörtern\r\n~n~ ;auch Richtung z.B. mi iras en la domon - ich gehe ins Haus\r\n~it~ ;Partizip Passiv des Verbs in der Vergangenheit, z.B. 'manĝita' = 'gegessen worden'\r\n~at~ ;Endung für Partizip Passiv des Verbs in der Gegenwart, z.B. 'manĝata' = 'gegessen werdend'\r\n~ot~ ;Endung für Partizip Passiv des Verbs in der Zukunft, z.B. 'manĝota' = 'gegessen werden seiend'\r\n~int~ ;Endung für Partizip Aktiv des Verbs in der Vergangenheit, z.B. 'manĝinta' = 'gegessen habend'\r\n~ant~ ;Endung für das Partizip Aktiv des Verbs in der Gegenwart, z.B. 'manĝanta' = 'essend'\r\n~ont~ ;Endung für Partizip Aktiv des Verbs in der Zukunft 'manĝonta' = 'essen werdend'\r\n"
close $h

### if {[file exists Ergaenzungen] == 0} {}
set h [open Ergaenzungen w+]
puts $h "######Ergaenzungen######\r\n###  ĉ  ĝ  ĥ  ĵ  ŝ  ŭ ###\r\n"
close $h

}
aldon

proc esp-ger {} {
# esperanto.txt --> esperanto
### if {[file exists esperanto.txt] == 0} {}
### .t insert end "esperanto.txt nicht gefunden!!!\n"
### update
### vwait xyz
set h  [open esperanto.txt r]
set Inhalt [read $h]
close $h
regsub Bordeaux $Inhalt Bordeaaa Inhalt
regsub -all cx $Inhalt \u109 Inhalt
regsub -all gx $Inhalt \u11d Inhalt
regsub -all hx $Inhalt \u125 Inhalt
regsub -all jx $Inhalt \u135 Inhalt
regsub -all sx $Inhalt \u15d Inhalt
regsub -all ux $Inhalt \u16d Inhalt
regsub -all Cx $Inhalt \u108 Inhalt
regsub -all Gx $Inhalt \u11c Inhalt
regsub -all Hx $Inhalt \u124 Inhalt
regsub -all Jx $Inhalt \u134 Inhalt
regsub -all Sx $Inhalt \u15c Inhalt
regsub -all Ux $Inhalt \u16c Inhalt
regsub Bordeaaa $Inhalt Bordeaux Inhalt
regsub -all \" $Inhalt ' Inhalt
regsub -all \n $Inhalt \r\n Inhalt
set hh [open esperanto w+]
puts $hh $Inhalt
close $hh
# deutsch.txt --> deutsch
set h  [open deutsch.txt r]
set Inhalt [read $h]
close $h
regsub Bordeaux $Inhalt Bordeaaa Inhalt
regsub -all cx $Inhalt \u109 Inhalt
regsub -all gx $Inhalt \u11d Inhalt
regsub -all hx $Inhalt \u125 Inhalt
regsub -all jx $Inhalt \u135 Inhalt
regsub -all sx $Inhalt \u15d Inhalt
regsub -all ux $Inhalt \u16d Inhalt
regsub -all Cx $Inhalt \u108 Inhalt
regsub -all Gx $Inhalt \u11c Inhalt
regsub -all Hx $Inhalt \u124 Inhalt
regsub -all Jx $Inhalt \u134 Inhalt
regsub -all Sx $Inhalt \u15c Inhalt
regsub -all Ux $Inhalt \u16c Inhalt
regsub Bordeaaa $Inhalt Bordeaux Inhalt
regsub -all \" $Inhalt ' Inhalt
regsub -all \n $Inhalt \r\n Inhalt
set hh [open deutsch w+]
puts $hh $Inhalt
close $hh
}

set stop 1
update
# krei la uzantointerfacon
### por Odys Nova7 kun Android - por Asus kun XP - Winsurf kun Win10
# wm geometry . 1000x510+0+0
### por HP kun Linux
# wm geometry . 790x710+0+0
### por ZTE kun Android
# wm geometry . 790x435+0+0
### por Coby kun Android
wm geometry . 790x400+0+0
catch {
scrollbar .s -command {.t yview}
pack .s -side right -fill y
### por HP Odys Asus
text .t -wrap word -yscrollcommand {.s set} -height 5 -spacing1 5  -font {"DejaVu Sans Mono" 10 bold}
### por ZTE u. Coby
# text .t -wrap word -yscrollcommand {.s set} -height 5 -spacing1 5  -font {"DejaVu Sans Mono" 6}

pack .t -expand yes -fill both
}
### if {[file exists esperanto] == 0} {esp-ger}
button .b5 -text " traduku! " -command {
set sl [lindex [.t get 0.0 end] 0]
catch {set sl [.t get sel.first sel.last]}
clipboard clear
clipboard append $sl
}
set stop 0}
set Richtung "Esperanto --> Deutsch"
button .b8 -text $Richtung -command {
if {$Richtung == "Esperanto --> Deutsch"} {set Richtung "Deutsch --> Esperanto"
.b8 configure -text $Richtung
return}
set Richtung "Esperanto --> Deutsch"
.b8 configure -text $Richtung
}
pack .b8 .b5 -side left
set clialt ""
set cli    ""
set h [open esperanto r]
set Inhalt [read $h]
close $h
set h [open aldonoj r]
set Inhalt "$Inhalt\n[read $h]"
close $h
set h [open deutsch r]
set Inhalt2 [read $h]
close $h
### vortoj, kiuj ne eksistas ene de vortoj eble nur kun ~
set nursolaj "a b c ĉ d e f g ĝ h ĥ i j ĵ k l m n o p r s ŝ t u ŭ v z
bo co ĉo do fo go ĝo ho ĥo jo ĵo ko lo mo no po ro so ŝo to vo zo
ol plej la din psi aŭ kaj ha he hi hu kuo ju des ĉu ĥi taŭ ke uk je jam"
### vortoj kiuj povas esti nur komence de vortoj
set nurkomence "xx mi vi li ŝi ĝi ri ni vi ili oni ci ĉia ĉie ĉio ĉiu ia ie io iu kia kie kio kiu nenia nenie nenio neniu tia tie tio tiu (tro) jen ĉial ĉiam ĉiel ĉies ĉiom  ial iam iel ies iom kial kiam kiel kies kiom nenial neniam neniel nenies neniom tial tiam tiel ties tiom "
### vortoj kiuj povas esti nur fine de vortoj
set nurfine "i u (as) is os us"
### vortoj kiuj ne estas vortoj
set nevortoj "dm gm om pl pr ps ti tr"

proc Uebersetzung {Suchwort Startindex} {
global Inhalt
set r ""
set i1 [string first "
$Suchwort " $Inhalt $Startindex]
if {$i1 == -1} {return $r}
set i3 $i1
incr i3
set i2 [string first "
" $Inhalt $i3]
incr i2 -1
set r "$r [string range $Inhalt $i1 $i2]"
return $r
                                        }

proc simpla {Suchwort} {
global nursolaj
set ind 0
set uu ""
while {$ind != -1} {
set ind [string first ' $Suchwort]
if {$ind == -1} {
set tt $Suchwort
set Startindex 0
set uu "$uu[Uebersetzung ~${tt} 0]"
if {[string length $tt] > 1} {set uu "$uu[Uebersetzung ${tt} 0]"}
continue        }
set tt [string range $Suchwort 0 $ind-1]
set solaj [lsearch $nursolaj $tt]
if {$solaj == -1} {set uu "$uu[Uebersetzung ${tt} 0]"}
set uu "$uu[Uebersetzung ${tt}a 0]"
set uu "$uu[Uebersetzung ${tt}e 0]"
set uu "$uu[Uebersetzung ${tt}i 0]"
set uu "$uu[Uebersetzung ${tt}o 0]"
set uu "$uu[Uebersetzung ${tt}~ 0]"  
set uu "$uu[Uebersetzung ~${tt} 1700500]"
set uu "$uu[Uebersetzung ~${tt}~ 1700500]"
set uu "$uu[Uebersetzung ${tt}a 1700500]"
set uu "$uu[Uebersetzung ${tt}e 1700500]"
set uu "$uu[Uebersetzung ${tt}i 1700500]"
set uu "$uu[Uebersetzung ${tt}o 1700500]"

set Suchwort [string range $Suchwort $ind+1 end]
                    }
.t insert end "\n$uu\n"
                        }

proc Deutsche_Uebersetzung {Suchwort} {
global Inhalt2
set Suchwort "\n$Suchwort "
set gefunden [string first $Suchwort $Inhalt2]
set anfang $gefunden
incr gefunden
set ende [string first "
" $Inhalt2 $gefunden]
incr ende -1
set inh [string range $Inhalt2 $anfang $ende]
if {$gefunden == 0} {.t insert end "\n $Suchwort nicht im Woerterbuch von Thommy Schuetz gefunden!
Vielleicht ist es kein Grundwort? - Schreibweise beachten!"}
set anfang [string last \n $inh]
if {$gefunden > 0} {.t insert end "\n\nFolgendes im Woerterbuch von Thommy Schuetz gefunden:"
.t insert end "[string range $inh $anfang end]\n" }
}

proc Analyse {Suchwort} {
global nursolaj nevortoj nurfine nurkomence stop cli
set zae 0
# metu komencajn variaĵojn
### Suchwort nur erster Buchstabe groß suchwort alle Buchstaben klein
set Suchwort [string tolower $Suchwort]
set Tt [string range $Suchwort 0 0]
set Tt [string toupper $Tt]
set TT [string range $Suchwort 1 end]
set suchwort "$Tt$TT"

set uu [Uebersetzung $Suchwort 0]
set uu "$uu[Uebersetzung $suchwort 0]"
set uu "$uu[Uebersetzung $Suchwort 1700500]"
set uu "$uu[Uebersetzung $suchwort 1700500]"

if {$uu == ""} {.t insert end "\n $Suchwort nicht im Woerterbuch von Thommy Schuetz gefunden!\n"}
if {$uu != ""} {.t insert end "\nIm Woerterbuch von Thommy Schuetz gefunden:$uu\n"         }

if {[string first nj $Suchwort] > -1} {.t insert end "-nj- ;weibliches Kosewort"}
if {[string first ĉj $Suchwort] > -1} {.t insert end "-ĉj- ;männliches Kosewort"}
.t insert end "
Moegliche Wortzusammensetzungen:
==================================================="
update

set restlaenge 0
set mm 0
set m  0
set n 0
set z 0
set tl(0) $Suchwort
set such(0) $Suchwort
set laenge [string length $tl(0)]
# ĉefa banto
while {$n < 1000} {
incr n
set uu ""
if {$m < 0} {
.t insert end "Wortsuche beendet!\n"
break
            }
set tt $tl($m)
set tt [string tolower $tt]
set Tt [string range $tt 0 0]
set Tt [string toupper $Tt]
set TT [string range $tt 1 end]
set Tt "$Tt$TT"
set Startindex 0
set lae [string length $tt]
set solaj [lsearch $nursolaj $tt]
set nevort [lsearch $nevortoj $tt]
if {$solaj == -1 && $nevort == -1} {set uu "$uu[Uebersetzung ${tt} $Startindex]"
incr z
set uu "$uu[Uebersetzung ${Tt} $Startindex]"
incr z
set uu "$uu[Uebersetzung ${tt}a $Startindex]"
incr z
set uu "$uu[Uebersetzung ${tt}e $Startindex]"
incr z
set uu "$uu[Uebersetzung ${tt}i $Startindex]"
incr z
set uu "$uu[Uebersetzung ${Tt}o $Startindex]"
incr z
set uu "$uu[Uebersetzung ${tt}o $Startindex]"
incr z}
set uu "$uu[Uebersetzung ${tt}~ $Startindex]"
incr z
set uu "$uu[Uebersetzung ~${tt}~ 1700500]"
incr z
set uu "$uu[Uebersetzung ~${tt} 1700500]"
incr z
set uu "$uu[Uebersetzung ${tt}a 1700500]"
incr z
set uu "$uu[Uebersetzung ${tt}e 1700500]"
incr z
set uu "$uu[Uebersetzung ${tt}i 1700500]"
incr z
set uu "$uu[Uebersetzung ${tt}o 1700500]"
incr z
set uu "$uu[Uebersetzung ~${tt} 1705580]"
incr z
if {[lsearch $nevortoj $tt] > -1} {set uu ""}
if {$lae == 1} { 
set mm $m
incr mm -1
if {$mm < 0} {break}
}

set ue($m) $uu
set uelaenge [string length $ue($m)]                              

# ĉu vortoparto troviĝis en la vortaro? Se jes m+1 kalkulu restvorton
if {$uelaenge > 0} {
set tllaenge [string length $tl($m)]
set restwort [string range $such($m) $tllaenge end]
# wenn Restwort "" dann Wort ausgeben
if {$restwort == ""} {
# Wort ausgeben
set mmm $m
incr mmm
set flag 0
set flag2 1
set zzz 0
set w ""
set u ""
while {$zzz < $mmm} {
if {$zzz > 0} {
set zz2 $zzz
incr zz2 -1

set komence [lsearch $nurkomence $tl($zzz)]
if {$komence > 0} {set flag 1}

# tl(zz2) estas antaux tl(zzz)
# kein e i u vor j!
if {$tl($zzz) == "j"} {
if {$tl($zz2) == "e" || $tl($zz2) == "i" || $tl($zz2) == "u"} {set flag 1}
}

# i u is os us nur wenn letzte Wortwurzel!
# as wenn damit As gemeint ist auch im Wort!
if {$tl($zzz) == "i" && $m != $zzz} {set flag 1}
if {$tl($zzz) == "u" && $m != $zzz} {set flag 1}
# if {$tl($zzz) == "as" && $m != $zzz} {set flag 1}
if {$tl($zzz) == "is" && $m != $zzz} {set flag 1}
if {$tl($zzz) == "os" && $m != $zzz} {set flag 1}
if {$tl($zzz) == "us" && $m != $zzz} {set flag 1}


# kein a e i o u vor i
if {$tl($zz2) == "a" || $tl($zz2) == "e" || $tl($zz2) == "i" || $tl($zz2) == "o" || $tl($zz2) == "u"} {
if {$tl($zzz) == "i"} {set flag 1}
}


# kein a e i o u j nach n oder nach j
if {$tl($zzz) == "a" || $tl($zzz) == "e" || $tl($zzz) == "i" || $tl($zzz) == "o" || $tl($zzz) == "u" || $tl($zzz) == "j"} {
if {$tl($zz2) == "n" || $tl($zz2) == "j" } {set flag 1}
}


# nur a o j e vor n es sei denn daß n die 2. Wortwurzel ist
if {$zz2 != 0} {
if {$tl($zz2) != "a" && $tl($zz2) != "o" && $tl($zz2) != "j" && $tl($zz2) != "e"} {
if {$tl($zzz) == "n"} {set flag 1}
}
}

# nur a o vor j es sei denn daß n die 2. Wortwurzel ist
 if {$zz2 != 0} {
 if {$tl($zz2) != "a" && $tl($zz2) != "o"} {
 if {$tl($zzz) == "j"} {set flag 1}
}
}

}
set w "$w$tl($zzz)'"
set u "$u$ue($zzz)"
incr zzz
                  }
set zz3 $zzz
incr zz3 -1
if {$tl($zz3) == "a"} {set flag2 0}
if {$tl($zz3) == "e"} {set flag2 0}
if {$tl($zz3) == "i"} {set flag2 0}
if {$tl($zz3) == "o"} {set flag2 0}
if {$tl($zz3) == "u"} {set flag2 0}
if {$tl($zz3) == "j"} {set flag2 0}
if {$tl($zz3) == "n"} {set flag2 0}
if {$tl($zz3) == "as"} {set flag2 0}
if {$tl($zz3) == "is"} {set flag2 0}
if {$tl($zz3) == "os"} {set flag2 0}
if {$tl($zz3) == "us"} {set flag2 0}
if {$flag == 0 && $flag2 == 0} {
set w [string range $w 0 end-1]
regsub -all ~ $w "" w
incr zae
.t insert end "
$zae) $w
-----------$u\n"
}
update
                     }
if {$restwort != ""} {
incr m 
set tl($m) "$restwort "
set such($m) "$restwort"
                     }
                   }

# mallongigu vorton je unu litero 
set tl($m) [string range $tl($m) 0 end-1]
while {[string length $tl($m)] < 1} {
incr m -1
# ĉu fino atingita?
catch {set tl($m) [string range $tl($m) 0 end-1]}
if {$m < 0} {break}
                }
}
if {$stop == 0} return
.t insert end "
$z mal im Woerterbuch nachgeschlagen
$n Schleifen durchlaufen!\n"
set cli ""
                        }

wm title . "Wort markieren und mit ctrl c in die Zwischenablage kopieren!"

### bind .t <Control-Key-c> {}
bind .t <Control-Key-c> {
set sl [.t get sel.first sel.last]
clipboard clear
clipboard append $sl
}

proc clip {} {
global clialt cli Richtung
catch {set cli [clipboard get]}
set clineu ""
if {$cli != $clialt && $cli != ""} {
set clialt $cli
set flag 1

while {$flag >0} {
set flag 0
### pro diversaj pdf-dosieroj
set s [string first " \\u0327" $cli]
if {$s > -1} {set cli [string replace $cli $s $s+6 yx]
incr flag}
set s [string first " \\u0328" $cli]
if {$s > -1} {set cli [string replace $cli $s $s+6 yy ]
incr flag}
set s [string first " \\u0304" $cli]
if {$s > -1} {set cli [string replace $cli $s $s+6 yz]
incr flag}
set s [string first " \\u0306" $cli]
if {$s > -1} {set cli [string replace $cli $s $s+6 yw]
incr flag}
set s [string first "\\u201d" $cli]
if {$s > -1} {set cli [string replace $cli $s $s+5 ""]
incr flag}
set s [string first "\\u2019" $cli]
if {$s > -1} {set cli [string replace $cli $s $s+5 ""]
incr flag}
}


set flag 1
while {$flag >0} {
set flag 0
### pro unikodoj kiel \u0123
set s [string first "\\" $cli]
.t insert end "s $s  flag $flag\n"
update
if {$s > -1} {
set unicode [string range $cli $s+2 $s+5]
set unicode "0x$unicode"
set unicode [format %c $unicode]
set cli [string replace $cli $s $s+5 $unicode]
incr flag}
}



regsub -all {[",;.:!?-]} $cli "" cli
regsub -all {[\n]}   $cli "" cli
regsub -all {[\r]}   $cli "" cli

set clineu $cli
### se vorto estas skribita per x-sistemo
regsub Bordeaux $clineu Bordeaaa clineu
regsub -all cx $clineu \u0109 clineu
regsub -all gx $clineu \u011d clineu
regsub -all hx $clineu \u0125 clineu 
regsub -all jx $clineu \u0135 clineu
regsub -all sx $clineu \u015d clineu
regsub -all ux $clineu \u016d clineu
regsub -all Cx $clineu \u0108 clineu
regsub -all Gx $clineu \u011c clineu
regsub -all Hx $clineu \u0124 clineu
regsub -all Jx $clineu \u0134 clineu
regsub -all Sx $clineu \u015c clineu
regsub -all Ux $clineu \u016c clineu

### por kelkaj pdf-dosieroj -> UTF-8 ###
regsub -all ” $clineu "" clineu

regsub -all ç $clineu \u0109 clineu
regsub -all yx $clineu \u011d clineu
regsub -all ¸  $clineu \u011d clineu
regsub -all yy $clineu \u0125 clineu
regsub -all ˛  $clineu \u0125 clineu
regsub -all î $clineu \u0135 clineu
regsub -all ÿ $clineu \u015d clineu
regsub -all û $clineu \u016d clineu
regsub -all Ç $clineu \u0108 clineu
regsub -all yz $clineu \u011c clineu
regsub -all ¯  $clineu \u011c clineu
regsub -all yw $clineu \u0124 clineu
regsub -all ˘  $clineu \u0124 clineu
regsub -all Î $clineu \u0134 clineu
regsub -all Ÿ $clineu \u015c clineu
regsub -all Û $clineu \u016c clineu

regsub Bordeaaa $clineu Bordeaux clineu
.t delete 0.0 end
.t insert end $clineu

if {$Richtung == "Esperanto --> Deutsch"} {
if {[string first ' $clineu] == -1} {Analyse $clineu}
if {[string first ' $clineu] != -1} {simpla $clineu}
} }
if {$Richtung == "Deutsch --> Esperanto"} {
if {$clineu != ""} {
Deutsche_Uebersetzung $clineu
} } 
after 1000 clip
}
 clip
###